2 #include "HsVersions.h"
4 module ParseIface ( parseIface ) where
8 import CmdLineOpts ( opt_IgnoreIfacePragmas )
10 import HsSyn -- quite a bit of stuff
11 import RdrHsSyn -- oodles of synonyms
12 import HsDecls ( HsIdInfo(..) )
13 import HsTypes ( mkHsForAllTy )
16 import HsPragmas ( noGenPragmas, noDataPragmas, noClassPragmas, noClassOpPragmas, noInstancePragmas )
17 import IdInfo ( exactArity, mkStrictnessInfo, mkBottomStrictnessInfo,
18 ArgUsageInfo, FBTypeInfo
20 import Kind ( Kind, mkArrowKind, mkTypeKind )
23 import RnMonad ( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
24 SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
26 import Bag ( emptyBag, unitBag, snocBag )
27 import FiniteMap ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
28 import Name ( OccName(..), Provenance )
29 import SrcLoc ( mkIfaceSrcLoc )
30 import Util ( panic{-, pprPanic ToDo:rm-} )
33 -----------------------------------------------------------------
35 parseIface = parseIToks . lexIface
37 -----------------------------------------------------------------
41 %tokentype { IfaceToken }
42 %monad { IfM }{ thenIf }{ returnIf }
45 INTERFACE { ITinterface }
46 USAGES_PART { ITusages }
47 VERSIONS_PART { ITversions }
48 EXPORTS_PART { ITexports }
49 INSTANCE_MODULES_PART { ITinstance_modules }
50 INSTANCES_PART { ITinstances }
51 FIXITIES_PART { ITfixities }
52 DECLARATIONS_PART { ITdeclarations }
53 PRAGMAS_PART { ITpragmas }
63 DERIVING { ITderiving }
70 INSTANCE { ITinstance }
80 INTEGER { ITinteger $$ }
83 VARSYM { ITvarsym $$ }
84 CONSYM { ITconsym $$ }
85 QVARID { ITqvarid $$ }
86 QCONID { ITqconid $$ }
87 QVARSYM { ITqvarsym $$ }
88 QCONSYM { ITqconsym $$ }
90 ARITY_PART { ITarity }
91 STRICT_PART { ITstrict }
92 UNFOLD_PART { ITunfold }
93 DEMAND { ITdemand $$ }
98 PRIM_CASE { ITprim_case }
104 COERCE_IN { ITcoerce_in }
105 COERCE_OUT { ITcoerce_out }
107 STRING { ITstring $$ }
108 DOUBLE { ITdouble $$ }
109 INTEGER_LIT { ITinteger_lit }
110 STRING_LIT { ITstring_lit }
111 FLOAT_LIT { ITfloat_lit }
112 RATIONAL_LIT { ITrational_lit }
113 ADDR_LIT { ITaddr_lit }
114 LIT_LIT { ITlit_lit }
118 iface :: { ParsedIface }
119 iface : INTERFACE CONID INTEGER
122 exports_part fixities_part
127 (fromInteger $3) -- Module version
130 $4 -- Instance modules
133 $8 -- Local instances
137 usages_part :: { [ImportVersion OccName] }
138 usages_part : USAGES_PART module_stuff_pairs { $2 }
141 module_stuff_pairs :: { [ImportVersion OccName] }
142 module_stuff_pairs : { [] }
143 | module_stuff_pair module_stuff_pairs { $1 : $2 }
145 module_stuff_pair :: { ImportVersion OccName }
146 module_stuff_pair : mod_name INTEGER DCOLON name_version_pairs SEMI
147 { ($1, fromInteger $2, $4) }
149 versions_part :: { [LocalVersion OccName] }
150 versions_part : VERSIONS_PART name_version_pairs { $2 }
153 name_version_pairs :: { [LocalVersion OccName] }
154 name_version_pairs : { [] }
155 | name_version_pair name_version_pairs { $1 : $2 }
157 name_version_pair :: { LocalVersion OccName }
158 name_version_pair : entity_occ INTEGER { ($1, fromInteger $2)
159 --------------------------------------------------------------------------
162 exports_part :: { [ExportItem] }
163 exports_part : EXPORTS_PART export_items { $2 }
166 export_items :: { [ExportItem] }
167 export_items : { [] }
168 | mod_name entities SEMI export_items { ($1,$2) : $4 }
170 entities :: { [(OccName, [OccName])] }
172 | entity entities { $1 : $2 }
174 entity :: { (OccName, [OccName]) }
175 entity : entity_occ maybe_inside { ($1, $2) }
177 maybe_inside :: { [OccName] }
178 maybe_inside : { [] }
179 | OPAREN val_occs CPAREN { $2
180 --------------------------------------------------------------------------
183 inst_modules_part :: { [Module] }
184 inst_modules_part : { [] }
185 | INSTANCE_MODULES_PART mod_list { $2 }
187 mod_list :: { [Module] }
189 | mod_name mod_list { $1 : $2
190 --------------------------------------------------------------------------
193 fixities_part :: { [(OccName,Fixity)] }
194 fixities_part : { [] }
195 | FIXITIES_PART fixes { $2 }
197 fixes :: { [(OccName,Fixity)] }
199 | fix fixes { $1 : $2 }
201 fix :: { (OccName, Fixity) }
202 fix : INFIXL INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixL) }
203 | INFIXR INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixR) }
204 | INFIX INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixN)
205 --------------------------------------------------------------------------
208 decls_part :: { [(Version, RdrNameHsDecl)] }
210 | DECLARATIONS_PART topdecls { $2 }
212 topdecls :: { [(Version, RdrNameHsDecl)] }
214 | version topdecl topdecls { ($1,$2) : $3 }
216 version :: { Version }
217 version : INTEGER { fromInteger $1 }
219 topdecl :: { RdrNameHsDecl }
220 topdecl : TYPE tc_name tv_bndrs EQUAL type SEMI
221 { TyD (TySynonym $2 $3 $5 mkIfaceSrcLoc) }
222 | DATA decl_context tc_name tv_bndrs EQUAL constrs deriving SEMI
223 { TyD (TyData $2 $3 $4 $6 $7 noDataPragmas mkIfaceSrcLoc) }
224 | NEWTYPE decl_context tc_name tv_bndrs EQUAL constr1 deriving SEMI
225 { TyD (TyNew $2 $3 $4 $6 $7 noDataPragmas mkIfaceSrcLoc) }
226 | CLASS decl_context tc_name tv_bndr csigs SEMI
227 { ClD (ClassDecl $2 $3 $4 $5 EmptyMonoBinds noClassPragmas mkIfaceSrcLoc) }
228 | var_name DCOLON type id_info SEMI SEMI
229 { {- Double semicolon allows easy pragma discard in lexer -}
231 id_info = if opt_IgnoreIfacePragmas then [] else $4
233 SigD (IfaceSig $1 $3 id_info mkIfaceSrcLoc) }
235 decl_context :: { RdrNameContext }
236 decl_context : { [] }
237 | OCURLY context_list1 CCURLY DARROW { $2 }
239 csigs :: { [RdrNameSig] }
241 | WHERE OCURLY csigs1 CCURLY { $3 }
243 csigs1 :: { [RdrNameSig] }
244 csigs1 : csig { [$1] }
245 | csig SEMI csigs1 { $1 : $3 }
247 csig :: { RdrNameSig }
248 csig : var_name DCOLON type { ClassOpSig $1 $3 noClassOpPragmas mkIfaceSrcLoc
249 ----------------------------------------------------------------
252 constrs :: { [RdrNameConDecl] }
253 constrs : constr { [$1] }
254 | constr VBAR constrs { $1 : $3 }
256 constr :: { RdrNameConDecl }
257 constr : data_name batypes { ConDecl $1 $2 mkIfaceSrcLoc }
258 | data_name OCURLY fields1 CCURLY { RecConDecl $1 $3 mkIfaceSrcLoc }
260 constr1 :: { RdrNameConDecl {- For a newtype -} }
261 constr1 : data_name atype { NewConDecl $1 $2 mkIfaceSrcLoc }
263 deriving :: { Maybe [RdrName] }
265 | DERIVING OPAREN qtc_names1 CPAREN { Just $3 }
267 batypes :: { [RdrNameBangType] }
269 | batype batypes { $1 : $2 }
271 batype :: { RdrNameBangType }
272 batype : atype { Unbanged $1 }
273 | BANG atype { Banged $2 }
275 fields1 :: { [([RdrName], RdrNameBangType)] }
276 fields1 : field { [$1] }
277 | field COMMA fields1 { $1 : $3 }
279 field :: { ([RdrName], RdrNameBangType) }
280 field : var_names1 DCOLON type { ($1, Unbanged $3) }
281 | var_names1 DCOLON BANG type { ($1, Banged $4)
282 --------------------------------------------------------------------------
285 forall :: { [HsTyVar RdrName] }
286 forall : OBRACK tv_bndrs CBRACK { $2 }
288 context :: { RdrNameContext }
290 | OCURLY context_list1 CCURLY { $2 }
292 context_list1 :: { RdrNameContext }
293 context_list1 : class { [$1] }
294 | class COMMA context_list1 { $1 : $3 }
296 class :: { (RdrName, RdrNameHsType) }
297 class : qtc_name atype { ($1, $2) }
299 type :: { RdrNameHsType }
300 type : FORALL forall context DARROW type { mkHsForAllTy $2 $3 $5 }
303 tautype :: { RdrNameHsType }
304 tautype : btype { $1 }
305 | btype RARROW tautype { MonoFunTy $1 $3 }
307 types2 :: { [RdrNameHsType] {- Two or more -} }
308 types2 : type COMMA type { [$1,$3] }
309 | type COMMA types2 { $1 : $3 }
311 btype :: { RdrNameHsType }
313 | btype atype { MonoTyApp $1 $2 }
315 atype :: { RdrNameHsType }
316 atype : qtc_name { MonoTyVar $1 }
317 | tv_name { MonoTyVar $1 }
318 | OPAREN types2 CPAREN { MonoTupleTy dummyRdrTcName $2 }
319 | OBRACK type CBRACK { MonoListTy dummyRdrTcName $2 }
320 | OCURLY qtc_name atype CCURLY { MonoDictTy $2 $3 }
321 | OPAREN type CPAREN { $2 }
323 atypes :: { [RdrNameHsType] {- Zero or more -} }
325 | atype atypes { $1 : $2
326 ---------------------------------------------------------------------
329 mod_name :: { Module }
332 var_occ :: { OccName }
333 var_occ : VARID { VarOcc $1 }
334 | VARSYM { VarOcc $1 }
335 | BANG { VarOcc SLIT("!") {-sigh, double-sigh-} }
337 tc_occ :: { OccName }
338 tc_occ : CONID { TCOcc $1 }
339 | CONSYM { TCOcc $1 }
340 | OPAREN RARROW CPAREN { TCOcc SLIT("->") }
342 entity_occ :: { OccName }
343 entity_occ : var_occ { $1 }
345 | RARROW { TCOcc SLIT("->") {- Allow un-paren'd arrow -} }
347 val_occ :: { OccName }
348 val_occ : var_occ { $1 }
349 | CONID { VarOcc $1 }
350 | CONSYM { VarOcc $1 }
352 val_occs :: { [OccName] }
354 | val_occ val_occs { $1 : $2 }
357 qvar_name :: { RdrName }
358 : QVARID { varQual $1 }
359 | QVARSYM { varQual $1 }
361 var_name :: { RdrName }
362 var_name : var_occ { Unqual $1 }
364 var_names1 :: { [RdrName] }
365 var_names1 : var_name { [$1] }
366 | var_name var_names1 { $1 : $2 }
368 any_var_name :: {RdrName}
369 any_var_name : var_name { $1 }
372 qdata_name :: { RdrName }
373 qdata_name : QCONID { varQual $1 }
374 | QCONSYM { varQual $1 }
376 data_name :: { RdrName }
377 data_name : CONID { Unqual (VarOcc $1) }
378 | CONSYM { Unqual (VarOcc $1) }
381 qtc_name :: { RdrName }
382 qtc_name : QCONID { tcQual $1 }
384 qtc_names1 :: { [RdrName] }
386 | qtc_name COMMA qtc_names1 { $1 : $3 }
388 tc_name :: { RdrName }
389 tc_name : tc_occ { Unqual $1 }
391 tv_name :: { RdrName }
392 tv_name : VARID { Unqual (TvOcc $1) }
394 tv_names :: { [RdrName] }
396 | tv_name tv_names { $1 : $2 }
398 tv_bndr :: { HsTyVar RdrName }
399 tv_bndr : tv_name DCOLON akind { IfaceTyVar $1 $3 }
400 | tv_name { UserTyVar $1 }
402 tv_bndrs :: { [HsTyVar RdrName] }
404 | tv_bndr tv_bndrs { $1 : $2 }
408 | akind RARROW kind { mkArrowKind $1 $3 }
411 : VARSYM { mkTypeKind {- ToDo: check that it's "*" -} }
412 | OPAREN kind CPAREN { $2
413 --------------------------------------------------------------------------
417 instances_part :: { [RdrNameInstDecl] }
418 instances_part : INSTANCES_PART instdecls { $2 }
421 instdecls :: { [RdrNameInstDecl] }
423 | instd instdecls { $1 : $2 }
425 instd :: { RdrNameInstDecl }
426 instd : INSTANCE type EQUAL var_name SEMI
428 EmptyMonoBinds {- No bindings -}
429 [] {- No user pragmas -}
430 (Just $4) {- Dfun id -}
432 --------------------------------------------------------------------------
435 id_info :: { [HsIdInfo RdrName] }
437 | id_info_item id_info { $1 : $2 }
439 id_info_item :: { HsIdInfo RdrName }
440 id_info_item : ARITY_PART arity_info { HsArity $2 }
441 | STRICT_PART strict_info { HsStrictness $2 }
442 | BOTTOM { HsStrictness mkBottomStrictnessInfo }
443 | UNFOLD_PART core_expr { HsUnfold $2 }
445 arity_info :: { ArityInfo }
446 arity_info : INTEGER { exactArity (fromInteger $1) }
448 strict_info :: { StrictnessInfo RdrName }
449 strict_info : DEMAND any_var_name { mkStrictnessInfo $1 (Just $2) }
450 | DEMAND { mkStrictnessInfo $1 Nothing }
452 core_expr :: { UfExpr RdrName }
453 core_expr : any_var_name { UfVar $1 }
454 | qdata_name { UfVar $1 }
455 | core_lit { UfLit $1 }
456 | OPAREN core_expr CPAREN { $2 }
458 | core_expr ATSIGN atype { UfApp $1 (UfTyArg $3) }
459 | core_expr core_arg { UfApp $1 $2 }
460 | LAM core_val_bndrs RARROW core_expr { foldr UfLam $4 $2 }
461 | BIGLAM core_tv_bndrs RARROW core_expr { foldr UfLam $4 $2 }
464 OCURLY alg_alts core_default CCURLY { UfCase $2 (UfAlgAlts $5 $6) }
465 | PRIM_CASE core_expr OF
466 OCURLY prim_alts core_default CCURLY { UfCase $2 (UfPrimAlts $5 $6) }
469 | LET OCURLY core_val_bndr EQUAL core_expr CCURLY
470 IN core_expr { UfLet (UfNonRec $3 $5) $8 }
471 | LETREC OCURLY rec_binds CCURLY
472 IN core_expr { UfLet (UfRec $3) $6 }
474 | coerce atype core_expr { UfCoerce $1 $2 $3 }
477 OBRACK atype atypes CBRACK core_args { let
478 (is_casm, may_gc) = $1
480 UfPrim (UfCCallOp $2 is_casm may_gc $5 $4)
484 rec_binds :: { [(UfBinder RdrName, UfExpr RdrName)] }
486 | core_val_bndr EQUAL core_expr SEMI rec_binds { ($1,$3) : $5 }
488 coerce :: { UfCoercion RdrName }
489 coerce : COERCE_IN qdata_name { UfIn $2 }
490 | COERCE_OUT qdata_name { UfOut $2 }
492 prim_alts :: { [(Literal,UfExpr RdrName)] }
494 | core_lit RARROW core_expr SEMI prim_alts { ($1,$3) : $5 }
496 alg_alts :: { [(RdrName, [UfBinder RdrName], UfExpr RdrName)] }
498 | qdata_name core_val_bndrs RARROW
499 core_expr SEMI alg_alts { ($1,$2,$4) : $6 }
501 core_default :: { UfDefault RdrName }
503 | core_val_bndr RARROW core_expr SEMI { UfBindDefault $1 $3 }
505 core_arg :: { UfArg RdrName }
506 : var_name { UfVarArg $1 }
507 | qvar_name { UfVarArg $1 }
508 | qdata_name { UfVarArg $1 }
509 | core_lit { UfLitArg $1 }
511 core_args :: { [UfArg RdrName] }
513 | core_arg core_args { $1 : $2 }
515 core_lit :: { Literal }
516 core_lit : INTEGER { MachInt $1 True }
517 | CHAR { MachChar $1 }
518 | STRING { MachStr $1 }
519 | STRING_LIT STRING { NoRepStr $2 }
520 | DOUBLE { MachDouble (toRational $1) }
521 | FLOAT_LIT DOUBLE { MachFloat (toRational $2) }
523 | INTEGER_LIT INTEGER { NoRepInteger $2 (panic "NoRepInteger type")
524 -- The type checker will add the types
527 | RATIONAL_LIT INTEGER INTEGER { NoRepRational ($2 % $3)
528 (panic "NoRepRational type")
529 -- The type checker will add the type
532 | ADDR_LIT INTEGER { MachAddr $2 }
533 | LIT_LIT STRING { MachLitLit $2 (panic "ParseIface.y: ToDo: need PrimRep on LitLits in ifaces") }
535 core_val_bndr :: { UfBinder RdrName }
536 core_val_bndr : var_name DCOLON atype { UfValBinder $1 $3 }
538 core_val_bndrs :: { [UfBinder RdrName] }
539 core_val_bndrs : { [] }
540 | core_val_bndr core_val_bndrs { $1 : $2 }
542 core_tv_bndr :: { UfBinder RdrName }
543 core_tv_bndr : tv_name DCOLON akind { UfTyBinder $1 $3 }
544 | tv_name { UfTyBinder $1 mkTypeKind }
546 core_tv_bndrs :: { [UfBinder RdrName] }
547 core_tv_bndrs : { [] }
548 | core_tv_bndr core_tv_bndrs { $1 : $2 }
550 ccall_string :: { FAST_STRING }