2 module ParseIface ( parseIface, IfaceStuff(..) ) where
4 #include "HsVersions.h"
6 import HsSyn -- quite a bit of stuff
7 import RdrHsSyn -- oodles of synonyms
8 import HsDecls ( HsIdInfo(..), HsStrictnessInfo(..) )
9 import HsTypes ( mkHsForAllTy )
12 import BasicTypes ( IfaceFlavour(..), Fixity(..), FixityDirection(..), NewOrData(..), Version )
13 import HsPragmas ( noDataPragmas, noClassPragmas )
14 import Kind ( Kind, mkArrowKind, mkBoxedTypeKind, mkTypeKind )
15 import IdInfo ( ArgUsageInfo, FBTypeInfo, ArityInfo, exactArity )
16 import PrimRep ( decodePrimRep )
19 import RnMonad ( ImportVersion, LocalVersion, ParsedIface(..), WhatsImported(..),
20 RdrNamePragma, ExportItem, RdrAvailInfo, GenAvailInfo(..)
22 import Bag ( emptyBag, unitBag, snocBag )
23 import FiniteMap ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
24 import Name ( OccName(..), isTCOcc, Provenance, SYN_IE(Module) )
25 import SrcLoc ( SrcLoc )
32 %tokentype { IfaceToken }
33 %monad { IfM }{ thenIf }{ returnIf }
34 %lexer { lexIface } { ITeof }
37 INTERFACE { ITinterface }
38 USAGES_PART { ITusages }
39 VERSIONS_PART { ITversions }
40 EXPORTS_PART { ITexports }
41 INSTANCE_MODULES_PART { ITinstance_modules }
42 INSTANCES_PART { ITinstances }
43 FIXITIES_PART { ITfixities }
44 DECLARATIONS_PART { ITdeclarations }
45 PRAGMAS_PART { ITpragmas }
49 DERIVING { ITderiving }
52 INSTANCE { ITinstance }
75 VARSYM { ITvarsym $$ }
76 CONSYM { ITconsym $$ }
77 QVARID { ITqvarid $$ }
78 QCONID { ITqconid $$ }
79 QVARSYM { ITqvarsym $$ }
80 QCONSYM { ITqconsym $$ }
82 STRICT_PART { ITstrict $$ }
83 TYPE_PART { ITtysig _ _ }
84 ARITY_PART { ITarity }
85 UNFOLD_PART { ITunfold $$ }
86 SPECIALISE { ITspecialise }
91 PRIM_CASE { ITprim_case }
100 INLINE_CALL { ITinline }
103 STRING { ITstring $$ }
104 INTEGER { ITinteger $$ }
105 DOUBLE { ITdouble $$ }
107 INTEGER_LIT { ITinteger_lit }
108 FLOAT_LIT { ITfloat_lit }
109 RATIONAL_LIT { ITrational_lit }
110 ADDR_LIT { ITaddr_lit }
111 LIT_LIT { ITlit_lit }
112 STRING_LIT { ITstring_lit }
114 UNKNOWN { ITunknown $$ }
117 -- iface_stuff is the main production.
118 -- It recognises (a) a whole interface file
119 -- (b) a type (so that type sigs can be parsed lazily)
120 -- (c) the IdInfo part of a signature (same reason)
122 iface_stuff :: { IfaceStuff }
123 iface_stuff : iface { PIface $1 }
125 | id_info { PIdInfo $1 }
128 iface :: { ParsedIface }
129 iface : INTERFACE CONID INTEGER checkVersion
132 exports_part fixities_part
137 (fromInteger $3) -- Module version
140 $5 -- Instance modules
143 $9 -- Local instances
147 usages_part :: { [ImportVersion OccName] }
148 usages_part : USAGES_PART module_stuff_pairs { $2 }
151 module_stuff_pairs :: { [ImportVersion OccName] }
152 module_stuff_pairs : { [] }
153 | module_stuff_pair module_stuff_pairs { $1 : $2 }
155 module_stuff_pair :: { ImportVersion OccName }
156 module_stuff_pair : mod_name opt_bang INTEGER DCOLON whats_imported SEMI
157 { ($1, $2, fromInteger $3, $5) }
159 whats_imported :: { WhatsImported OccName }
160 whats_imported : { Everything }
161 | name_version_pair name_version_pairs { Specifically ($1:$2) }
163 versions_part :: { [LocalVersion OccName] }
164 versions_part : VERSIONS_PART name_version_pairs { $2 }
167 name_version_pairs :: { [LocalVersion OccName] }
168 name_version_pairs : { [] }
169 | name_version_pair name_version_pairs { $1 : $2 }
171 name_version_pair :: { LocalVersion OccName }
172 name_version_pair : entity_occ INTEGER { ($1, fromInteger $2)
173 --------------------------------------------------------------------------
176 exports_part :: { [ExportItem] }
177 exports_part : EXPORTS_PART export_items { $2 }
180 export_items :: { [ExportItem] }
181 export_items : { [] }
182 | opt_bang mod_name entities SEMI export_items { ($2,$1,$3) : $5 }
184 opt_bang :: { IfaceFlavour }
185 opt_bang : { HiFile }
186 | BANG { HiBootFile }
188 entities :: { [RdrAvailInfo] }
190 | entity entities { $1 : $2 }
192 entity :: { RdrAvailInfo }
193 entity : entity_occ { if isTCOcc $1
196 | entity_occ stuff_inside { AvailTC $1 ($1:$2) }
197 | entity_occ VBAR stuff_inside { AvailTC $1 $3 }
199 stuff_inside :: { [OccName] }
200 stuff_inside : OPAREN val_occs1 CPAREN { $2
201 --------------------------------------------------------------------------
204 inst_modules_part :: { [Module] }
205 inst_modules_part : { [] }
206 | INSTANCE_MODULES_PART mod_list { $2 }
208 mod_list :: { [Module] }
210 | mod_name mod_list { $1 : $2
211 --------------------------------------------------------------------------
214 fixities_part :: { [(OccName,Fixity)] }
215 fixities_part : { [] }
216 | FIXITIES_PART fixes { $2 }
218 fixes :: { [(OccName,Fixity)] }
220 | fix fixes { $1 : $2 }
222 fix :: { (OccName, Fixity) }
223 fix : INFIXL INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixL) }
224 | INFIXR INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixR) }
225 | INFIX INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixN)
226 --------------------------------------------------------------------------
229 decls_part :: { [(Version, RdrNameHsDecl)] }
231 | DECLARATIONS_PART topdecls { $2 }
233 topdecls :: { [(Version, RdrNameHsDecl)] }
235 | version topdecl topdecls { ($1,$2) : $3 }
237 version :: { Version }
238 version : INTEGER { fromInteger $1 }
240 topdecl :: { RdrNameHsDecl }
241 topdecl : src_loc TYPE tc_name tv_bndrs EQUAL type SEMI
242 { TyD (TySynonym $3 $4 $6 $1) }
243 | src_loc DATA decl_context tc_name tv_bndrs constrs deriving SEMI
244 { TyD (TyData DataType $3 $4 $5 $6 $7 noDataPragmas $1) }
245 | src_loc NEWTYPE decl_context tc_name tv_bndrs newtype_constr deriving SEMI
246 { TyD (TyData NewType $3 $4 $5 $6 $7 noDataPragmas $1) }
247 | src_loc CLASS decl_context tc_name tv_bndrs csigs SEMI
248 { ClD (mkClassDecl $3 $4 $5 $6 EmptyMonoBinds noClassPragmas $1) }
249 | src_loc var_name TYPE_PART
252 ITtysig sig idinfo_part -> -- Parse type and idinfo lazily
256 Just s -> case parseIface s $1 of
257 Succeeded (PIdInfo id_info) -> id_info
258 other -> pprPanic "IdInfo parse failed"
261 tp = case parseIface sig $1 of
262 Succeeded (PType tp) -> tp
263 other -> pprPanic "Id type parse failed"
266 SigD (IfaceSig $2 tp info $1) }
268 decl_context :: { RdrNameContext }
269 decl_context : { [] }
270 | OCURLY context_list1 CCURLY DARROW { $2 }
273 csigs :: { [RdrNameSig] }
275 | WHERE OCURLY csigs1 CCURLY { $3 }
277 csigs1 :: { [RdrNameSig] }
278 csigs1 : csig { [$1] }
279 | csig SEMI csigs1 { $1 : $3 }
281 csig :: { RdrNameSig }
282 csig : src_loc var_name DCOLON type { ClassOpSig $2 Nothing $4 $1 }
283 | src_loc var_name EQUAL DCOLON type { ClassOpSig $2
284 (Just (error "Un-filled-in default method"))
286 ----------------------------------------------------------------
289 constrs :: { [RdrNameConDecl] {- empty for handwritten abstract -} }
291 | EQUAL constrs1 { $2 }
293 constrs1 :: { [RdrNameConDecl] }
294 constrs1 : constr { [$1] }
295 | constr VBAR constrs1 { $1 : $3 }
297 constr :: { RdrNameConDecl }
298 constr : src_loc data_name batypes { ConDecl $2 [] (VanillaCon $3) $1 }
299 | src_loc data_name OCURLY fields1 CCURLY { ConDecl $2 [] (RecCon $4) $1 }
301 newtype_constr :: { [RdrNameConDecl] {- Empty if handwritten abstract -} }
302 newtype_constr : { [] }
303 | src_loc EQUAL data_name atype { [ConDecl $3 [] (NewCon $4) $1] }
305 deriving :: { Maybe [RdrName] }
307 | DERIVING OPAREN tc_names1 CPAREN { Just $3 }
309 batypes :: { [RdrNameBangType] }
311 | batype batypes { $1 : $2 }
313 batype :: { RdrNameBangType }
314 batype : atype { Unbanged $1 }
315 | BANG atype { Banged $2 }
317 fields1 :: { [([RdrName], RdrNameBangType)] }
318 fields1 : field { [$1] }
319 | field COMMA fields1 { $1 : $3 }
321 field :: { ([RdrName], RdrNameBangType) }
322 field : var_names1 DCOLON type { ($1, Unbanged $3) }
323 | var_names1 DCOLON BANG type { ($1, Banged $4) }
324 --------------------------------------------------------------------------
326 type :: { RdrNameHsType }
327 type : FORALL forall context DARROW type { mkHsForAllTy $2 $3 $5 }
328 | btype RARROW type { MonoFunTy $1 $3 }
331 forall :: { [HsTyVar RdrName] }
332 forall : OBRACK tv_bndrs CBRACK { $2 }
334 context :: { RdrNameContext }
336 | OCURLY context_list1 CCURLY { $2 }
338 context_list1 :: { RdrNameContext }
339 context_list1 : class { [$1] }
340 | class COMMA context_list1 { $1 : $3 }
342 class :: { (RdrName, [RdrNameHsType]) }
343 class : tc_name atypes { ($1, $2) }
345 types2 :: { [RdrNameHsType] {- Two or more -} }
346 types2 : type COMMA type { [$1,$3] }
347 | type COMMA types2 { $1 : $3 }
349 btype :: { RdrNameHsType }
351 | btype atype { MonoTyApp $1 $2 }
353 atype :: { RdrNameHsType }
354 atype : tc_name { MonoTyVar $1 }
355 | tv_name { MonoTyVar $1 }
356 | OPAREN types2 CPAREN { MonoTupleTy dummyRdrTcName $2 }
357 | OBRACK type CBRACK { MonoListTy dummyRdrTcName $2 }
358 | OCURLY tc_name atypes CCURLY { MonoDictTy $2 $3 }
359 | OPAREN type CPAREN { $2 }
361 atypes :: { [RdrNameHsType] {- Zero or more -} }
363 | atype atypes { $1 : $2 }
364 ---------------------------------------------------------------------
366 mod_name :: { Module }
369 var_occ :: { OccName }
370 var_occ : VARID { VarOcc $1 }
371 | VARSYM { VarOcc $1 }
372 | BANG { VarOcc SLIT("!") {-sigh, double-sigh-} }
374 tc_occ :: { OccName }
375 tc_occ : CONID { TCOcc $1 }
376 | CONSYM { TCOcc $1 }
377 | OPAREN RARROW CPAREN { TCOcc SLIT("->") }
379 entity_occ :: { OccName }
380 entity_occ : var_occ { $1 }
382 | RARROW { TCOcc SLIT("->") {- Allow un-paren'd arrow -} }
384 val_occ :: { OccName }
385 val_occ : var_occ { $1 }
386 | CONID { VarOcc $1 }
387 | CONSYM { VarOcc $1 }
389 val_occs1 :: { [OccName] }
391 | val_occ val_occs1 { $1 : $2 }
394 var_name :: { RdrName }
395 var_name : var_occ { Unqual $1 }
397 qvar_name :: { RdrName }
398 qvar_name : var_name { $1 }
399 | QVARID { lexVarQual $1 }
400 | QVARSYM { lexVarQual $1 }
402 var_names :: { [RdrName] }
404 | var_name var_names { $1 : $2 }
406 var_names1 :: { [RdrName] }
407 var_names1 : var_name var_names { $1 : $2 }
409 data_name :: { RdrName }
410 data_name : CONID { Unqual (VarOcc $1) }
411 | CONSYM { Unqual (VarOcc $1) }
413 qdata_name :: { RdrName }
414 qdata_name : data_name { $1 }
415 | QCONID { lexVarQual $1 }
416 | QCONSYM { lexVarQual $1 }
418 qdata_names :: { [RdrName] }
420 | qdata_name qdata_names { $1 : $2 }
422 tc_name :: { RdrName }
423 tc_name : tc_occ { Unqual $1 }
424 | QCONID { lexTcQual $1 }
425 | QCONSYM { lexTcQual $1 }
427 tc_names1 :: { [RdrName] }
429 | tc_name COMMA tc_names1 { $1 : $3 }
431 tv_name :: { RdrName }
432 tv_name : VARID { Unqual (TvOcc $1) }
433 | VARSYM { Unqual (TvOcc $1) {- Allow t2 as a tyvar -} }
435 tv_names :: { [RdrName] }
437 | tv_name tv_names { $1 : $2 }
439 tv_bndr :: { HsTyVar RdrName }
440 tv_bndr : tv_name DCOLON akind { IfaceTyVar $1 $3 }
441 | tv_name { UserTyVar $1 }
443 tv_bndrs :: { [HsTyVar RdrName] }
445 | tv_bndr tv_bndrs { $1 : $2 }
449 | akind RARROW kind { mkArrowKind $1 $3 }
452 : VARSYM { if $1 == SLIT("*") then
454 else if $1 == SLIT("**") then
456 else panic "ParseInterface: akind"
458 | OPAREN kind CPAREN { $2 }
459 --------------------------------------------------------------------------
462 instances_part :: { [RdrNameInstDecl] }
463 instances_part : INSTANCES_PART instdecls { $2 }
466 instdecls :: { [RdrNameInstDecl] }
468 | instd instdecls { $1 : $2 }
470 instd :: { RdrNameInstDecl }
471 instd : src_loc INSTANCE type EQUAL var_name SEMI
473 EmptyMonoBinds {- No bindings -}
474 [] {- No user pragmas -}
475 (Just $5) {- Dfun id -}
478 --------------------------------------------------------------------------
480 id_info :: { [HsIdInfo RdrName] }
482 | id_info_item id_info { $1 : $2 }
484 id_info_item :: { HsIdInfo RdrName }
485 id_info_item : ARITY_PART arity_info { HsArity $2 }
486 | strict_info { HsStrictness $1 }
487 | BOTTOM { HsStrictness HsBottom }
488 | UNFOLD_PART core_expr { HsUnfold $1 $2 }
489 | SPECIALISE spec_tvs
490 atypes EQUAL core_expr { HsSpecialise $2 $3 $5 }
493 spec_tvs :: { [HsTyVar RdrName] }
494 spec_tvs : OBRACK tv_bndrs CBRACK { $2 }
497 arity_info :: { ArityInfo }
498 arity_info : INTEGER { exactArity (fromInteger $1) }
500 strict_info :: { HsStrictnessInfo RdrName }
501 strict_info : STRICT_PART qvar_name OCURLY qdata_names CCURLY { HsStrictnessInfo $1 (Just ($2,$4)) }
502 | STRICT_PART qvar_name { HsStrictnessInfo $1 (Just ($2,[])) }
503 | STRICT_PART { HsStrictnessInfo $1 Nothing }
505 core_expr :: { UfExpr RdrName }
506 core_expr : qvar_name { UfVar $1 }
507 | qdata_name { UfVar $1 }
508 | core_lit { UfLit $1 }
509 | OPAREN core_expr CPAREN { $2 }
510 | qdata_name OCURLY data_args CCURLY { UfCon $1 $3 }
512 | core_expr ATSIGN atype { UfApp $1 (UfTyArg $3) }
513 | core_expr core_arg { UfApp $1 $2 }
514 | LAM core_val_bndrs RARROW core_expr { foldr UfLam $4 $2 }
515 | BIGLAM core_tv_bndrs RARROW core_expr { foldr UfLam $4 $2 }
518 OCURLY alg_alts core_default CCURLY { UfCase $2 (UfAlgAlts $5 $6) }
519 | PRIM_CASE core_expr OF
520 OCURLY prim_alts core_default CCURLY { UfCase $2 (UfPrimAlts $5 $6) }
523 | LET OCURLY core_val_bndr EQUAL core_expr CCURLY
524 IN core_expr { UfLet (UfNonRec $3 $5) $8 }
525 | LETREC OCURLY rec_binds CCURLY
526 IN core_expr { UfLet (UfRec $3) $6 }
529 OBRACK atype atypes CBRACK core_args { let
530 (is_casm, may_gc) = $1
532 UfPrim (UfCCallOp $2 is_casm may_gc $5 $4)
535 | INLINE_CALL core_expr { UfNote UfInlineCall $2 }
536 | COERCE atype core_expr { UfNote (UfCoerce $2) $3 }
537 | SCC core_expr { UfNote (UfSCC $1) $2 }
539 rec_binds :: { [(UfBinder RdrName, UfExpr RdrName)] }
541 | core_val_bndr EQUAL core_expr SEMI rec_binds { ($1,$3) : $5 }
543 prim_alts :: { [(Literal,UfExpr RdrName)] }
545 | core_lit RARROW core_expr SEMI prim_alts { ($1,$3) : $5 }
547 alg_alts :: { [(RdrName, [RdrName], UfExpr RdrName)] }
549 | qdata_name var_names RARROW
550 core_expr SEMI alg_alts { ($1,$2,$4) : $6 }
552 core_default :: { UfDefault RdrName }
554 | var_name RARROW core_expr SEMI { UfBindDefault $1 $3 }
556 core_arg :: { UfArg RdrName }
557 : qvar_name { UfVarArg $1 }
558 | qdata_name { UfVarArg $1 }
559 | core_lit { UfLitArg $1 }
561 core_args :: { [UfArg RdrName] }
563 | core_arg core_args { $1 : $2 }
565 data_args :: { [UfArg RdrName] }
567 | ATSIGN atype data_args { UfTyArg $2 : $3 }
568 | core_arg data_args { $1 : $2 }
570 core_lit :: { Literal }
571 core_lit : INTEGER { MachInt $1 True }
572 | CHAR { MachChar $1 }
573 | STRING { MachStr $1 }
574 | STRING_LIT STRING { NoRepStr $2 }
575 | DOUBLE { MachDouble (toRational $1) }
576 | FLOAT_LIT DOUBLE { MachFloat (toRational $2) }
578 | INTEGER_LIT INTEGER { NoRepInteger $2 (panic "NoRepInteger type")
579 -- The type checker will add the types
582 | RATIONAL_LIT INTEGER INTEGER { NoRepRational ($2 % $3)
583 (panic "NoRepRational type")
584 -- The type checker will add the type
587 | ADDR_LIT INTEGER { MachAddr $2 }
588 | LIT_LIT prim_rep STRING { MachLitLit $3 (decodePrimRep $2) }
590 core_val_bndr :: { UfBinder RdrName }
591 core_val_bndr : var_name DCOLON atype { UfValBinder $1 $3 }
593 core_val_bndrs :: { [UfBinder RdrName] }
594 core_val_bndrs : { [] }
595 | core_val_bndr core_val_bndrs { $1 : $2 }
597 core_tv_bndr :: { UfBinder RdrName }
598 core_tv_bndr : tv_name DCOLON akind { UfTyBinder $1 $3 }
599 | tv_name { UfTyBinder $1 mkBoxedTypeKind }
601 core_tv_bndrs :: { [UfBinder RdrName] }
602 core_tv_bndrs : { [] }
603 | core_tv_bndr core_tv_bndrs { $1 : $2 }
605 ccall_string :: { FAST_STRING }
611 : VARID { head (_UNPK_ $1) }
612 | CONID { head (_UNPK_ $1) }
614 -------------------------------------------------------------------
616 src_loc :: { SrcLoc }
617 src_loc : {% getSrcLocIf }
619 checkVersion :: { () }
620 : {-empty-} {% checkVersion Nothing }
621 | INTEGER {% checkVersion (Just (fromInteger $1)) }
623 -------------------------------------------------------------------
628 data IfaceStuff = PIface ParsedIface
629 | PIdInfo [HsIdInfo RdrName]
630 | PType RdrNameHsType