2 #include "HsVersions.h"
3 module ParseIface ( parseIface ) where
7 import HsSyn -- quite a bit of stuff
8 import RdrHsSyn -- oodles of synonyms
9 import HsDecls ( HsIdInfo(..) )
10 import HsTypes ( mkHsForAllTy )
13 import BasicTypes ( Fixity(..), FixityDirection(..), NewOrData(..), Version(..) )
14 import HsPragmas ( noDataPragmas, noClassPragmas )
15 import Kind ( Kind, mkArrowKind, mkBoxedTypeKind )
16 import IdInfo ( ArgUsageInfo, FBTypeInfo )
19 import RnMonad ( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
20 SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
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 ( mkIfaceSrcLoc )
26 --import Util ( panic{-, pprPanic ToDo:rm-} )
27 import ParseType ( parseType )
28 import ParseUnfolding ( parseUnfolding )
31 -----------------------------------------------------------------
33 parseIface ls = parseIToks (lexIface ls)
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 }
55 DERIVING { ITderiving }
58 INSTANCE { ITinstance }
81 VARSYM { ITvarsym $$ }
82 CONSYM { ITconsym $$ }
83 QVARID { ITqvarid $$ }
84 QCONID { ITqconid $$ }
85 QVARSYM { ITqvarsym $$ }
86 QCONSYM { ITqconsym $$ }
88 IDINFO_PART { ITidinfo $$ }
89 TYPE_PART { ITtysig $$ }
90 ARITY_PART { ITarity }
91 STRICT_PART { ITstrict }
92 UNFOLD_PART { ITunfold $$ }
93 DEMAND { ITdemand $$ }
98 PRIM_CASE { ITprim_case }
103 COERCE_IN { ITcoerce_in }
104 COERCE_OUT { ITcoerce_out }
110 STRING { ITstring $$ }
111 INTEGER { ITinteger $$ }
112 DOUBLE { ITdouble $$ }
114 INTEGER_LIT { ITinteger_lit }
115 FLOAT_LIT { ITfloat_lit }
116 RATIONAL_LIT { ITrational_lit }
117 ADDR_LIT { ITaddr_lit }
118 LIT_LIT { ITlit_lit }
119 STRING_LIT { ITstring_lit }
121 UNKNOWN { ITunknown $$ }
124 iface :: { ParsedIface }
125 iface : INTERFACE CONID INTEGER
128 exports_part fixities_part
133 (fromInteger $3) -- Module version
136 $4 -- Instance modules
139 $8 -- Local instances
143 usages_part :: { [ImportVersion OccName] }
144 usages_part : USAGES_PART module_stuff_pairs { $2 }
147 module_stuff_pairs :: { [ImportVersion OccName] }
148 module_stuff_pairs : { [] }
149 | module_stuff_pair module_stuff_pairs { $1 : $2 }
151 module_stuff_pair :: { ImportVersion OccName }
152 module_stuff_pair : mod_name INTEGER DCOLON name_version_pairs SEMI
153 { ($1, fromInteger $2, $4) }
155 versions_part :: { [LocalVersion OccName] }
156 versions_part : VERSIONS_PART name_version_pairs { $2 }
159 name_version_pairs :: { [LocalVersion OccName] }
160 name_version_pairs : { [] }
161 | name_version_pair name_version_pairs { $1 : $2 }
163 name_version_pair :: { LocalVersion OccName }
164 name_version_pair : entity_occ INTEGER { ($1, fromInteger $2)
165 --------------------------------------------------------------------------
168 exports_part :: { [ExportItem] }
169 exports_part : EXPORTS_PART export_items { $2 }
172 export_items :: { [ExportItem] }
173 export_items : { [] }
174 | mod_name entities SEMI export_items { ($1,$2) : $4 }
176 entities :: { [(OccName, [OccName])] }
178 | entity entities { $1 : $2 }
180 entity :: { (OccName, [OccName]) }
181 entity : entity_occ { ($1, if isTCOcc $1
182 then [$1] {- AvailTC -}
183 else []) {- Avail -} }
184 | entity_occ stuff_inside { ($1, ($1 : $2)) {- TyCls exported too -} }
185 | entity_occ BANG stuff_inside { ($1, $3) {- TyCls not exported -} }
187 stuff_inside :: { [OccName] }
188 stuff_inside : OPAREN val_occs1 CPAREN { $2
189 --------------------------------------------------------------------------
192 inst_modules_part :: { [Module] }
193 inst_modules_part : { [] }
194 | INSTANCE_MODULES_PART mod_list { $2 }
196 mod_list :: { [Module] }
198 | mod_name mod_list { $1 : $2
199 --------------------------------------------------------------------------
202 fixities_part :: { [(OccName,Fixity)] }
203 fixities_part : { [] }
204 | FIXITIES_PART fixes { $2 }
206 fixes :: { [(OccName,Fixity)] }
208 | fix fixes { $1 : $2 }
210 fix :: { (OccName, Fixity) }
211 fix : INFIXL INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixL) }
212 | INFIXR INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixR) }
213 | INFIX INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixN)
214 --------------------------------------------------------------------------
217 decls_part :: { [(Version, RdrNameHsDecl)] }
219 | DECLARATIONS_PART topdecls { $2 }
221 topdecls :: { [(Version, RdrNameHsDecl)] }
223 | version topdecl topdecls { ($1,$2) : $3 }
225 version :: { Version }
226 version : INTEGER { fromInteger $1 }
228 topdecl :: { RdrNameHsDecl }
229 topdecl : TYPE tc_name tv_bndrs EQUAL type SEMI
230 { TyD (TySynonym $2 $3 $5 mkIfaceSrcLoc) }
231 | DATA decl_context tc_name tv_bndrs constrs deriving SEMI
232 { TyD (TyData DataType $2 $3 $4 $5 $6 noDataPragmas mkIfaceSrcLoc) }
233 | NEWTYPE decl_context tc_name tv_bndrs newtype_constr deriving SEMI
234 { TyD (TyData NewType $2 $3 $4 $5 $6 noDataPragmas mkIfaceSrcLoc) }
235 | CLASS decl_context tc_name tv_bndr csigs SEMI
236 { ClD (ClassDecl $2 $3 $4 $5 EmptyMonoBinds noClassPragmas mkIfaceSrcLoc) }
237 | var_name TYPE_PART id_info
240 (Succeeded tp) = parseType $2
242 SigD (IfaceSig $1 tp $3 mkIfaceSrcLoc) }
244 id_info :: { [HsIdInfo RdrName] }
246 | IDINFO_PART { let { (Succeeded id_info) = parseUnfolding $1 } in id_info}
248 decl_context :: { RdrNameContext }
249 decl_context : { [] }
250 | OCURLY context_list1 CCURLY DARROW { $2 }
253 csigs :: { [RdrNameSig] }
255 | WHERE OCURLY csigs1 CCURLY { $3 }
257 csigs1 :: { [RdrNameSig] }
258 csigs1 : csig { [$1] }
259 | csig SEMI csigs1 { $1 : $3 }
261 csig :: { RdrNameSig }
262 csig : var_name DCOLON type { ClassOpSig $1 $1 $3 mkIfaceSrcLoc
263 ----------------------------------------------------------------
266 constrs :: { [RdrNameConDecl] {- empty for handwritten abstract -} }
268 | EQUAL constrs1 { $2 }
270 constrs1 :: { [RdrNameConDecl] }
271 constrs1 : constr { [$1] }
272 | constr VBAR constrs1 { $1 : $3 }
274 constr :: { RdrNameConDecl }
275 constr : data_name batypes { ConDecl $1 [] (VanillaCon $2) mkIfaceSrcLoc }
276 | data_name OCURLY fields1 CCURLY { ConDecl $1 [] (RecCon $3) mkIfaceSrcLoc }
278 newtype_constr :: { [RdrNameConDecl] {- Empty if handwritten abstract -} }
279 newtype_constr : { [] }
280 | EQUAL data_name atype { [ConDecl $2 [] (NewCon $3) mkIfaceSrcLoc] }
282 deriving :: { Maybe [RdrName] }
284 | DERIVING OPAREN tc_names1 CPAREN { Just $3 }
286 batypes :: { [RdrNameBangType] }
288 | batype batypes { $1 : $2 }
290 batype :: { RdrNameBangType }
291 batype : atype { Unbanged $1 }
292 | BANG atype { Banged $2 }
294 fields1 :: { [([RdrName], RdrNameBangType)] }
295 fields1 : field { [$1] }
296 | field COMMA fields1 { $1 : $3 }
298 field :: { ([RdrName], RdrNameBangType) }
299 field : var_names1 DCOLON type { ($1, Unbanged $3) }
300 | var_names1 DCOLON BANG type { ($1, Banged $4)
301 --------------------------------------------------------------------------
304 forall :: { [HsTyVar RdrName] }
305 forall : OBRACK tv_bndrs CBRACK { $2 }
307 context :: { RdrNameContext }
309 | OCURLY context_list1 CCURLY { $2 }
311 context_list1 :: { RdrNameContext }
312 context_list1 : class { [$1] }
313 | class COMMA context_list1 { $1 : $3 }
315 class :: { (RdrName, RdrNameHsType) }
316 class : tc_name atype { ($1, $2) }
318 type :: { RdrNameHsType }
319 type : FORALL forall context DARROW type { mkHsForAllTy $2 $3 $5 }
320 | btype RARROW type { MonoFunTy $1 $3 }
323 types2 :: { [RdrNameHsType] {- Two or more -} }
324 types2 : type COMMA type { [$1,$3] }
325 | type COMMA types2 { $1 : $3 }
327 btype :: { RdrNameHsType }
329 | btype atype { MonoTyApp $1 $2 }
331 atype :: { RdrNameHsType }
332 atype : tc_name { MonoTyVar $1 }
333 | tv_name { MonoTyVar $1 }
334 | OPAREN types2 CPAREN { MonoTupleTy dummyRdrTcName $2 }
335 | OBRACK type CBRACK { MonoListTy dummyRdrTcName $2 }
336 | OCURLY tc_name atype CCURLY { MonoDictTy $2 $3 }
337 | OPAREN type CPAREN { $2 }
339 atypes :: { [RdrNameHsType] {- Zero or more -} }
341 | atype atypes { $1 : $2
342 ---------------------------------------------------------------------
345 mod_name :: { Module }
348 var_occ :: { OccName }
349 var_occ : VARID { VarOcc $1 }
350 | VARSYM { VarOcc $1 }
351 | BANG { VarOcc SLIT("!") {-sigh, double-sigh-} }
353 tc_occ :: { OccName }
354 tc_occ : CONID { TCOcc $1 }
355 | CONSYM { TCOcc $1 }
356 | OPAREN RARROW CPAREN { TCOcc SLIT("->") }
358 entity_occ :: { OccName }
359 entity_occ : var_occ { $1 }
361 | RARROW { TCOcc SLIT("->") {- Allow un-paren'd arrow -} }
363 val_occ :: { OccName }
364 val_occ : var_occ { $1 }
365 | CONID { VarOcc $1 }
366 | CONSYM { VarOcc $1 }
368 val_occs1 :: { [OccName] }
370 | val_occ val_occs1 { $1 : $2 }
373 qvar_name :: { RdrName }
374 : QVARID { varQual $1 }
375 | QVARSYM { varQual $1 }
377 var_name :: { RdrName }
378 var_name : var_occ { Unqual $1 }
380 var_names1 :: { [RdrName] }
381 var_names1 : var_name { [$1] }
382 | var_name var_names1 { $1 : $2 }
384 any_var_name :: {RdrName}
385 any_var_name : var_name { $1 }
388 qdata_name :: { RdrName }
389 qdata_name : QCONID { varQual $1 }
390 | QCONSYM { varQual $1 }
392 data_name :: { RdrName }
393 data_name : CONID { Unqual (VarOcc $1) }
394 | CONSYM { Unqual (VarOcc $1) }
397 tc_names1 :: { [RdrName] }
399 | tc_name COMMA tc_names1 { $1 : $3 }
401 tc_name :: { RdrName }
402 tc_name : tc_occ { Unqual $1 }
403 | QCONID { tcQual $1 }
405 tv_name :: { RdrName }
406 tv_name : VARID { Unqual (TvOcc $1) }
408 tv_names :: { [RdrName] }
410 | tv_name tv_names { $1 : $2 }
412 tv_bndr :: { HsTyVar RdrName }
413 tv_bndr : tv_name DCOLON akind { IfaceTyVar $1 $3 }
414 | tv_name { UserTyVar $1 }
416 tv_bndrs :: { [HsTyVar RdrName] }
418 | tv_bndr tv_bndrs { $1 : $2 }
422 | akind RARROW kind { mkArrowKind $1 $3 }
425 : VARSYM { mkBoxedTypeKind {- ToDo: check that it's "*" -} }
426 | OPAREN kind CPAREN { $2
427 --------------------------------------------------------------------------
431 instances_part :: { [RdrNameInstDecl] }
432 instances_part : INSTANCES_PART instdecls { $2 }
435 instdecls :: { [RdrNameInstDecl] }
437 | instd instdecls { $1 : $2 }
439 instd :: { RdrNameInstDecl }
440 instd : INSTANCE type EQUAL var_name SEMI
442 EmptyMonoBinds {- No bindings -}
443 [] {- No user pragmas -}
444 (Just $4) {- Dfun id -}
446 --------------------------------------------------------------------------