module ParseIface ( parseIface ) where
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
import ParseUtils
import HsPragmas ( noGenPragmas )
import Bag ( emptyBag, unitBag, snocBag )
-import FiniteMap ( emptyFM, unitFM, addToFM, plusFM, bagToFM )
-import Name ( ExportFlag(..), mkTupNameStr,
+import FiniteMap ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
+import Name ( ExportFlag(..), mkTupNameStr, preludeQual,
RdrName(..){-instance Outputable:ToDo:rm-}
)
import Outputable -- ToDo:rm
import PprStyle ( PprStyle(..) ) -- ToDo: rm debugging
import SrcLoc ( mkIfaceSrcLoc )
-import Util ( pprPanic{-ToDo:rm-} )
+import Util ( panic, pprPanic{-ToDo:rm-} )
-----------------------------------------------------------------
%token
INTERFACE { ITinterface }
+ USAGES_PART { ITusages }
VERSIONS_PART { ITversions }
EXPORTS_PART { ITexports }
INSTANCE_MODULES_PART { ITinstance_modules }
DECLARATIONS_PART { ITdeclarations }
PRAGMAS_PART { ITpragmas }
BANG { ITbang }
- BQUOTE { ITbquote }
CBRACK { ITcbrack }
CCURLY { ITccurly }
+ DCCURLY { ITdccurly }
CLASS { ITclass }
COMMA { ITcomma }
CPAREN { ITcparen }
DCOLON { ITdcolon }
DOTDOT { ITdotdot }
EQUAL { ITequal }
+ FORALL { ITforall }
INFIX { ITinfix }
INFIXL { ITinfixl }
INFIXR { ITinfixr }
NEWTYPE { ITnewtype }
OBRACK { ITobrack }
OCURLY { ITocurly }
+ DOCURLY { ITdocurly }
OPAREN { IToparen }
RARROW { ITrarrow }
SEMI { ITsemi }
iface :: { ParsedIface }
iface : INTERFACE CONID INTEGER
- versions_part exports_part inst_modules_part
+ usages_part versions_part
+ exports_part inst_modules_part
fixities_part decls_part instances_part pragmas_part
- { case $8 of { (tm, vm) ->
- ParsedIface $2 (fromInteger $3) Nothing{-src version-}
- $4 -- local versions
- $5 -- exports map
- $6 -- instance modules
- $7 -- fixities map
+ { case $9 of { (tm, vm) ->
+ ParsedIface $2 (panic "merge modules") (fromInteger $3) Nothing{-src version-}
+ $4 -- usages
+ $5 -- local versions
+ $6 -- exports map
+ $7 -- instance modules
+ $8 -- fixities map
tm -- decls maps
vm
- $9 -- local instances
- $10 -- pragmas map
+ $10 -- local instances
+ $11 -- pragmas map
}
--------------------------------------------------------------------------
}
-versions_part :: { LocalVersionsMap }
-versions_part : VERSIONS_PART name_version_pairs
- { bagToFM $2 }
+usages_part :: { UsagesMap }
+usages_part : USAGES_PART module_stuff_pairs { bagToFM $2 }
+ | { emptyFM }
+
+versions_part :: { VersionsMap }
+versions_part : VERSIONS_PART name_version_pairs { bagToFM $2 }
+ | { emptyFM }
+
+module_stuff_pairs :: { Bag (Module, (Version, FiniteMap FAST_STRING Version)) }
+module_stuff_pairs : module_stuff_pair
+ { unitBag $1 }
+ | module_stuff_pairs module_stuff_pair
+ { $1 `snocBag` $2 }
+
+module_stuff_pair :: { (Module, (Version, FiniteMap FAST_STRING Version)) }
+module_stuff_pair : CONID INTEGER DCOLON name_version_pairs SEMI
+ { ($1, (fromInteger $2, bagToFM $4)) }
name_version_pairs :: { Bag (FAST_STRING, Int) }
-name_version_pairs : iname OPAREN INTEGER CPAREN
- { unitBag ($1, fromInteger $3) }
- | name_version_pairs iname OPAREN INTEGER CPAREN
- { $1 `snocBag` ($2, fromInteger $4)
+name_version_pairs : name_version_pair
+ { unitBag $1 }
+ | name_version_pairs name_version_pair
+ { $1 `snocBag` $2 }
+
+name_version_pair :: { (FAST_STRING, Int) }
+name_version_pair : name INTEGER
+ { ($1, fromInteger $2)
--------------------------------------------------------------------------
}
exports_part :: { ExportsMap }
exports_part : EXPORTS_PART export_items { bagToFM $2 }
+ | { emptyFM }
-export_items :: { Bag (FAST_STRING, (RdrName, ExportFlag)) }
-export_items : qiname maybe_dotdot
- { unitBag (de_qual $1, ($1, $2)) }
- | export_items qiname maybe_dotdot
- { $1 `snocBag` (de_qual $2, ($2, $3)) }
+export_items :: { Bag (FAST_STRING, (OrigName, ExportFlag)) }
+export_items : export_item { unitBag $1 }
+ | export_items export_item { $1 `snocBag` $2 }
+
+export_item :: { (FAST_STRING, (OrigName, ExportFlag)) }
+export_item : CONID name maybe_dotdot { ($2, (OrigName $1 $2, $3)) }
maybe_dotdot :: { ExportFlag }
maybe_dotdot : DOTDOT { ExportAll }
| { emptyFM }
fixes :: { FixitiesMap }
-fixes : fix { case $1 of (k,v) -> unitFM k v }
- | fixes SEMI fix { case $3 of (k,v) -> addToFM $1 k v }
+fixes : fix { case $1 of (k,v) -> unitFM k v }
+ | fixes fix { case $2 of (k,v) -> addToFM $1 k v }
fix :: { (FAST_STRING, RdrNameFixityDecl) }
-fix : INFIXL INTEGER qop { (de_qual $3, InfixL $3 (fromInteger $2)) }
- | INFIXR INTEGER qop { (de_qual $3, InfixR $3 (fromInteger $2)) }
- | INFIX INTEGER qop { (de_qual $3, InfixN $3 (fromInteger $2))
+fix : INFIXL INTEGER qname SEMI { (de_qual $3, InfixL $3 (fromInteger $2)) }
+ | INFIXR INTEGER qname SEMI { (de_qual $3, InfixR $3 (fromInteger $2)) }
+ | INFIX INTEGER qname SEMI { (de_qual $3, InfixN $3 (fromInteger $2))
--------------------------------------------------------------------------
}
decls_part :: { (LocalTyDefsMap, LocalValDefsMap) }
decls_part : DECLARATIONS_PART topdecls { $2 }
+ | { (emptyFM, emptyFM) }
topdecls :: { (LocalTyDefsMap, LocalValDefsMap) }
-topdecls : topdecl { $1 }
- | topdecls SEMI topdecl { case $1 of { (ts1, vs1) ->
- case $3 of { (ts2, vs2) ->
- (plusFM ts1 ts2, plusFM vs1 vs2)}}
- }
+topdecls : topdecl { $1 }
+ | topdecls topdecl { case $1 of { (ts1, vs1) ->
+ case $2 of { (ts2, vs2) ->
+ (plusFM ts1 ts2, plusFM vs1 vs2)}}
+ }
topdecl :: { (LocalTyDefsMap, LocalValDefsMap) }
-topdecl : typed { ($1, emptyFM) }
- | datad { $1 }
- | newtd { $1 }
- | classd { $1 }
+topdecl : typed SEMI { ($1, emptyFM) }
+ | datad SEMI { $1 }
+ | newtd SEMI { $1 }
+ | classd SEMI { $1 }
| decl { case $1 of { (n, Sig qn ty _ loc) ->
(emptyFM, unitFM n (ValSig qn loc ty)) }
}
| { [] }
decls :: { [(FAST_STRING, RdrNameSig)] }
-decls : decl { [$1] }
- | decls SEMI decl { $1 ++ [$3] }
+decls : decl { [$1] }
+ | decls decl { $1 ++ [$2] }
decl :: { (FAST_STRING, RdrNameSig) }
-decl : var DCOLON ctype { (de_qual $1, Sig $1 $3 noGenPragmas mkIfaceSrcLoc) }
+decl : var DCOLON ctype SEMI { (de_qual $1, Sig $1 $3 noGenPragmas mkIfaceSrcLoc) }
context :: { RdrNameContext }
-context : OPAREN context_list CPAREN { reverse $2 }
- | class { [$1] }
+context : DOCURLY context_list DCCURLY { reverse $2 }
context_list :: { RdrNameContext{-reversed-} }
context_list : class { [$1] }
class : gtycon VARID { ($1, Unqual $2) }
ctype :: { RdrNamePolyType }
-ctype : type DARROW type { HsPreForAllTy (type2context $1) $3 }
- | type { HsPreForAllTy [] $1 }
+ctype : FORALL OBRACK tyvars CBRACK context DARROW type { HsForAllTy (map Unqual $3) $5 $7 }
+ | FORALL OBRACK tyvars CBRACK type { HsForAllTy (map Unqual $3) [] $5 }
+ | type { HsForAllTy [] [] $1 }
type :: { RdrNameMonoType }
type : btype { $1 }
case ty1 of {
MonoTyVar tv -> MonoTyApp tv tys;
MonoTyApp tc ts -> MonoTyApp tc (ts++tys);
- MonoFunTy t1 t2 -> MonoTyApp (Unqual SLIT("->")) (t1:t2:tys);
- MonoListTy ty -> MonoTyApp (Unqual SLIT("[]")) (ty:tys);
- MonoTupleTy ts -> MonoTyApp (Unqual (mkTupNameStr (length ts)))
+ MonoFunTy t1 t2 -> MonoTyApp (preludeQual SLIT("->")) (t1:t2:tys);
+ MonoListTy ty -> MonoTyApp (preludeQual SLIT("[]")) (ty:tys);
+ MonoTupleTy ts -> MonoTyApp (preludeQual (mkTupNameStr (length ts)))
(ts++tys);
_ -> pprPanic "test:" (ppr PprDebug $1)
}}
gtycon :: { RdrName }
gtycon : QCONID { $1 }
- | CONID { Unqual $1 }
- | OPAREN RARROW CPAREN { Unqual SLIT("->") }
- | OBRACK CBRACK { Unqual SLIT("[]") }
- | OPAREN CPAREN { Unqual SLIT("()") }
- | OPAREN commas CPAREN { Unqual (mkTupNameStr $2) }
+ | OPAREN RARROW CPAREN { preludeQual SLIT("->") }
+ | OBRACK CBRACK { preludeQual SLIT("[]") }
+ | OPAREN CPAREN { preludeQual SLIT("()") }
+ | OPAREN commas CPAREN { preludeQual (mkTupNameStr $2) }
commas :: { Int }
commas : COMMA { 2{-1 comma => arity 2-} }
constr :: { (RdrName, RdrNameConDecl) }
constr : btyconapp
{ case $1 of (con, tys) -> (con, ConDecl con tys mkIfaceSrcLoc) }
- | OPAREN QCONSYM CPAREN { ($2, ConDecl $2 [] mkIfaceSrcLoc) }
- | OPAREN QCONSYM CPAREN batypes { ($2, ConDecl $2 $4 mkIfaceSrcLoc) }
- | OPAREN CONSYM CPAREN { (Unqual $2, ConDecl (Unqual $2) [] mkIfaceSrcLoc) }
- | OPAREN CONSYM CPAREN batypes { (Unqual $2, ConDecl (Unqual $2) $4 mkIfaceSrcLoc) }
+ | QCONSYM { ($1, ConDecl $1 [] mkIfaceSrcLoc) }
+ | QCONSYM batypes { ($1, ConDecl $1 $2 mkIfaceSrcLoc) }
| gtycon OCURLY fields CCURLY
{ ($1, RecConDecl $1 $3 mkIfaceSrcLoc) }
btyconapp : gtycon { ($1, []) }
| btyconapp batype { case $1 of (tc,tys) -> (tc, tys ++ [$2]) }
-bbtype :: { RdrNameBangType }
-bbtype : btype { Unbanged $1 }
- | BANG atype { Banged $2 }
-
batype :: { RdrNameBangType }
-batype : atype { Unbanged $1 }
- | BANG atype { Banged $2 }
+batype : atype { Unbanged (HsForAllTy [{-ToDo:tvs-}] [] $1) }
+ | BANG atype { Banged (HsForAllTy [{-ToDo:tvs-}] [] $2) }
batypes :: { [RdrNameBangType] }
batypes : batype { [$1] }
| fields COMMA field { $1 ++ [$3] }
field :: { ([RdrName], RdrNameBangType) }
-field : var DCOLON type { ([$1], Unbanged $3) }
- | var DCOLON BANG atype { ([$1], Banged $4) }
+field : var DCOLON type { ([$1], Unbanged (HsForAllTy [{-ToDo:tvs-}] [] $3)) }
+ | var DCOLON BANG atype { ([$1], Banged (HsForAllTy [{-ToDo:tvs-}] [] $4)) }
constr1 :: { (RdrName, RdrNameMonoType) }
constr1 : gtycon atype { ($1, $2) }
var :: { RdrName }
-var : QVARID { $1 }
- | OPAREN QVARSYM CPAREN { $2 }
- | VARID { Unqual $1 }
- | OPAREN VARSYM CPAREN { Unqual $2 }
-
-op :: { FAST_STRING }
-op : BQUOTE VARID BQUOTE { $2 }
- | BQUOTE CONID BQUOTE { $2 }
- | VARSYM { $1 }
- | CONSYM { $1 }
+var : QVARID { $1 }
+ | QVARSYM { $1 }
-qop :: { RdrName }
-qop : BQUOTE QVARID BQUOTE { $2 }
- | BQUOTE QCONID BQUOTE { $2 }
+qname :: { RdrName }
+qname : QVARID { $1 }
+ | QCONID { $1 }
| QVARSYM { $1 }
| QCONSYM { $1 }
- | op { Unqual $1 }
-iname :: { FAST_STRING }
-iname : VARID { $1 }
+name :: { FAST_STRING }
+name : VARID { $1 }
| CONID { $1 }
- | OPAREN VARSYM CPAREN { $2 }
- | OPAREN CONSYM CPAREN { $2 }
-
-qiname :: { RdrName }
-qiname : QVARID { $1 }
- | QCONID { $1 }
- | OPAREN QVARSYM CPAREN { $2 }
- | OPAREN QCONSYM CPAREN { $2 }
- | iname { Unqual $1 }
+ | VARSYM { $1 }
+ | BANG { SLIT("!"){-sigh, double-sigh-} }
+ | CONSYM { $1 }
+ | OBRACK CBRACK { SLIT("[]") }
+ | OPAREN CPAREN { SLIT("()") }
+ | OPAREN commas CPAREN { mkTupNameStr $2 }
instances_part :: { Bag RdrIfaceInst }
instances_part : INSTANCES_PART instdecls { $2 }
instdecls :: { Bag RdrIfaceInst }
instdecls : instd { unitBag $1 }
- | instdecls SEMI instd { $1 `snocBag` $3 }
+ | instdecls instd { $1 `snocBag` $2 }
instd :: { RdrIfaceInst }
-instd : INSTANCE context DARROW gtycon restrict_inst { mk_inst $2 $4 $5 }
- | INSTANCE gtycon general_inst { mk_inst [] $2 $3 }
+instd : INSTANCE FORALL OBRACK tyvars CBRACK context DARROW gtycon restrict_inst SEMI { mk_inst (map Unqual $4) $6 $8 $9 }
+ | INSTANCE FORALL OBRACK tyvars CBRACK gtycon general_inst SEMI { mk_inst (map Unqual $4) [] $6 $7 }
+ | INSTANCE gtycon general_inst SEMI { mk_inst [] [] $2 $3 }
restrict_inst :: { RdrNameMonoType }
restrict_inst : gtycon { MonoTyApp $1 [] }
- | OPAREN gtyconvars CPAREN { case $2 of (tc,tvs) -> MonoTyApp tc (map en_mono tvs) }
- | OPAREN VARID COMMA tyvar_list CPAREN { MonoTupleTy (map en_mono ($2:$4)) }
+ | OPAREN gtyconvars CPAREN { case $2 of (tc,tvs) -> MonoTyApp tc (map en_mono (reverse tvs)) }
+ | OPAREN VARID COMMA tyvars CPAREN { MonoTupleTy (map en_mono ($2:$4)) }
| OBRACK VARID CBRACK { MonoListTy (en_mono $2) }
| OPAREN VARID RARROW VARID CPAREN { MonoFunTy (en_mono $2) (en_mono $4) }
| OBRACK type CBRACK { MonoListTy $2 }
| OPAREN btype RARROW type CPAREN { MonoFunTy $2 $4 }
-tyvar_list :: { [FAST_STRING] }
-tyvar_list : VARID { [$1] }
- | tyvar_list COMMA VARID { $1 ++ [$3]
+tyvars :: { [FAST_STRING] }
+tyvars : VARID { [$1] }
+ | tyvars COMMA VARID { $1 ++ [$3]
--------------------------------------------------------------------------
}
projects / ghc-hetmet.git / blobdiff