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 HsPragmas ( noGenPragmas, noDataPragmas, noClassPragmas, noClassOpPragmas, noInstancePragmas )
16 import IdInfo ( exactArity, mkStrictnessInfo, mkBottomStrictnessInfo,
17 ArgUsageInfo, FBTypeInfo
19 import Kind ( Kind, mkArrowKind, mkTypeKind )
22 import RnMonad ( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
23 SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
25 import Bag ( emptyBag, unitBag, snocBag )
26 import FiniteMap ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
27 import Name ( OccName(..), isTCOcc, Provenance )
28 import SrcLoc ( mkIfaceSrcLoc )
29 import Util ( panic{-, pprPanic ToDo:rm-} )
30 import ParseType ( parseType )
31 import ParseUnfolding ( parseUnfolding )
34 -----------------------------------------------------------------
36 parseIface ls = parseIToks (lexIface ls)
38 -----------------------------------------------------------------
42 %tokentype { IfaceToken }
43 %monad { IfM }{ thenIf }{ returnIf }
46 INTERFACE { ITinterface }
47 USAGES_PART { ITusages }
48 VERSIONS_PART { ITversions }
49 EXPORTS_PART { ITexports }
50 INSTANCE_MODULES_PART { ITinstance_modules }
51 INSTANCES_PART { ITinstances }
52 FIXITIES_PART { ITfixities }
53 DECLARATIONS_PART { ITdeclarations }
54 PRAGMAS_PART { ITpragmas }
58 DERIVING { ITderiving }
61 INSTANCE { ITinstance }
84 VARSYM { ITvarsym $$ }
85 CONSYM { ITconsym $$ }
86 QVARID { ITqvarid $$ }
87 QCONID { ITqconid $$ }
88 QVARSYM { ITqvarsym $$ }
89 QCONSYM { ITqconsym $$ }
91 IDINFO_PART { ITidinfo $$ }
92 TYPE_PART { ITtysig $$ }
93 ARITY_PART { ITarity }
94 STRICT_PART { ITstrict }
95 UNFOLD_PART { ITunfold }
96 DEMAND { ITdemand $$ }
101 PRIM_CASE { ITprim_case }
106 COERCE_IN { ITcoerce_in }
107 COERCE_OUT { ITcoerce_out }
113 STRING { ITstring $$ }
114 INTEGER { ITinteger $$ }
115 DOUBLE { ITdouble $$ }
117 INTEGER_LIT { ITinteger_lit }
118 FLOAT_LIT { ITfloat_lit }
119 RATIONAL_LIT { ITrational_lit }
120 ADDR_LIT { ITaddr_lit }
121 LIT_LIT { ITlit_lit }
122 STRING_LIT { ITstring_lit }
124 UNKNOWN { ITunknown $$ }
127 iface :: { ParsedIface }
128 iface : INTERFACE CONID INTEGER
131 exports_part fixities_part
136 (fromInteger $3) -- Module version
139 $4 -- Instance modules
142 $8 -- Local instances
146 usages_part :: { [ImportVersion OccName] }
147 usages_part : USAGES_PART module_stuff_pairs { $2 }
150 module_stuff_pairs :: { [ImportVersion OccName] }
151 module_stuff_pairs : { [] }
152 | module_stuff_pair module_stuff_pairs { $1 : $2 }
154 module_stuff_pair :: { ImportVersion OccName }
155 module_stuff_pair : mod_name INTEGER DCOLON name_version_pairs SEMI
156 { ($1, fromInteger $2, $4) }
158 versions_part :: { [LocalVersion OccName] }
159 versions_part : VERSIONS_PART name_version_pairs { $2 }
162 name_version_pairs :: { [LocalVersion OccName] }
163 name_version_pairs : { [] }
164 | name_version_pair name_version_pairs { $1 : $2 }
166 name_version_pair :: { LocalVersion OccName }
167 name_version_pair : entity_occ INTEGER { ($1, fromInteger $2)
168 --------------------------------------------------------------------------
171 exports_part :: { [ExportItem] }
172 exports_part : EXPORTS_PART export_items { $2 }
175 export_items :: { [ExportItem] }
176 export_items : { [] }
177 | mod_name entities SEMI export_items { ($1,$2) : $4 }
179 entities :: { [(OccName, [OccName])] }
181 | entity entities { $1 : $2 }
183 entity :: { (OccName, [OccName]) }
184 entity : entity_occ { ($1, if isTCOcc $1
185 then [$1] {- AvailTC -}
186 else []) {- Avail -} }
187 | entity_occ stuff_inside { ($1, ($1 : $2)) {- TyCls exported too -} }
188 | entity_occ BANG stuff_inside { ($1, $3) {- TyCls not exported -} }
190 stuff_inside :: { [OccName] }
191 stuff_inside : OPAREN val_occs1 CPAREN { $2
192 --------------------------------------------------------------------------
195 inst_modules_part :: { [Module] }
196 inst_modules_part : { [] }
197 | INSTANCE_MODULES_PART mod_list { $2 }
199 mod_list :: { [Module] }
201 | mod_name mod_list { $1 : $2
202 --------------------------------------------------------------------------
205 fixities_part :: { [(OccName,Fixity)] }
206 fixities_part : { [] }
207 | FIXITIES_PART fixes { $2 }
209 fixes :: { [(OccName,Fixity)] }
211 | fix fixes { $1 : $2 }
213 fix :: { (OccName, Fixity) }
214 fix : INFIXL INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixL) }
215 | INFIXR INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixR) }
216 | INFIX INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixN)
217 --------------------------------------------------------------------------
220 decls_part :: { [(Version, RdrNameHsDecl)] }
222 | DECLARATIONS_PART topdecls { $2 }
224 topdecls :: { [(Version, RdrNameHsDecl)] }
226 | version topdecl topdecls { ($1,$2) : $3 }
228 version :: { Version }
229 version : INTEGER { fromInteger $1 }
231 topdecl :: { RdrNameHsDecl }
232 topdecl : TYPE tc_name tv_bndrs EQUAL type SEMI
233 { TyD (TySynonym $2 $3 $5 mkIfaceSrcLoc) }
234 | DATA decl_context tc_name tv_bndrs constrs deriving SEMI
235 { TyD (TyData $2 $3 $4 $5 $6 noDataPragmas mkIfaceSrcLoc) }
236 | NEWTYPE decl_context tc_name tv_bndrs EQUAL constr1 deriving SEMI
237 { TyD (TyNew $2 $3 $4 $6 $7 noDataPragmas mkIfaceSrcLoc) }
238 | CLASS decl_context tc_name tv_bndr csigs SEMI
239 { ClD (ClassDecl $2 $3 $4 $5 EmptyMonoBinds noClassPragmas mkIfaceSrcLoc) }
240 | var_name TYPE_PART id_info
243 (Succeeded tp) = parseType $2
245 SigD (IfaceSig $1 tp $3 mkIfaceSrcLoc) }
247 id_info :: { [HsIdInfo RdrName] }
249 | IDINFO_PART { let { (Succeeded id_info) = parseUnfolding $1 } in id_info}
251 decl_context :: { RdrNameContext }
252 decl_context : { [] }
253 | OCURLY context_list1 CCURLY DARROW { $2 }
256 csigs :: { [RdrNameSig] }
258 | WHERE OCURLY csigs1 CCURLY { $3 }
260 csigs1 :: { [RdrNameSig] }
261 csigs1 : csig { [$1] }
262 | csig SEMI csigs1 { $1 : $3 }
264 csig :: { RdrNameSig }
265 csig : var_name DCOLON type { ClassOpSig $1 $1 $3 mkIfaceSrcLoc
266 ----------------------------------------------------------------
269 constrs :: { [RdrNameConDecl] }
271 | EQUAL constrs1 { $2 }
273 constrs1 :: { [RdrNameConDecl] }
274 constrs1 : constr { [$1] }
275 | constr VBAR constrs1 { $1 : $3 }
277 constr :: { RdrNameConDecl }
278 constr : data_name batypes { ConDecl $1 $2 mkIfaceSrcLoc }
279 | data_name OCURLY fields1 CCURLY { RecConDecl $1 $3 mkIfaceSrcLoc }
281 constr1 :: { RdrNameConDecl {- For a newtype -} }
282 constr1 : data_name atype { NewConDecl $1 $2 mkIfaceSrcLoc }
284 deriving :: { Maybe [RdrName] }
286 | DERIVING OPAREN qtc_names1 CPAREN { Just $3 }
288 batypes :: { [RdrNameBangType] }
290 | batype batypes { $1 : $2 }
292 batype :: { RdrNameBangType }
293 batype : atype { Unbanged $1 }
294 | BANG atype { Banged $2 }
296 fields1 :: { [([RdrName], RdrNameBangType)] }
297 fields1 : field { [$1] }
298 | field COMMA fields1 { $1 : $3 }
300 field :: { ([RdrName], RdrNameBangType) }
301 field : var_names1 DCOLON type { ($1, Unbanged $3) }
302 | var_names1 DCOLON BANG type { ($1, Banged $4)
303 --------------------------------------------------------------------------
306 forall :: { [HsTyVar RdrName] }
307 forall : OBRACK tv_bndrs CBRACK { $2 }
309 context :: { RdrNameContext }
311 | OCURLY context_list1 CCURLY { $2 }
313 context_list1 :: { RdrNameContext }
314 context_list1 : class { [$1] }
315 | class COMMA context_list1 { $1 : $3 }
317 class :: { (RdrName, RdrNameHsType) }
318 class : qtc_name atype { ($1, $2) }
320 type :: { RdrNameHsType }
321 type : FORALL forall context DARROW type { mkHsForAllTy $2 $3 $5 }
324 tautype :: { RdrNameHsType }
325 tautype : btype { $1 }
326 | btype RARROW tautype { MonoFunTy $1 $3 }
328 types2 :: { [RdrNameHsType] {- Two or more -} }
329 types2 : type COMMA type { [$1,$3] }
330 | type COMMA types2 { $1 : $3 }
332 btype :: { RdrNameHsType }
334 | btype atype { MonoTyApp $1 $2 }
336 atype :: { RdrNameHsType }
337 atype : qtc_name { MonoTyVar $1 }
338 | tv_name { MonoTyVar $1 }
339 | OPAREN types2 CPAREN { MonoTupleTy dummyRdrTcName $2 }
340 | OBRACK type CBRACK { MonoListTy dummyRdrTcName $2 }
341 | OCURLY qtc_name atype CCURLY { MonoDictTy $2 $3 }
342 | OPAREN type CPAREN { $2 }
344 atypes :: { [RdrNameHsType] {- Zero or more -} }
346 | atype atypes { $1 : $2
347 ---------------------------------------------------------------------
350 mod_name :: { Module }
353 var_occ :: { OccName }
354 var_occ : VARID { VarOcc $1 }
355 | VARSYM { VarOcc $1 }
356 | BANG { VarOcc SLIT("!") {-sigh, double-sigh-} }
358 tc_occ :: { OccName }
359 tc_occ : CONID { TCOcc $1 }
360 | CONSYM { TCOcc $1 }
361 | OPAREN RARROW CPAREN { TCOcc SLIT("->") }
363 entity_occ :: { OccName }
364 entity_occ : var_occ { $1 }
366 | RARROW { TCOcc SLIT("->") {- Allow un-paren'd arrow -} }
368 val_occ :: { OccName }
369 val_occ : var_occ { $1 }
370 | CONID { VarOcc $1 }
371 | CONSYM { VarOcc $1 }
373 val_occs1 :: { [OccName] }
375 | val_occ val_occs1 { $1 : $2 }
378 qvar_name :: { RdrName }
379 : QVARID { varQual $1 }
380 | QVARSYM { varQual $1 }
382 var_name :: { RdrName }
383 var_name : var_occ { Unqual $1 }
385 var_names1 :: { [RdrName] }
386 var_names1 : var_name { [$1] }
387 | var_name var_names1 { $1 : $2 }
389 any_var_name :: {RdrName}
390 any_var_name : var_name { $1 }
393 qdata_name :: { RdrName }
394 qdata_name : QCONID { varQual $1 }
395 | QCONSYM { varQual $1 }
397 data_name :: { RdrName }
398 data_name : CONID { Unqual (VarOcc $1) }
399 | CONSYM { Unqual (VarOcc $1) }
402 qtc_name :: { RdrName }
403 qtc_name : QCONID { tcQual $1 }
405 qtc_names1 :: { [RdrName] }
407 | qtc_name COMMA qtc_names1 { $1 : $3 }
409 tc_name :: { RdrName }
410 tc_name : tc_occ { Unqual $1 }
412 tv_name :: { RdrName }
413 tv_name : VARID { Unqual (TvOcc $1) }
415 tv_names :: { [RdrName] }
417 | tv_name tv_names { $1 : $2 }
419 tv_bndr :: { HsTyVar RdrName }
420 tv_bndr : tv_name DCOLON akind { IfaceTyVar $1 $3 }
421 | tv_name { UserTyVar $1 }
423 tv_bndrs :: { [HsTyVar RdrName] }
425 | tv_bndr tv_bndrs { $1 : $2 }
429 | akind RARROW kind { mkArrowKind $1 $3 }
432 : VARSYM { mkTypeKind {- ToDo: check that it's "*" -} }
433 | OPAREN kind CPAREN { $2
434 --------------------------------------------------------------------------
438 instances_part :: { [RdrNameInstDecl] }
439 instances_part : INSTANCES_PART instdecls { $2 }
442 instdecls :: { [RdrNameInstDecl] }
444 | instd instdecls { $1 : $2 }
446 instd :: { RdrNameInstDecl }
447 instd : INSTANCE type EQUAL var_name SEMI
449 EmptyMonoBinds {- No bindings -}
450 [] {- No user pragmas -}
451 (Just $4) {- Dfun id -}
453 --------------------------------------------------------------------------