2 #include "HsVersions.h"
4 module ParseIface ( parseIface ) where
8 import HsSyn -- quite a bit of stuff
9 import RdrHsSyn -- oodles of synonyms
10 import HsDecls ( HsIdInfo(..) )
11 import HsTypes ( mkHsForAllTy )
14 import HsPragmas ( noGenPragmas, noDataPragmas, noClassPragmas, noClassOpPragmas, noInstancePragmas )
15 import IdInfo ( exactArity, mkStrictnessInfo, mkBottomStrictnessInfo,
16 ArgUsageInfo, FBTypeInfo
18 import Kind ( Kind, mkArrowKind, mkTypeKind )
21 import RnMonad ( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
22 SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
24 import Bag ( emptyBag, unitBag, snocBag )
25 import FiniteMap ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
26 import Name ( OccName(..), Provenance )
27 import SrcLoc ( mkIfaceSrcLoc )
28 import Util ( panic{-, pprPanic ToDo:rm-} )
31 -----------------------------------------------------------------
33 parseIface = parseIToks . lexIface
35 -----------------------------------------------------------------
39 %tokentype { IfaceToken }
40 %monad { IfM }{ thenIf }{ returnIf }
43 INTERFACE { ITinterface }
44 USAGES_PART { ITusages }
45 VERSIONS_PART { ITversions }
46 EXPORTS_PART { ITexports }
47 INSTANCE_MODULES_PART { ITinstance_modules }
48 INSTANCES_PART { ITinstances }
49 FIXITIES_PART { ITfixities }
50 DECLARATIONS_PART { ITdeclarations }
51 PRAGMAS_PART { ITpragmas }
61 DERIVING { ITderiving }
68 INSTANCE { ITinstance }
78 INTEGER { ITinteger $$ }
81 VARSYM { ITvarsym $$ }
82 CONSYM { ITconsym $$ }
83 QVARID { ITqvarid $$ }
84 QCONID { ITqconid $$ }
85 QVARSYM { ITqvarsym $$ }
86 QCONSYM { ITqconsym $$ }
88 ARITY_PART { ITarity }
89 STRICT_PART { ITstrict }
90 UNFOLD_PART { ITunfold }
91 DEMAND { ITdemand $$ }
100 COERCE_IN { ITcoerce_in }
101 COERCE_OUT { ITcoerce_out }
103 STRING { ITstring $$ }
106 iface :: { ParsedIface }
107 iface : INTERFACE CONID INTEGER
110 exports_part fixities_part
115 (fromInteger $3) -- Module version
118 $4 -- Instance modules
121 $8 -- Local instances
125 usages_part :: { [ImportVersion OccName] }
126 usages_part : USAGES_PART module_stuff_pairs { $2 }
129 module_stuff_pairs :: { [ImportVersion OccName] }
130 module_stuff_pairs : { [] }
131 | module_stuff_pair module_stuff_pairs { $1 : $2 }
133 module_stuff_pair :: { ImportVersion OccName }
134 module_stuff_pair : mod_name INTEGER DCOLON name_version_pairs SEMI
135 { ($1, fromInteger $2, $4) }
137 versions_part :: { [LocalVersion OccName] }
138 versions_part : VERSIONS_PART name_version_pairs { $2 }
141 name_version_pairs :: { [LocalVersion OccName] }
142 name_version_pairs : { [] }
143 | name_version_pair name_version_pairs { $1 : $2 }
145 name_version_pair :: { LocalVersion OccName }
146 name_version_pair : entity_occ INTEGER { ($1, fromInteger $2)
147 --------------------------------------------------------------------------
150 exports_part :: { [ExportItem] }
151 exports_part : EXPORTS_PART export_items { $2 }
154 export_items :: { [ExportItem] }
155 export_items : { [] }
156 | export_item export_items { $1 : $2 }
158 export_item :: { ExportItem }
159 export_item : mod_name entity_occ maybe_dotdot { ($1, $2, $3) }
161 maybe_dotdot :: { [OccName] }
162 maybe_dotdot : { [] }
163 | OPAREN val_occs CPAREN { $2
164 --------------------------------------------------------------------------
167 inst_modules_part :: { [Module] }
168 inst_modules_part : { [] }
169 | INSTANCE_MODULES_PART mod_list { $2 }
171 mod_list :: { [Module] }
173 | mod_name mod_list { $1 : $2
174 --------------------------------------------------------------------------
177 fixities_part :: { [(OccName,Fixity)] }
178 fixities_part : { [] }
179 | FIXITIES_PART fixes { $2 }
181 fixes :: { [(OccName,Fixity)] }
183 | fix fixes { $1 : $2 }
185 fix :: { (OccName, Fixity) }
186 fix : INFIXL INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixL) }
187 | INFIXR INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixR) }
188 | INFIX INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixN)
189 --------------------------------------------------------------------------
192 decls_part :: { [(Version, RdrNameHsDecl)] }
194 | DECLARATIONS_PART topdecls { $2 }
196 topdecls :: { [(Version, RdrNameHsDecl)] }
198 | version topdecl topdecls { ($1,$2) : $3 }
200 version :: { Version }
201 version : INTEGER { fromInteger $1 }
203 topdecl :: { RdrNameHsDecl }
204 topdecl : TYPE tc_name tv_bndrs EQUAL type SEMI
205 { TyD (TySynonym $2 $3 $5 mkIfaceSrcLoc) }
206 | DATA decl_context tc_name tv_bndrs EQUAL constrs deriving SEMI
207 { TyD (TyData $2 $3 $4 $6 $7 noDataPragmas mkIfaceSrcLoc) }
208 | NEWTYPE decl_context tc_name tv_bndrs EQUAL constr1 deriving SEMI
209 { TyD (TyNew $2 $3 $4 $6 $7 noDataPragmas mkIfaceSrcLoc) }
210 | CLASS decl_context tc_name tv_bndr csigs SEMI
211 { ClD (ClassDecl $2 $3 $4 $5 EmptyMonoBinds noClassPragmas mkIfaceSrcLoc) }
212 | var_name DCOLON ctype id_info SEMI
213 { SigD (IfaceSig $1 $3 $4 mkIfaceSrcLoc) }
215 decl_context :: { RdrNameContext }
216 decl_context : { [] }
217 | OCURLY context_list1 CCURLY DARROW { $2 }
219 csigs :: { [RdrNameSig] }
221 | WHERE OCURLY csigs1 CCURLY { $3 }
223 csigs1 :: { [RdrNameSig] }
224 csigs1 : csig { [$1] }
225 | csig SEMI csigs1 { $1 : $3 }
227 csig :: { RdrNameSig }
228 csig : var_name DCOLON ctype { ClassOpSig $1 $3 noClassOpPragmas mkIfaceSrcLoc
229 ----------------------------------------------------------------
232 constrs :: { [RdrNameConDecl] }
233 constrs : constr { [$1] }
234 | constr VBAR constrs { $1 : $3 }
236 constr :: { RdrNameConDecl }
237 constr : data_name batypes { ConDecl $1 $2 mkIfaceSrcLoc }
238 | data_name OCURLY fields1 CCURLY { RecConDecl $1 $3 mkIfaceSrcLoc }
240 constr1 :: { RdrNameConDecl {- For a newtype -} }
241 constr1 : data_name atype { NewConDecl $1 $2 mkIfaceSrcLoc }
243 deriving :: { Maybe [RdrName] }
245 | DERIVING OPAREN qtc_names1 CPAREN { Just $3 }
247 batypes :: { [RdrNameBangType] }
249 | batype batypes { $1 : $2 }
251 batype :: { RdrNameBangType }
252 batype : atype { Unbanged $1 }
253 | BANG atype { Banged $2 }
255 fields1 :: { [([RdrName], RdrNameBangType)] }
256 fields1 : field { [$1] }
257 | field COMMA fields1 { $1 : $3 }
259 field :: { ([RdrName], RdrNameBangType) }
260 field : var_name DCOLON ctype { ([$1], Unbanged $3) }
261 | var_name DCOLON BANG ctype { ([$1], Banged $4)
262 --------------------------------------------------------------------------
265 forall :: { [HsTyVar RdrName] }
266 forall : OBRACK tv_bndrs CBRACK { $2 }
268 context :: { RdrNameContext }
270 | OCURLY context_list1 CCURLY { $2 }
272 context_list1 :: { RdrNameContext }
273 context_list1 : class { [$1] }
274 | class COMMA context_list1 { $1 : $3 }
276 class :: { (RdrName, RdrNameHsType) }
277 class : qtc_name atype { ($1, $2) }
279 ctype :: { RdrNameHsType }
280 ctype : FORALL forall context DARROW type { mkHsForAllTy $2 $3 $5 }
283 type :: { RdrNameHsType }
285 | btype RARROW type { MonoFunTy $1 $3 }
287 ctypes2 :: { [RdrNameHsType] {- Two or more -} }
288 ctypes2 : ctype COMMA ctype { [$1,$3] }
289 | ctype COMMA ctypes2 { $1 : $3 }
291 btype :: { RdrNameHsType }
293 | qtc_name atypes1 { MonoTyApp $1 $2 }
294 | tv_name atypes1 { MonoTyApp $1 $2 }
296 atype :: { RdrNameHsType }
297 atype : qtc_name { MonoTyApp $1 [] }
298 | tv_name { MonoTyVar $1 }
299 | OPAREN ctypes2 CPAREN { MonoTupleTy dummyRdrTcName $2 }
300 | OBRACK type CBRACK { MonoListTy dummyRdrTcName $2 }
301 | OCURLY qtc_name atype CCURLY { MonoDictTy $2 $3 }
302 | OPAREN ctype CPAREN { $2 }
304 atypes1 :: { [RdrNameHsType] {- One or more -} }
305 atypes1 : atype { [$1] }
306 | atype atypes1 { $1 : $2
307 ---------------------------------------------------------------------
310 mod_name :: { Module }
313 var_occ :: { OccName }
314 var_occ : VARID { VarOcc $1 }
315 | VARSYM { VarOcc $1 }
316 | BANG { VarOcc SLIT("!") {-sigh, double-sigh-} }
318 entity_occ :: { OccName }
319 entity_occ : var_occ { $1 }
321 | CONSYM { TCOcc $1 }
323 val_occ :: { OccName }
324 val_occ : var_occ { $1 }
325 | CONID { VarOcc $1 }
326 | CONSYM { VarOcc $1 }
328 val_occs :: { [OccName] }
330 | val_occ val_occs { $1 : $2 }
333 qvar_name :: { RdrName }
334 : QVARID { varQual $1 }
335 | QVARSYM { varQual $1 }
337 var_name :: { RdrName }
338 var_name : var_occ { Unqual $1 }
341 qdata_name :: { RdrName }
342 qdata_name : QCONID { varQual $1 }
343 | QCONSYM { varQual $1 }
345 data_name :: { RdrName }
346 data_name : CONID { Unqual (VarOcc $1) }
347 | CONSYM { Unqual (VarOcc $1) }
350 qtc_name :: { RdrName }
351 qtc_name : QCONID { tcQual $1 }
353 qtc_names1 :: { [RdrName] }
355 | qtc_name COMMA qtc_names1 { $1 : $3 }
357 tc_name :: { RdrName }
358 tc_name : CONID { Unqual (TCOcc $1) }
361 tv_name :: { RdrName }
362 tv_name : VARID { Unqual (TvOcc $1) }
364 tv_names :: { [RdrName] }
366 | tv_name tv_names { $1 : $2 }
368 tv_bndr :: { HsTyVar RdrName }
369 tv_bndr : tv_name DCOLON akind { IfaceTyVar $1 $3 }
370 | tv_name { UserTyVar $1 }
372 tv_bndrs :: { [HsTyVar RdrName] }
374 | tv_bndr tv_bndrs { $1 : $2 }
378 | akind RARROW kind { mkArrowKind $1 $3 }
381 : VARSYM { mkTypeKind {- ToDo: check that it's "*" -} }
382 | OPAREN kind CPAREN { $2
383 --------------------------------------------------------------------------
387 instances_part :: { [RdrNameInstDecl] }
388 instances_part : INSTANCES_PART instdecls { $2 }
391 instdecls :: { [RdrNameInstDecl] }
393 | instd instdecls { $1 : $2 }
395 instd :: { RdrNameInstDecl }
396 instd : INSTANCE ctype EQUAL var_name SEMI
398 EmptyMonoBinds {- No bindings -}
399 [] {- No user pragmas -}
400 (Just $4) {- Dfun id -}
402 --------------------------------------------------------------------------
405 id_info :: { [HsIdInfo RdrName] }
407 | ARITY_PART arity_info id_info { HsArity $2 : $3 }
408 | STRICT_PART strict_info id_info { HsStrictness $2 : $3 }
409 | UNFOLD_PART core_expr id_info { HsUnfold $2 : $3 }
411 arity_info :: { ArityInfo }
412 arity_info : INTEGER { exactArity (fromInteger $1) }
414 strict_info :: { StrictnessInfo RdrName }
415 strict_info : DEMAND qvar_name { mkStrictnessInfo $1 (Just $2) }
416 | DEMAND { mkStrictnessInfo $1 Nothing }
417 | BOTTOM { mkBottomStrictnessInfo }
419 core_expr :: { UfExpr RdrName }
420 core_expr : var_name { UfVar $1 }
421 | qvar_name { UfVar $1 }
422 | qdata_name { UfVar $1 }
423 | core_lit { UfLit $1 }
424 | core_expr core_arg { UfApp $1 $2 }
425 | LAM core_val_bndr RARROW core_expr { UfLam $2 $4 }
426 | BIGLAM core_tv_bndrs RARROW core_expr { foldr UfLam $4 $2 }
429 OCURLY alg_alts core_default CCURLY { UfCase $2 (UfAlgAlts $5 $6) }
430 | CASE BANG core_expr OF
431 OCURLY prim_alts core_default CCURLY { UfCase $3 (UfPrimAlts $6 $7) }
433 | LET OCURLY core_val_bndr EQUAL core_expr CCURLY
434 IN core_expr { UfLet (UfNonRec $3 $5) $8 }
435 | LETREC OCURLY rec_binds CCURLY
436 IN core_expr { UfLet (UfRec $3) $6 }
438 | qdata_name BANG core_args { UfCon $1 $3 }
439 | qvar_name BANG core_args { UfPrim (UfOtherOp $1) $3 }
440 | coerce atype core_expr { UfCoerce $1 $2 $3 }
442 rec_binds :: { [(UfBinder RdrName, UfExpr RdrName)] }
444 | core_val_bndr EQUAL core_expr SEMI rec_binds { ($1,$3) : $5 }
446 coerce :: { UfCoercion RdrName }
447 coerce : COERCE_IN qdata_name { UfIn $2 }
448 | COERCE_OUT qdata_name { UfOut $2 }
450 prim_alts :: { [(Literal,UfExpr RdrName)] }
452 | core_lit RARROW core_expr SEMI prim_alts { ($1,$3) : $5 }
454 alg_alts :: { [(RdrName, [UfBinder RdrName], UfExpr RdrName)] }
456 | qdata_name core_val_bndrs RARROW
457 core_expr SEMI alg_alts { ($1,$2,$4) : $6 }
459 core_default :: { UfDefault RdrName }
461 | core_val_bndr RARROW core_expr { UfBindDefault $1 $3 }
463 core_arg :: { UfArg RdrName }
464 : var_name { UfVarArg $1 }
465 | qvar_name { UfVarArg $1 }
466 | qdata_name { UfVarArg $1 }
467 | core_lit { UfLitArg $1 }
468 | OBRACK atype CBRACK { UfTyArg $2 }
470 core_args :: { [UfArg RdrName] }
472 | core_arg core_args { $1 : $2 }
474 core_lit :: { Literal }
475 core_lit : INTEGER { MachInt $1 True }
476 | CHAR { MachChar $1 }
477 | STRING { MachStr $1 }
479 core_val_bndr :: { UfBinder RdrName }
480 core_val_bndr : var_name DCOLON atype { UfValBinder $1 $3 }
482 core_val_bndrs :: { [UfBinder RdrName] }
483 core_val_bndrs : { [] }
484 | core_val_bndr core_val_bndrs { $1 : $2 }
486 core_tv_bndr :: { UfBinder RdrName }
487 core_tv_bndr : tv_name DCOLON akind { UfTyBinder $1 $3 }
488 | tv_name { UfTyBinder $1 mkTypeKind }
490 core_tv_bndrs :: { [UfBinder RdrName] }
491 core_tv_bndrs : { [] }
492 | core_tv_bndr core_tv_bndrs { $1 : $2 }