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,
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 }
70 INTEGER { ITinteger $$ }
73 VARSYM { ITvarsym $$ }
74 CONSYM { ITconsym $$ }
75 QVARID { ITqvarid $$ }
76 QCONID { ITqconid $$ }
77 QVARSYM { ITqvarsym $$ }
78 QCONSYM { ITqconsym $$ }
81 iface :: { ParsedIface }
82 iface : INTERFACE CONID INTEGER
83 usages_part versions_part
84 exports_part inst_modules_part
85 fixities_part decls_part instances_part pragmas_part
86 { case $9 of { (tm, vm) ->
87 ParsedIface $2 (panic "merge modules") (fromInteger $3) Nothing{-src version-}
91 $7 -- instance modules
95 $10 -- local instances
98 --------------------------------------------------------------------------
101 usages_part :: { UsagesMap }
102 usages_part : USAGES_PART module_stuff_pairs { bagToFM $2 }
105 versions_part :: { VersionsMap }
106 versions_part : VERSIONS_PART name_version_pairs { bagToFM $2 }
109 module_stuff_pairs :: { Bag (Module, (Version, FiniteMap FAST_STRING Version)) }
110 module_stuff_pairs : module_stuff_pair
112 | module_stuff_pairs module_stuff_pair
115 module_stuff_pair :: { (Module, (Version, FiniteMap FAST_STRING Version)) }
116 module_stuff_pair : CONID INTEGER DCOLON name_version_pairs SEMI
117 { ($1, (fromInteger $2, bagToFM $4)) }
119 name_version_pairs :: { Bag (FAST_STRING, Int) }
120 name_version_pairs : name_version_pair
122 | name_version_pairs name_version_pair
125 name_version_pair :: { (FAST_STRING, Int) }
126 name_version_pair : iname INTEGER
127 { ($1, fromInteger $2)
128 --------------------------------------------------------------------------
131 exports_part :: { ExportsMap }
132 exports_part : EXPORTS_PART export_items { bagToFM $2 }
135 export_items :: { Bag (FAST_STRING, (RdrName, ExportFlag)) }
136 export_items : export_item { unitBag $1 }
137 | export_items export_item { $1 `snocBag` $2 }
139 export_item :: { (FAST_STRING, (RdrName, ExportFlag)) }
140 export_item : qiname maybe_dotdot { (de_qual $1, ($1, $2)) }
142 maybe_dotdot :: { ExportFlag }
143 maybe_dotdot : DOTDOT { ExportAll }
145 --------------------------------------------------------------------------
148 inst_modules_part :: { Bag Module }
149 inst_modules_part : INSTANCE_MODULES_PART mod_list { $2 }
152 mod_list :: { Bag Module }
153 mod_list : CONID { unitBag $1 }
154 | mod_list CONID { $1 `snocBag` $2
155 --------------------------------------------------------------------------
158 fixities_part :: { FixitiesMap }
159 fixities_part : FIXITIES_PART fixes { $2 }
162 fixes :: { FixitiesMap }
163 fixes : fix { case $1 of (k,v) -> unitFM k v }
164 | fixes fix { case $2 of (k,v) -> addToFM $1 k v }
166 fix :: { (FAST_STRING, RdrNameFixityDecl) }
167 fix : INFIXL INTEGER qop SEMI { (de_qual $3, InfixL $3 (fromInteger $2)) }
168 | INFIXR INTEGER qop SEMI { (de_qual $3, InfixR $3 (fromInteger $2)) }
169 | INFIX INTEGER qop SEMI { (de_qual $3, InfixN $3 (fromInteger $2))
170 --------------------------------------------------------------------------
173 decls_part :: { (LocalTyDefsMap, LocalValDefsMap) }
174 decls_part : DECLARATIONS_PART topdecls { $2 }
175 | { (emptyFM, emptyFM) }
177 topdecls :: { (LocalTyDefsMap, LocalValDefsMap) }
178 topdecls : topdecl { $1 }
179 | topdecls topdecl { case $1 of { (ts1, vs1) ->
180 case $2 of { (ts2, vs2) ->
181 (plusFM ts1 ts2, plusFM vs1 vs2)}}
184 topdecl :: { (LocalTyDefsMap, LocalValDefsMap) }
185 topdecl : typed SEMI { ($1, emptyFM) }
189 | decl { case $1 of { (n, Sig qn ty _ loc) ->
190 (emptyFM, unitFM n (ValSig qn loc ty)) }
193 typed :: { LocalTyDefsMap }
194 typed : TYPE simple EQUAL type { mk_type $2 $4 }
196 datad :: { (LocalTyDefsMap, LocalValDefsMap) }
197 datad : DATA simple EQUAL constrs { mk_data [] $2 $4 }
198 | DATA context DARROW simple EQUAL constrs { mk_data $2 $4 $6 }
200 newtd :: { (LocalTyDefsMap, LocalValDefsMap) }
201 newtd : NEWTYPE simple EQUAL constr1 { mk_new [] $2 $4 }
202 | NEWTYPE context DARROW simple EQUAL constr1 { mk_new $2 $4 $6 }
204 classd :: { (LocalTyDefsMap, LocalValDefsMap) }
205 classd : CLASS class cbody { mk_class [] $2 $3 }
206 | CLASS context DARROW class cbody { mk_class $2 $4 $5 }
208 cbody :: { [(FAST_STRING, RdrNameSig)] }
209 cbody : WHERE OCURLY decls CCURLY { $3 }
212 decls :: { [(FAST_STRING, RdrNameSig)] }
213 decls : decl { [$1] }
214 | decls decl { $1 ++ [$2] }
216 decl :: { (FAST_STRING, RdrNameSig) }
217 decl : var DCOLON ctype SEMI { (de_qual $1, Sig $1 $3 noGenPragmas mkIfaceSrcLoc) }
219 context :: { RdrNameContext }
220 context : OPAREN context_list CPAREN { 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 : type DARROW type { HsPreForAllTy (type2context $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 (Unqual SLIT("->")) (t1:t2:tys);
252 MonoListTy ty -> MonoTyApp (Unqual SLIT("[]")) (ty:tys);
253 MonoTupleTy ts -> MonoTyApp (Unqual (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 | CONID { Unqual $1 }
284 | OPAREN RARROW CPAREN { Unqual SLIT("->") }
285 | OBRACK CBRACK { Unqual SLIT("[]") }
286 | OPAREN CPAREN { Unqual SLIT("()") }
287 | OPAREN commas CPAREN { Unqual (mkTupNameStr $2) }
290 commas : COMMA { 2{-1 comma => arity 2-} }
291 | commas COMMA { $1 + 1 }
293 simple :: { (RdrName, [FAST_STRING]) }
294 simple : gtycon { ($1, []) }
295 | gtyconvars { case $1 of (tc,tvs) -> (tc, reverse tvs) }
297 gtyconvars :: { (RdrName, [FAST_STRING] {-reversed-}) }
298 gtyconvars : gtycon VARID { ($1, [$2]) }
299 | gtyconvars VARID { case $1 of (tc,tvs) -> (tc, $2 : tvs) }
301 constrs :: { [(RdrName, RdrNameConDecl)] }
302 constrs : constr { [$1] }
303 | constrs VBAR constr { $1 ++ [$3] }
305 constr :: { (RdrName, RdrNameConDecl) }
307 { case $1 of (con, tys) -> (con, ConDecl con tys mkIfaceSrcLoc) }
308 | OPAREN QCONSYM CPAREN { ($2, ConDecl $2 [] mkIfaceSrcLoc) }
309 | OPAREN QCONSYM CPAREN batypes { ($2, ConDecl $2 $4 mkIfaceSrcLoc) }
310 | OPAREN CONSYM CPAREN { (Unqual $2, ConDecl (Unqual $2) [] mkIfaceSrcLoc) }
311 | OPAREN CONSYM CPAREN batypes { (Unqual $2, ConDecl (Unqual $2) $4 mkIfaceSrcLoc) }
312 | gtycon OCURLY fields CCURLY
313 { ($1, RecConDecl $1 $3 mkIfaceSrcLoc) }
315 btyconapp :: { (RdrName, [RdrNameBangType]) }
316 btyconapp : gtycon { ($1, []) }
317 | btyconapp batype { case $1 of (tc,tys) -> (tc, tys ++ [$2]) }
319 bbtype :: { RdrNameBangType }
320 bbtype : btype { Unbanged (HsPreForAllTy [] $1) }
321 | BANG atype { Banged (HsPreForAllTy [] $2) }
323 batype :: { RdrNameBangType }
324 batype : atype { Unbanged (HsPreForAllTy [] $1) }
325 | BANG atype { Banged (HsPreForAllTy [] $2) }
327 batypes :: { [RdrNameBangType] }
328 batypes : batype { [$1] }
329 | batypes batype { $1 ++ [$2] }
331 fields :: { [([RdrName], RdrNameBangType)] }
332 fields : field { [$1] }
333 | fields COMMA field { $1 ++ [$3] }
335 field :: { ([RdrName], RdrNameBangType) }
336 field : var DCOLON type { ([$1], Unbanged (HsPreForAllTy [] $3)) }
337 | var DCOLON BANG atype { ([$1], Banged (HsPreForAllTy [] $4)) }
339 constr1 :: { (RdrName, RdrNameMonoType) }
340 constr1 : gtycon atype { ($1, $2) }
344 | OPAREN QVARSYM CPAREN { $2 }
345 | VARID { Unqual $1 }
346 | OPAREN VARSYM CPAREN { Unqual $2 }
348 op :: { FAST_STRING }
349 op : BQUOTE VARID BQUOTE { $2 }
350 | BQUOTE CONID BQUOTE { $2 }
355 qop : BQUOTE QVARID BQUOTE { $2 }
356 | BQUOTE QCONID BQUOTE { $2 }
361 iname :: { FAST_STRING }
364 | OPAREN VARSYM CPAREN { $2 }
365 | OPAREN CONSYM CPAREN { $2 }
367 qiname :: { RdrName }
368 qiname : QVARID { $1 }
370 | OPAREN QVARSYM CPAREN { $2 }
371 | OPAREN QCONSYM CPAREN { $2 }
372 | iname { Unqual $1 }
374 instances_part :: { Bag RdrIfaceInst }
375 instances_part : INSTANCES_PART instdecls { $2 }
378 instdecls :: { Bag RdrIfaceInst }
379 instdecls : instd { unitBag $1 }
380 | instdecls instd { $1 `snocBag` $2 }
382 instd :: { RdrIfaceInst }
383 instd : INSTANCE context DARROW gtycon restrict_inst SEMI { mk_inst $2 $4 $5 }
384 | INSTANCE gtycon general_inst SEMI { mk_inst [] $2 $3 }
386 restrict_inst :: { RdrNameMonoType }
387 restrict_inst : gtycon { MonoTyApp $1 [] }
388 | OPAREN gtyconvars CPAREN { case $2 of (tc,tvs) -> MonoTyApp tc (map en_mono tvs) }
389 | OPAREN VARID COMMA tyvar_list CPAREN { MonoTupleTy (map en_mono ($2:$4)) }
390 | OBRACK VARID CBRACK { MonoListTy (en_mono $2) }
391 | OPAREN VARID RARROW VARID CPAREN { MonoFunTy (en_mono $2) (en_mono $4) }
393 general_inst :: { RdrNameMonoType }
394 general_inst : gtycon { MonoTyApp $1 [] }
395 | OPAREN gtyconapp CPAREN { case $2 of (tc,tys) -> MonoTyApp tc tys }
396 | OPAREN type COMMA types CPAREN { MonoTupleTy ($2:$4) }
397 | OBRACK type CBRACK { MonoListTy $2 }
398 | OPAREN btype RARROW type CPAREN { MonoFunTy $2 $4 }
400 tyvar_list :: { [FAST_STRING] }
401 tyvar_list : VARID { [$1] }
402 | tyvar_list COMMA VARID { $1 ++ [$3]
403 --------------------------------------------------------------------------
406 pragmas_part :: { LocalPragmasMap }
407 pragmas_part : PRAGMAS_PART