2 #include "HsVersions.h"
4 module ParseIface ( parseIface ) where
10 import HsSyn -- quite a bit of stuff
11 import RdrHsSyn -- oodles of synonyms
12 import HsPragmas ( noGenPragmas )
14 import Bag ( emptyBag, unitBag, snocBag )
15 import FiniteMap ( emptyFM, unitFM, addToFM, plusFM, bagToFM )
16 import Name ( ExportFlag(..), mkTupNameStr, preludeQual,
17 RdrName(..){-instance Outputable:ToDo:rm-}
19 import Outputable -- ToDo:rm
20 import PprStyle ( PprStyle(..) ) -- ToDo: rm debugging
21 import SrcLoc ( mkIfaceSrcLoc )
22 import Util ( panic, pprPanic{-ToDo:rm-} )
24 -----------------------------------------------------------------
26 parseIface = parseIToks . lexIface
28 -----------------------------------------------------------------
32 %tokentype { IfaceToken }
33 %monad { IfM }{ thenIf }{ returnIf }
36 INTERFACE { ITinterface }
37 USAGES_PART { ITusages }
38 VERSIONS_PART { ITversions }
39 EXPORTS_PART { ITexports }
40 INSTANCE_MODULES_PART { ITinstance_modules }
41 INSTANCES_PART { ITinstances }
42 FIXITIES_PART { ITfixities }
43 DECLARATIONS_PART { ITdeclarations }
44 PRAGMAS_PART { ITpragmas }
60 INSTANCE { ITinstance }
71 INTEGER { ITinteger $$ }
74 VARSYM { ITvarsym $$ }
75 CONSYM { ITconsym $$ }
76 QVARID { ITqvarid $$ }
77 QCONID { ITqconid $$ }
78 QVARSYM { ITqvarsym $$ }
79 QCONSYM { ITqconsym $$ }
82 iface :: { ParsedIface }
83 iface : INTERFACE CONID INTEGER
84 usages_part versions_part
85 exports_part inst_modules_part
86 fixities_part decls_part instances_part pragmas_part
87 { case $9 of { (tm, vm) ->
88 ParsedIface $2 (panic "merge modules") (fromInteger $3) Nothing{-src version-}
92 $7 -- instance modules
96 $10 -- local instances
99 --------------------------------------------------------------------------
102 usages_part :: { UsagesMap }
103 usages_part : USAGES_PART module_stuff_pairs { bagToFM $2 }
106 versions_part :: { VersionsMap }
107 versions_part : VERSIONS_PART name_version_pairs { bagToFM $2 }
110 module_stuff_pairs :: { Bag (Module, (Version, FiniteMap FAST_STRING Version)) }
111 module_stuff_pairs : module_stuff_pair
113 | module_stuff_pairs module_stuff_pair
116 module_stuff_pair :: { (Module, (Version, FiniteMap FAST_STRING Version)) }
117 module_stuff_pair : CONID INTEGER DCOLON name_version_pairs SEMI
118 { ($1, (fromInteger $2, bagToFM $4)) }
120 name_version_pairs :: { Bag (FAST_STRING, Int) }
121 name_version_pairs : name_version_pair
123 | name_version_pairs name_version_pair
126 name_version_pair :: { (FAST_STRING, Int) }
127 name_version_pair : name INTEGER
128 { ($1, fromInteger $2)
129 --------------------------------------------------------------------------
132 exports_part :: { ExportsMap }
133 exports_part : EXPORTS_PART export_items { bagToFM $2 }
136 export_items :: { Bag (FAST_STRING, (OrigName, ExportFlag)) }
137 export_items : export_item { unitBag $1 }
138 | export_items export_item { $1 `snocBag` $2 }
140 export_item :: { (FAST_STRING, (OrigName, ExportFlag)) }
141 export_item : CONID name maybe_dotdot { ($2, (OrigName $1 $2, $3)) }
143 maybe_dotdot :: { ExportFlag }
144 maybe_dotdot : DOTDOT { ExportAll }
146 --------------------------------------------------------------------------
149 inst_modules_part :: { Bag Module }
150 inst_modules_part : INSTANCE_MODULES_PART mod_list { $2 }
153 mod_list :: { Bag Module }
154 mod_list : CONID { unitBag $1 }
155 | mod_list CONID { $1 `snocBag` $2
156 --------------------------------------------------------------------------
159 fixities_part :: { FixitiesMap }
160 fixities_part : FIXITIES_PART fixes { $2 }
163 fixes :: { FixitiesMap }
164 fixes : fix { case $1 of (k,v) -> unitFM k v }
165 | fixes fix { case $2 of (k,v) -> addToFM $1 k v }
167 fix :: { (FAST_STRING, RdrNameFixityDecl) }
168 fix : INFIXL INTEGER qname SEMI { (de_qual $3, InfixL $3 (fromInteger $2)) }
169 | INFIXR INTEGER qname SEMI { (de_qual $3, InfixR $3 (fromInteger $2)) }
170 | INFIX INTEGER qname SEMI { (de_qual $3, InfixN $3 (fromInteger $2))
171 --------------------------------------------------------------------------
174 decls_part :: { (LocalTyDefsMap, LocalValDefsMap) }
175 decls_part : DECLARATIONS_PART topdecls { $2 }
176 | { (emptyFM, emptyFM) }
178 topdecls :: { (LocalTyDefsMap, LocalValDefsMap) }
179 topdecls : topdecl { $1 }
180 | topdecls topdecl { case $1 of { (ts1, vs1) ->
181 case $2 of { (ts2, vs2) ->
182 (plusFM ts1 ts2, plusFM vs1 vs2)}}
185 topdecl :: { (LocalTyDefsMap, LocalValDefsMap) }
186 topdecl : typed SEMI { ($1, emptyFM) }
190 | decl { case $1 of { (n, Sig qn ty _ loc) ->
191 (emptyFM, unitFM n (ValSig qn loc ty)) }
194 typed :: { LocalTyDefsMap }
195 typed : TYPE simple EQUAL type { mk_type $2 $4 }
197 datad :: { (LocalTyDefsMap, LocalValDefsMap) }
198 datad : DATA simple EQUAL constrs { mk_data [] $2 $4 }
199 | DATA context DARROW simple EQUAL constrs { mk_data $2 $4 $6 }
201 newtd :: { (LocalTyDefsMap, LocalValDefsMap) }
202 newtd : NEWTYPE simple EQUAL constr1 { mk_new [] $2 $4 }
203 | NEWTYPE context DARROW simple EQUAL constr1 { mk_new $2 $4 $6 }
205 classd :: { (LocalTyDefsMap, LocalValDefsMap) }
206 classd : CLASS class cbody { mk_class [] $2 $3 }
207 | CLASS context DARROW class cbody { mk_class $2 $4 $5 }
209 cbody :: { [(FAST_STRING, RdrNameSig)] }
210 cbody : WHERE OCURLY decls CCURLY { $3 }
213 decls :: { [(FAST_STRING, RdrNameSig)] }
214 decls : decl { [$1] }
215 | decls decl { $1 ++ [$2] }
217 decl :: { (FAST_STRING, RdrNameSig) }
218 decl : var DCOLON ctype SEMI { (de_qual $1, Sig $1 $3 noGenPragmas mkIfaceSrcLoc) }
220 context :: { RdrNameContext }
221 context : DOCURLY context_list DCCURLY { reverse $2 }
223 context_list :: { RdrNameContext{-reversed-} }
224 context_list : class { [$1] }
225 | context_list COMMA class { $3 : $1 }
227 class :: { (RdrName, RdrName) }
228 class : gtycon VARID { ($1, Unqual $2) }
230 ctype :: { RdrNamePolyType }
231 ctype : context DARROW type { HsPreForAllTy $1 $3 }
232 | type { HsPreForAllTy [] $1 }
234 type :: { RdrNameMonoType }
236 | btype RARROW type { MonoFunTy $1 $3 }
238 types :: { [RdrNameMonoType] }
239 types : type { [$1] }
240 | types COMMA type { $1 ++ [$3] }
242 btype :: { RdrNameMonoType }
243 btype : gtyconapp { case $1 of (tc, tys) -> MonoTyApp tc tys }
244 | ntyconapp { case $1 of { (ty1, tys) ->
249 MonoTyVar tv -> MonoTyApp tv tys;
250 MonoTyApp tc ts -> MonoTyApp tc (ts++tys);
251 MonoFunTy t1 t2 -> MonoTyApp (preludeQual SLIT("->")) (t1:t2:tys);
252 MonoListTy ty -> MonoTyApp (preludeQual SLIT("[]")) (ty:tys);
253 MonoTupleTy ts -> MonoTyApp (preludeQual (mkTupNameStr (length ts)))
255 _ -> pprPanic "test:" (ppr PprDebug $1)
259 ntyconapp :: { (RdrNameMonoType, [RdrNameMonoType]) }
260 ntyconapp : ntycon { ($1, []) }
261 | ntyconapp atype { case $1 of (t1,tys) -> (t1, tys ++ [$2]) }
263 gtyconapp :: { (RdrName, [RdrNameMonoType]) }
264 gtyconapp : gtycon { ($1, []) }
265 | gtyconapp atype { case $1 of (tc,tys) -> (tc, tys ++ [$2]) }
267 atype :: { RdrNameMonoType }
268 atype : gtycon { MonoTyApp $1 [] }
271 atypes :: { [RdrNameMonoType] }
272 atypes : atype { [$1] }
273 | atypes atype { $1 ++ [$2] }
275 ntycon :: { RdrNameMonoType }
276 ntycon : VARID { MonoTyVar (Unqual $1) }
277 | OPAREN type COMMA types CPAREN { MonoTupleTy ($2 : $4) }
278 | OBRACK type CBRACK { MonoListTy $2 }
279 | OPAREN type CPAREN { $2 }
281 gtycon :: { RdrName }
282 gtycon : QCONID { $1 }
283 | OPAREN RARROW CPAREN { preludeQual SLIT("->") }
284 | OBRACK CBRACK { preludeQual SLIT("[]") }
285 | OPAREN CPAREN { preludeQual SLIT("()") }
286 | OPAREN commas CPAREN { preludeQual (mkTupNameStr $2) }
289 commas : COMMA { 2{-1 comma => arity 2-} }
290 | commas COMMA { $1 + 1 }
292 simple :: { (RdrName, [FAST_STRING]) }
293 simple : gtycon { ($1, []) }
294 | gtyconvars { case $1 of (tc,tvs) -> (tc, reverse tvs) }
296 gtyconvars :: { (RdrName, [FAST_STRING] {-reversed-}) }
297 gtyconvars : gtycon VARID { ($1, [$2]) }
298 | gtyconvars VARID { case $1 of (tc,tvs) -> (tc, $2 : tvs) }
300 constrs :: { [(RdrName, RdrNameConDecl)] }
301 constrs : constr { [$1] }
302 | constrs VBAR constr { $1 ++ [$3] }
304 constr :: { (RdrName, RdrNameConDecl) }
306 { case $1 of (con, tys) -> (con, ConDecl con tys mkIfaceSrcLoc) }
307 | QCONSYM { ($1, ConDecl $1 [] mkIfaceSrcLoc) }
308 | QCONSYM batypes { ($1, ConDecl $1 $2 mkIfaceSrcLoc) }
309 | gtycon OCURLY fields CCURLY
310 { ($1, RecConDecl $1 $3 mkIfaceSrcLoc) }
312 btyconapp :: { (RdrName, [RdrNameBangType]) }
313 btyconapp : gtycon { ($1, []) }
314 | btyconapp batype { case $1 of (tc,tys) -> (tc, tys ++ [$2]) }
316 bbtype :: { RdrNameBangType }
317 bbtype : btype { Unbanged (HsPreForAllTy [] $1) }
318 | BANG atype { Banged (HsPreForAllTy [] $2) }
320 batype :: { RdrNameBangType }
321 batype : atype { Unbanged (HsPreForAllTy [] $1) }
322 | BANG atype { Banged (HsPreForAllTy [] $2) }
324 batypes :: { [RdrNameBangType] }
325 batypes : batype { [$1] }
326 | batypes batype { $1 ++ [$2] }
328 fields :: { [([RdrName], RdrNameBangType)] }
329 fields : field { [$1] }
330 | fields COMMA field { $1 ++ [$3] }
332 field :: { ([RdrName], RdrNameBangType) }
333 field : var DCOLON type { ([$1], Unbanged (HsPreForAllTy [] $3)) }
334 | var DCOLON BANG atype { ([$1], Banged (HsPreForAllTy [] $4)) }
336 constr1 :: { (RdrName, RdrNameMonoType) }
337 constr1 : gtycon atype { ($1, $2) }
344 qname : QVARID { $1 }
349 name :: { FAST_STRING }
353 | BANG { SLIT("!"){-sigh, double-sigh-} }
356 instances_part :: { Bag RdrIfaceInst }
357 instances_part : INSTANCES_PART instdecls { $2 }
360 instdecls :: { Bag RdrIfaceInst }
361 instdecls : instd { unitBag $1 }
362 | instdecls instd { $1 `snocBag` $2 }
364 instd :: { RdrIfaceInst }
365 instd : INSTANCE context DARROW gtycon restrict_inst SEMI { mk_inst $2 $4 $5 }
366 | INSTANCE gtycon general_inst SEMI { mk_inst [] $2 $3 }
368 restrict_inst :: { RdrNameMonoType }
369 restrict_inst : gtycon { MonoTyApp $1 [] }
370 | OPAREN gtyconvars CPAREN { case $2 of (tc,tvs) -> MonoTyApp tc (map en_mono tvs) }
371 | OPAREN VARID COMMA tyvar_list CPAREN { MonoTupleTy (map en_mono ($2:$4)) }
372 | OBRACK VARID CBRACK { MonoListTy (en_mono $2) }
373 | OPAREN VARID RARROW VARID CPAREN { MonoFunTy (en_mono $2) (en_mono $4) }
375 general_inst :: { RdrNameMonoType }
376 general_inst : gtycon { MonoTyApp $1 [] }
377 | OPAREN gtyconapp CPAREN { case $2 of (tc,tys) -> MonoTyApp tc tys }
378 | OPAREN type COMMA types CPAREN { MonoTupleTy ($2:$4) }
379 | OBRACK type CBRACK { MonoListTy $2 }
380 | OPAREN btype RARROW type CPAREN { MonoFunTy $2 $4 }
382 tyvar_list :: { [FAST_STRING] }
383 tyvar_list : VARID { [$1] }
384 | tyvar_list COMMA VARID { $1 ++ [$3]
385 --------------------------------------------------------------------------
388 pragmas_part :: { LocalPragmasMap }
389 pragmas_part : PRAGMAS_PART