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 }
77 VARSYM { ITvarsym $$ }
78 CONSYM { ITconsym $$ }
79 QVARID { ITqvarid $$ }
80 QCONID { ITqconid $$ }
81 QVARSYM { ITqvarsym $$ }
82 QCONSYM { ITqconsym $$ }
84 STRICT_PART { ITstrict $$ }
85 TYPE_PART { ITtysig _ _ }
86 ARITY_PART { ITarity }
87 UNFOLD_PART { ITunfold $$ }
88 SPECIALISE { ITspecialise }
93 PRIM_CASE { ITprim_case }
102 INLINE_CALL { ITinline }
105 STRING { ITstring $$ }
106 INTEGER { ITinteger $$ }
107 DOUBLE { ITdouble $$ }
109 INTEGER_LIT { ITinteger_lit }
110 FLOAT_LIT { ITfloat_lit }
111 RATIONAL_LIT { ITrational_lit }
112 ADDR_LIT { ITaddr_lit }
113 LIT_LIT { ITlit_lit }
114 STRING_LIT { ITstring_lit }
116 UNKNOWN { ITunknown $$ }
119 -- iface_stuff is the main production.
120 -- It recognises (a) a whole interface file
121 -- (b) a type (so that type sigs can be parsed lazily)
122 -- (c) the IdInfo part of a signature (same reason)
124 iface_stuff :: { IfaceStuff }
125 iface_stuff : iface { PIface $1 }
127 | id_info { PIdInfo $1 }
130 iface :: { ParsedIface }
131 iface : INTERFACE CONID INTEGER checkVersion
134 exports_part fixities_part
139 (fromInteger $3) -- Module version
142 $5 -- Instance modules
145 $9 -- Local instances
149 usages_part :: { [ImportVersion OccName] }
150 usages_part : USAGES_PART module_stuff_pairs { $2 }
153 module_stuff_pairs :: { [ImportVersion OccName] }
154 module_stuff_pairs : { [] }
155 | module_stuff_pair module_stuff_pairs { $1 : $2 }
157 module_stuff_pair :: { ImportVersion OccName }
158 module_stuff_pair : mod_name opt_bang INTEGER '::' whats_imported ';'
159 { ($1, $2, fromInteger $3, $5) }
161 whats_imported :: { WhatsImported OccName }
162 whats_imported : { Everything }
163 | name_version_pair name_version_pairs { Specifically ($1:$2) }
165 versions_part :: { [LocalVersion OccName] }
166 versions_part : VERSIONS_PART name_version_pairs { $2 }
169 name_version_pairs :: { [LocalVersion OccName] }
170 name_version_pairs : { [] }
171 | name_version_pair name_version_pairs { $1 : $2 }
173 name_version_pair :: { LocalVersion OccName }
174 name_version_pair : entity_occ INTEGER { ($1, fromInteger $2)
175 --------------------------------------------------------------------------
178 exports_part :: { [ExportItem] }
179 exports_part : EXPORTS_PART export_items { $2 }
182 export_items :: { [ExportItem] }
183 export_items : { [] }
184 | opt_bang mod_name entities ';' export_items { ($2,$1,$3) : $5 }
186 opt_bang :: { IfaceFlavour }
187 opt_bang : { HiFile }
190 entities :: { [RdrAvailInfo] }
192 | entity entities { $1 : $2 }
194 entity :: { RdrAvailInfo }
195 entity : entity_occ { if isTCOcc $1
198 | entity_occ stuff_inside { AvailTC $1 ($1:$2) }
199 | entity_occ '|' stuff_inside { AvailTC $1 $3 }
201 stuff_inside :: { [OccName] }
202 stuff_inside : '(' val_occs1 ')' { $2
203 --------------------------------------------------------------------------
206 inst_modules_part :: { [Module] }
207 inst_modules_part : { [] }
208 | INSTANCE_MODULES_PART mod_list { $2 }
210 mod_list :: { [Module] }
212 | mod_name mod_list { $1 : $2
213 --------------------------------------------------------------------------
216 fixities_part :: { [(OccName,Fixity)] }
217 fixities_part : { [] }
218 | FIXITIES_PART fixes { $2 }
220 fixes :: { [(OccName,Fixity)] }
222 | fix fixes { $1 : $2 }
224 fix :: { (OccName, Fixity) }
225 fix : INFIXL INTEGER val_occ ';' { ($3, Fixity (fromInteger $2) InfixL) }
226 | INFIXR INTEGER val_occ ';' { ($3, Fixity (fromInteger $2) InfixR) }
227 | INFIX INTEGER val_occ ';' { ($3, Fixity (fromInteger $2) InfixN)
228 --------------------------------------------------------------------------
231 decls_part :: { [(Version, RdrNameHsDecl)] }
233 | DECLARATIONS_PART topdecls { $2 }
235 topdecls :: { [(Version, RdrNameHsDecl)] }
237 | version topdecl topdecls { ($1,$2) : $3 }
239 version :: { Version }
240 version : INTEGER { fromInteger $1 }
242 topdecl :: { RdrNameHsDecl }
243 topdecl : src_loc TYPE tc_name tv_bndrs '=' type ';'
244 { TyD (TySynonym $3 $4 $6 $1) }
245 | src_loc DATA decl_context tc_name tv_bndrs constrs deriving ';'
246 { TyD (TyData DataType $3 $4 $5 $6 $7 noDataPragmas $1) }
247 | src_loc NEWTYPE decl_context tc_name tv_bndrs newtype_constr deriving ';'
248 { TyD (TyData NewType $3 $4 $5 $6 $7 noDataPragmas $1) }
249 | src_loc CLASS decl_context tc_name tv_bndrs csigs ';'
250 { ClD (mkClassDecl $3 $4 $5 $6 EmptyMonoBinds noClassPragmas $1) }
251 | src_loc var_name TYPE_PART
254 ITtysig sig idinfo_part -> -- Parse type and idinfo lazily
258 Just s -> case parseIface s $1 of
259 Succeeded (PIdInfo id_info) -> id_info
260 other -> pprPanic "IdInfo parse failed"
263 tp = case parseIface sig $1 of
264 Succeeded (PType tp) -> tp
265 other -> pprPanic "Id type parse failed"
268 SigD (IfaceSig $2 tp info $1) }
270 decl_context :: { RdrNameContext }
271 decl_context : { [] }
272 | '{' context_list1 '}' '=>' { $2 }
275 csigs :: { [RdrNameSig] }
277 | WHERE '{' csigs1 '}' { $3 }
279 csigs1 :: { [RdrNameSig] }
280 csigs1 : csig { [$1] }
281 | csig ';' csigs1 { $1 : $3 }
283 csig :: { RdrNameSig }
284 csig : src_loc var_name '::' type { ClassOpSig $2 Nothing $4 $1 }
285 | src_loc var_name '=' '::' type { ClassOpSig $2
286 (Just (error "Un-filled-in default method"))
288 ----------------------------------------------------------------
291 constrs :: { [RdrNameConDecl] {- empty for handwritten abstract -} }
293 | '=' constrs1 { $2 }
295 constrs1 :: { [RdrNameConDecl] }
296 constrs1 : constr { [$1] }
297 | constr '|' constrs1 { $1 : $3 }
299 constr :: { RdrNameConDecl }
300 constr : src_loc data_name batypes { ConDecl $2 [] (VanillaCon $3) $1 }
301 | src_loc data_name '{' fields1 '}' { ConDecl $2 [] (RecCon $4) $1 }
303 newtype_constr :: { [RdrNameConDecl] {- Empty if handwritten abstract -} }
304 newtype_constr : { [] }
305 | src_loc '=' data_name atype { [ConDecl $3 [] (NewCon $4) $1] }
307 deriving :: { Maybe [RdrName] }
309 | DERIVING '(' tc_names1 ')' { Just $3 }
311 batypes :: { [RdrNameBangType] }
313 | batype batypes { $1 : $2 }
315 batype :: { RdrNameBangType }
316 batype : atype { Unbanged $1 }
317 | '!' atype { Banged $2 }
319 fields1 :: { [([RdrName], RdrNameBangType)] }
320 fields1 : field { [$1] }
321 | field ',' fields1 { $1 : $3 }
323 field :: { ([RdrName], RdrNameBangType) }
324 field : var_names1 '::' type { ($1, Unbanged $3) }
325 | var_names1 '::' '!' type { ($1, Banged $4) }
326 --------------------------------------------------------------------------
328 type :: { RdrNameHsType }
329 type : FORALL forall context '=>' type { mkHsForAllTy $2 $3 $5 }
330 | btype '->' type { MonoFunTy $1 $3 }
333 forall :: { [HsTyVar RdrName] }
334 forall : '[' tv_bndrs ']' { $2 }
336 context :: { RdrNameContext }
338 | '{' context_list1 '}' { $2 }
340 context_list1 :: { RdrNameContext }
341 context_list1 : class { [$1] }
342 | class ',' context_list1 { $1 : $3 }
344 class :: { (RdrName, [RdrNameHsType]) }
345 class : tc_name atypes { ($1, $2) }
347 types2 :: { [RdrNameHsType] {- Two or more -} }
348 types2 : type ',' type { [$1,$3] }
349 | type ',' types2 { $1 : $3 }
351 btype :: { RdrNameHsType }
353 | btype atype { MonoTyApp $1 $2 }
355 atype :: { RdrNameHsType }
356 atype : tc_name { MonoTyVar $1 }
357 | tv_name { MonoTyVar $1 }
358 | '(' types2 ')' { MonoTupleTy $2 True{-boxed-} }
359 | '(#' types2 '#)' { MonoTupleTy $2 False{-unboxed-} }
360 | '[' type ']' { MonoListTy $2 }
361 | '{' tc_name atypes '}' { MonoDictTy $2 $3 }
362 | '(' type ')' { $2 }
364 atypes :: { [RdrNameHsType] {- Zero or more -} }
366 | atype atypes { $1 : $2 }
367 ---------------------------------------------------------------------
369 mod_name :: { Module }
372 var_occ :: { OccName }
373 var_occ : VARID { VarOcc $1 }
374 | VARSYM { VarOcc $1 }
375 | '!' { VarOcc SLIT("!") {-sigh, double-sigh-} }
377 tc_occ :: { OccName }
378 tc_occ : CONID { TCOcc $1 }
379 | CONSYM { TCOcc $1 }
380 | '(' '->' ')' { TCOcc SLIT("->") }
382 entity_occ :: { OccName }
383 entity_occ : var_occ { $1 }
385 | '->' { TCOcc SLIT("->") {- Allow un-paren'd arrow -} }
387 val_occ :: { OccName }
388 val_occ : var_occ { $1 }
389 | CONID { VarOcc $1 }
390 | CONSYM { VarOcc $1 }
392 val_occs1 :: { [OccName] }
394 | val_occ val_occs1 { $1 : $2 }
397 var_name :: { RdrName }
398 var_name : var_occ { Unqual $1 }
400 qvar_name :: { RdrName }
401 qvar_name : var_name { $1 }
402 | QVARID { lexVarQual $1 }
403 | QVARSYM { lexVarQual $1 }
405 var_names :: { [RdrName] }
407 | var_name var_names { $1 : $2 }
409 var_names1 :: { [RdrName] }
410 var_names1 : var_name var_names { $1 : $2 }
412 data_name :: { RdrName }
413 data_name : CONID { Unqual (VarOcc $1) }
414 | CONSYM { Unqual (VarOcc $1) }
416 qdata_name :: { RdrName }
417 qdata_name : data_name { $1 }
418 | QCONID { lexVarQual $1 }
419 | QCONSYM { lexVarQual $1 }
421 qdata_names :: { [RdrName] }
423 | qdata_name qdata_names { $1 : $2 }
425 tc_name :: { RdrName }
426 tc_name : tc_occ { Unqual $1 }
427 | QCONID { lexTcQual $1 }
428 | QCONSYM { lexTcQual $1 }
430 tc_names1 :: { [RdrName] }
432 | tc_name ',' tc_names1 { $1 : $3 }
434 tv_name :: { RdrName }
435 tv_name : VARID { Unqual (TvOcc $1) }
436 | VARSYM { Unqual (TvOcc $1) {- Allow t2 as a tyvar -} }
438 tv_names :: { [RdrName] }
440 | tv_name tv_names { $1 : $2 }
442 tv_bndr :: { HsTyVar RdrName }
443 tv_bndr : tv_name '::' akind { IfaceTyVar $1 $3 }
444 | tv_name { UserTyVar $1 }
446 tv_bndrs :: { [HsTyVar RdrName] }
448 | tv_bndr tv_bndrs { $1 : $2 }
452 | akind '->' kind { mkArrowKind $1 $3 }
455 : VARSYM { if $1 == SLIT("*") then
457 else if $1 == SLIT("**") then
459 else panic "ParseInterface: akind"
461 | '(' kind ')' { $2 }
462 --------------------------------------------------------------------------
465 instances_part :: { [RdrNameInstDecl] }
466 instances_part : INSTANCES_PART instdecls { $2 }
469 instdecls :: { [RdrNameInstDecl] }
471 | instd instdecls { $1 : $2 }
473 instd :: { RdrNameInstDecl }
474 instd : src_loc INSTANCE type '=' var_name ';'
476 EmptyMonoBinds {- No bindings -}
477 [] {- No user pragmas -}
478 (Just $5) {- Dfun id -}
481 --------------------------------------------------------------------------
483 id_info :: { [HsIdInfo RdrName] }
485 | id_info_item id_info { $1 : $2 }
487 id_info_item :: { HsIdInfo RdrName }
488 id_info_item : ARITY_PART arity_info { HsArity $2 }
489 | strict_info { HsStrictness $1 }
490 | BOTTOM { HsStrictness HsBottom }
491 | UNFOLD_PART core_expr { HsUnfold $1 $2 }
492 | SPECIALISE spec_tvs
493 atypes '=' core_expr { HsSpecialise $2 $3 $5 }
496 spec_tvs :: { [HsTyVar RdrName] }
497 spec_tvs : '[' tv_bndrs ']' { $2 }
500 arity_info :: { ArityInfo }
501 arity_info : INTEGER { exactArity (fromInteger $1) }
503 strict_info :: { HsStrictnessInfo RdrName }
504 strict_info : STRICT_PART qvar_name '{' qdata_names '}' { HsStrictnessInfo $1 (Just ($2,$4)) }
505 | STRICT_PART qvar_name { HsStrictnessInfo $1 (Just ($2,[])) }
506 | STRICT_PART { HsStrictnessInfo $1 Nothing }
508 core_expr :: { UfExpr RdrName }
509 core_expr : qvar_name { UfVar $1 }
510 | qdata_name { UfVar $1 }
511 | core_lit { UfLit $1 }
512 | '(' core_expr ')' { $2 }
513 | qdata_name '{' data_args '}' { UfCon $1 $3 }
515 | core_expr ATSIGN atype { UfApp $1 (UfTyArg $3) }
516 | core_expr core_arg { UfApp $1 $2 }
517 | LAM core_val_bndrs '->' core_expr { foldr UfLam $4 $2 }
518 | BIGLAM core_tv_bndrs '->' core_expr { foldr UfLam $4 $2 }
521 '{' alg_alts core_default '}' { UfCase $2 (UfAlgAlts $5 $6) }
522 | PRIM_CASE core_expr OF
523 '{' prim_alts core_default '}' { UfCase $2 (UfPrimAlts $5 $6) }
526 | LET '{' core_val_bndr '=' core_expr '}'
527 IN core_expr { UfLet (UfNonRec $3 $5) $8 }
528 | LETREC '{' rec_binds '}'
529 IN core_expr { UfLet (UfRec $3) $6 }
532 '[' atype atypes ']' core_args { let
533 (is_casm, may_gc) = $1
535 UfPrim (UfCCallOp $2 is_casm may_gc $5 $4)
538 | INLINE_CALL core_expr { UfNote UfInlineCall $2 }
539 | COERCE atype core_expr { UfNote (UfCoerce $2) $3 }
540 | SCC core_expr { UfNote (UfSCC $1) $2 }
542 rec_binds :: { [(UfBinder RdrName, UfExpr RdrName)] }
544 | core_val_bndr '=' core_expr ';' rec_binds { ($1,$3) : $5 }
546 prim_alts :: { [(Literal,UfExpr RdrName)] }
548 | core_lit '->' core_expr ';' prim_alts { ($1,$3) : $5 }
550 alg_alts :: { [(RdrName, [RdrName], UfExpr RdrName)] }
552 | qdata_name var_names '->'
553 core_expr ';' alg_alts { ($1,$2,$4) : $6 }
555 core_default :: { UfDefault RdrName }
557 | var_name '->' core_expr ';' { UfBindDefault $1 $3 }
559 core_arg :: { UfArg RdrName }
560 : qvar_name { UfVarArg $1 }
561 | qdata_name { UfVarArg $1 }
562 | core_lit { UfLitArg $1 }
564 core_args :: { [UfArg RdrName] }
566 | core_arg core_args { $1 : $2 }
568 data_args :: { [UfArg RdrName] }
570 | ATSIGN atype data_args { UfTyArg $2 : $3 }
571 | core_arg data_args { $1 : $2 }
573 core_lit :: { Literal }
574 core_lit : INTEGER { MachInt $1 True }
575 | CHAR { MachChar $1 }
576 | STRING { MachStr $1 }
577 | STRING_LIT STRING { NoRepStr $2 }
578 | DOUBLE { MachDouble (toRational $1) }
579 | FLOAT_LIT DOUBLE { MachFloat (toRational $2) }
581 | INTEGER_LIT INTEGER { NoRepInteger $2 (panic "NoRepInteger type")
582 -- The type checker will add the types
585 | RATIONAL_LIT INTEGER INTEGER { NoRepRational ($2 % $3)
586 (panic "NoRepRational type")
587 -- The type checker will add the type
590 | ADDR_LIT INTEGER { MachAddr $2 }
591 | LIT_LIT prim_rep STRING { MachLitLit $3 (decodePrimRep $2) }
593 core_val_bndr :: { UfBinder RdrName }
594 core_val_bndr : var_name '::' atype { UfValBinder $1 $3 }
596 core_val_bndrs :: { [UfBinder RdrName] }
597 core_val_bndrs : { [] }
598 | core_val_bndr core_val_bndrs { $1 : $2 }
600 core_tv_bndr :: { UfBinder RdrName }
601 core_tv_bndr : tv_name '::' akind { UfTyBinder $1 $3 }
602 | tv_name { UfTyBinder $1 mkBoxedTypeKind }
604 core_tv_bndrs :: { [UfBinder RdrName] }
605 core_tv_bndrs : { [] }
606 | core_tv_bndr core_tv_bndrs { $1 : $2 }
608 ccall_string :: { FAST_STRING }
614 : VARID { head (_UNPK_ $1) }
615 | CONID { head (_UNPK_ $1) }
617 -------------------------------------------------------------------
619 src_loc :: { SrcLoc }
620 src_loc : {% getSrcLocIf }
622 checkVersion :: { () }
623 : {-empty-} {% checkVersion Nothing }
624 | INTEGER {% checkVersion (Just (fromInteger $1)) }
626 -------------------------------------------------------------------
631 data IfaceStuff = PIface ParsedIface
632 | PIdInfo [HsIdInfo RdrName]
633 | PType RdrNameHsType