2 #include "HsVersions.h"
3 module ParseIface ( parseIface ) where
7 import CmdLineOpts ( opt_IgnoreIfacePragmas )
9 import HsSyn -- quite a bit of stuff
10 import RdrHsSyn -- oodles of synonyms
11 import HsDecls ( HsIdInfo(..) )
12 import HsTypes ( mkHsForAllTy )
15 import BasicTypes ( Fixity(..), FixityDirection(..), NewOrData(..), Version(..) )
16 import HsPragmas ( noGenPragmas, noDataPragmas, noClassPragmas, noClassOpPragmas, noInstancePragmas )
17 import IdInfo ( exactArity, mkStrictnessInfo, mkBottomStrictnessInfo,
18 ArgUsageInfo, FBTypeInfo, ArityInfo, StrictnessInfo
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(..), isTCOcc, Provenance, SYN_IE(Module) )
29 import SrcLoc ( mkIfaceSrcLoc )
30 import Util ( panic{-, pprPanic ToDo:rm-} )
31 import ParseType ( parseType )
32 import ParseUnfolding ( parseUnfolding )
35 -----------------------------------------------------------------
37 parseIface ls = parseIToks (lexIface ls)
39 -----------------------------------------------------------------
43 %tokentype { IfaceToken }
44 %monad { IfM }{ thenIf }{ returnIf }
47 INTERFACE { ITinterface }
48 USAGES_PART { ITusages }
49 VERSIONS_PART { ITversions }
50 EXPORTS_PART { ITexports }
51 INSTANCE_MODULES_PART { ITinstance_modules }
52 INSTANCES_PART { ITinstances }
53 FIXITIES_PART { ITfixities }
54 DECLARATIONS_PART { ITdeclarations }
55 PRAGMAS_PART { ITpragmas }
59 DERIVING { ITderiving }
62 INSTANCE { ITinstance }
85 VARSYM { ITvarsym $$ }
86 CONSYM { ITconsym $$ }
87 QVARID { ITqvarid $$ }
88 QCONID { ITqconid $$ }
89 QVARSYM { ITqvarsym $$ }
90 QCONSYM { ITqconsym $$ }
92 IDINFO_PART { ITidinfo $$ }
93 TYPE_PART { ITtysig $$ }
94 ARITY_PART { ITarity }
95 STRICT_PART { ITstrict }
96 UNFOLD_PART { ITunfold $$ }
97 DEMAND { ITdemand $$ }
102 PRIM_CASE { ITprim_case }
107 COERCE_IN { ITcoerce_in }
108 COERCE_OUT { ITcoerce_out }
114 STRING { ITstring $$ }
115 INTEGER { ITinteger $$ }
116 DOUBLE { ITdouble $$ }
118 INTEGER_LIT { ITinteger_lit }
119 FLOAT_LIT { ITfloat_lit }
120 RATIONAL_LIT { ITrational_lit }
121 ADDR_LIT { ITaddr_lit }
122 LIT_LIT { ITlit_lit }
123 STRING_LIT { ITstring_lit }
125 UNKNOWN { ITunknown $$ }
128 iface :: { ParsedIface }
129 iface : INTERFACE CONID INTEGER
132 exports_part fixities_part
137 (fromInteger $3) -- Module version
140 $4 -- Instance modules
143 $8 -- 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 INTEGER DCOLON name_version_pairs SEMI
157 { ($1, fromInteger $2, $4) }
159 versions_part :: { [LocalVersion OccName] }
160 versions_part : VERSIONS_PART name_version_pairs { $2 }
163 name_version_pairs :: { [LocalVersion OccName] }
164 name_version_pairs : { [] }
165 | name_version_pair name_version_pairs { $1 : $2 }
167 name_version_pair :: { LocalVersion OccName }
168 name_version_pair : entity_occ INTEGER { ($1, fromInteger $2)
169 --------------------------------------------------------------------------
172 exports_part :: { [ExportItem] }
173 exports_part : EXPORTS_PART export_items { $2 }
176 export_items :: { [ExportItem] }
177 export_items : { [] }
178 | mod_name entities SEMI export_items { ($1,$2) : $4 }
180 entities :: { [(OccName, [OccName])] }
182 | entity entities { $1 : $2 }
184 entity :: { (OccName, [OccName]) }
185 entity : entity_occ { ($1, if isTCOcc $1
186 then [$1] {- AvailTC -}
187 else []) {- Avail -} }
188 | entity_occ stuff_inside { ($1, ($1 : $2)) {- TyCls exported too -} }
189 | entity_occ BANG stuff_inside { ($1, $3) {- TyCls not exported -} }
191 stuff_inside :: { [OccName] }
192 stuff_inside : OPAREN val_occs1 CPAREN { $2
193 --------------------------------------------------------------------------
196 inst_modules_part :: { [Module] }
197 inst_modules_part : { [] }
198 | INSTANCE_MODULES_PART mod_list { $2 }
200 mod_list :: { [Module] }
202 | mod_name mod_list { $1 : $2
203 --------------------------------------------------------------------------
206 fixities_part :: { [(OccName,Fixity)] }
207 fixities_part : { [] }
208 | FIXITIES_PART fixes { $2 }
210 fixes :: { [(OccName,Fixity)] }
212 | fix fixes { $1 : $2 }
214 fix :: { (OccName, Fixity) }
215 fix : INFIXL INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixL) }
216 | INFIXR INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixR) }
217 | INFIX INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixN)
218 --------------------------------------------------------------------------
221 decls_part :: { [(Version, RdrNameHsDecl)] }
223 | DECLARATIONS_PART topdecls { $2 }
225 topdecls :: { [(Version, RdrNameHsDecl)] }
227 | version topdecl topdecls { ($1,$2) : $3 }
229 version :: { Version }
230 version : INTEGER { fromInteger $1 }
232 topdecl :: { RdrNameHsDecl }
233 topdecl : TYPE tc_name tv_bndrs EQUAL type SEMI
234 { TyD (TySynonym $2 $3 $5 mkIfaceSrcLoc) }
235 | DATA decl_context tc_name tv_bndrs constrs deriving SEMI
236 { TyD (TyData DataType $2 $3 $4 $5 $6 noDataPragmas mkIfaceSrcLoc) }
237 | NEWTYPE decl_context tc_name tv_bndrs newtype_constr deriving SEMI
238 { TyD (TyData NewType $2 $3 $4 $5 $6 noDataPragmas mkIfaceSrcLoc) }
239 | CLASS decl_context tc_name tv_bndr csigs SEMI
240 { ClD (ClassDecl $2 $3 $4 $5 EmptyMonoBinds noClassPragmas mkIfaceSrcLoc) }
241 | var_name TYPE_PART id_info
244 (Succeeded tp) = parseType $2
246 SigD (IfaceSig $1 tp $3 mkIfaceSrcLoc) }
248 id_info :: { [HsIdInfo RdrName] }
250 | IDINFO_PART { let { (Succeeded id_info) = parseUnfolding $1 } in id_info}
252 decl_context :: { RdrNameContext }
253 decl_context : { [] }
254 | OCURLY context_list1 CCURLY DARROW { $2 }
257 csigs :: { [RdrNameSig] }
259 | WHERE OCURLY csigs1 CCURLY { $3 }
261 csigs1 :: { [RdrNameSig] }
262 csigs1 : csig { [$1] }
263 | csig SEMI csigs1 { $1 : $3 }
265 csig :: { RdrNameSig }
266 csig : var_name DCOLON type { ClassOpSig $1 $1 $3 mkIfaceSrcLoc
267 ----------------------------------------------------------------
270 constrs :: { [RdrNameConDecl] {- empty for handwritten abstract -} }
272 | EQUAL constrs1 { $2 }
274 constrs1 :: { [RdrNameConDecl] }
275 constrs1 : constr { [$1] }
276 | constr VBAR constrs1 { $1 : $3 }
278 constr :: { RdrNameConDecl }
279 constr : data_name batypes { ConDecl $1 [] (VanillaCon $2) mkIfaceSrcLoc }
280 | data_name OCURLY fields1 CCURLY { ConDecl $1 [] (RecCon $3) mkIfaceSrcLoc }
282 newtype_constr :: { [RdrNameConDecl] {- Empty if handwritten abstract -} }
283 newtype_constr : { [] }
284 | EQUAL data_name atype { [ConDecl $2 [] (NewCon $3) mkIfaceSrcLoc] }
286 deriving :: { Maybe [RdrName] }
288 | DERIVING OPAREN tc_names1 CPAREN { Just $3 }
290 batypes :: { [RdrNameBangType] }
292 | batype batypes { $1 : $2 }
294 batype :: { RdrNameBangType }
295 batype : atype { Unbanged $1 }
296 | BANG atype { Banged $2 }
298 fields1 :: { [([RdrName], RdrNameBangType)] }
299 fields1 : field { [$1] }
300 | field COMMA fields1 { $1 : $3 }
302 field :: { ([RdrName], RdrNameBangType) }
303 field : var_names1 DCOLON type { ($1, Unbanged $3) }
304 | var_names1 DCOLON BANG type { ($1, Banged $4)
305 --------------------------------------------------------------------------
308 forall :: { [HsTyVar RdrName] }
309 forall : OBRACK tv_bndrs CBRACK { $2 }
311 context :: { RdrNameContext }
313 | OCURLY context_list1 CCURLY { $2 }
315 context_list1 :: { RdrNameContext }
316 context_list1 : class { [$1] }
317 | class COMMA context_list1 { $1 : $3 }
319 class :: { (RdrName, RdrNameHsType) }
320 class : tc_name atype { ($1, $2) }
322 type :: { RdrNameHsType }
323 type : FORALL forall context DARROW type { mkHsForAllTy $2 $3 $5 }
324 | btype RARROW type { MonoFunTy $1 $3 }
327 types2 :: { [RdrNameHsType] {- Two or more -} }
328 types2 : type COMMA type { [$1,$3] }
329 | type COMMA types2 { $1 : $3 }
331 btype :: { RdrNameHsType }
333 | btype atype { MonoTyApp $1 $2 }
335 atype :: { RdrNameHsType }
336 atype : tc_name { MonoTyVar $1 }
337 | tv_name { MonoTyVar $1 }
338 | OPAREN types2 CPAREN { MonoTupleTy dummyRdrTcName $2 }
339 | OBRACK type CBRACK { MonoListTy dummyRdrTcName $2 }
340 | OCURLY tc_name atype CCURLY { MonoDictTy $2 $3 }
341 | OPAREN type CPAREN { $2 }
343 atypes :: { [RdrNameHsType] {- Zero or more -} }
345 | atype atypes { $1 : $2
346 ---------------------------------------------------------------------
349 mod_name :: { Module }
352 var_occ :: { OccName }
353 var_occ : VARID { VarOcc $1 }
354 | VARSYM { VarOcc $1 }
355 | BANG { VarOcc SLIT("!") {-sigh, double-sigh-} }
357 tc_occ :: { OccName }
358 tc_occ : CONID { TCOcc $1 }
359 | CONSYM { TCOcc $1 }
360 | OPAREN RARROW CPAREN { TCOcc SLIT("->") }
362 entity_occ :: { OccName }
363 entity_occ : var_occ { $1 }
365 | RARROW { TCOcc SLIT("->") {- Allow un-paren'd arrow -} }
367 val_occ :: { OccName }
368 val_occ : var_occ { $1 }
369 | CONID { VarOcc $1 }
370 | CONSYM { VarOcc $1 }
372 val_occs1 :: { [OccName] }
374 | val_occ val_occs1 { $1 : $2 }
377 qvar_name :: { RdrName }
378 : QVARID { varQual $1 }
379 | QVARSYM { varQual $1 }
381 var_name :: { RdrName }
382 var_name : var_occ { Unqual $1 }
384 var_names1 :: { [RdrName] }
385 var_names1 : var_name { [$1] }
386 | var_name var_names1 { $1 : $2 }
388 any_var_name :: {RdrName}
389 any_var_name : var_name { $1 }
392 qdata_name :: { RdrName }
393 qdata_name : QCONID { varQual $1 }
394 | QCONSYM { varQual $1 }
396 data_name :: { RdrName }
397 data_name : CONID { Unqual (VarOcc $1) }
398 | CONSYM { Unqual (VarOcc $1) }
401 tc_names1 :: { [RdrName] }
403 | tc_name COMMA tc_names1 { $1 : $3 }
405 tc_name :: { RdrName }
406 tc_name : tc_occ { Unqual $1 }
407 | QCONID { tcQual $1 }
409 tv_name :: { RdrName }
410 tv_name : VARID { Unqual (TvOcc $1) }
412 tv_names :: { [RdrName] }
414 | tv_name tv_names { $1 : $2 }
416 tv_bndr :: { HsTyVar RdrName }
417 tv_bndr : tv_name DCOLON akind { IfaceTyVar $1 $3 }
418 | tv_name { UserTyVar $1 }
420 tv_bndrs :: { [HsTyVar RdrName] }
422 | tv_bndr tv_bndrs { $1 : $2 }
426 | akind RARROW kind { mkArrowKind $1 $3 }
429 : VARSYM { mkTypeKind {- ToDo: check that it's "*" -} }
430 | OPAREN kind CPAREN { $2
431 --------------------------------------------------------------------------
435 instances_part :: { [RdrNameInstDecl] }
436 instances_part : INSTANCES_PART instdecls { $2 }
439 instdecls :: { [RdrNameInstDecl] }
441 | instd instdecls { $1 : $2 }
443 instd :: { RdrNameInstDecl }
444 instd : INSTANCE type EQUAL var_name SEMI
446 EmptyMonoBinds {- No bindings -}
447 [] {- No user pragmas -}
448 (Just $4) {- Dfun id -}
450 --------------------------------------------------------------------------