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 Outputable -- ToDo:rm
+--import PprStyle ( PprStyle(..) ) -- ToDo: rm debugging
import SrcLoc ( mkIfaceSrcLoc )
-import Util ( panic, pprPanic{-ToDo:rm-} )
+import Util ( panic{-, pprPanic ToDo:rm-} )
-----------------------------------------------------------------
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 }
name_version_pairs :: { Bag (FAST_STRING, Int) }
name_version_pairs : name_version_pair
{ unitBag $1 }
- | name_version_pairs COMMA name_version_pair
- { $1 `snocBag` $3 }
+ | name_version_pairs name_version_pair
+ { $1 `snocBag` $2 }
name_version_pair :: { (FAST_STRING, Int) }
-name_version_pair : iname INTEGER
+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 :: { Bag (FAST_STRING, (OrigName, ExportFlag)) }
export_items : export_item { unitBag $1 }
| export_items export_item { $1 `snocBag` $2 }
-export_item :: { (FAST_STRING, (RdrName, ExportFlag)) }
-export_item : qiname maybe_dotdot { (de_qual $1, ($1, $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 }
| fixes fix { case $2 of (k,v) -> addToFM $1 k v }
fix :: { (FAST_STRING, RdrNameFixityDecl) }
-fix : INFIXL INTEGER qop SEMI { (de_qual $3, InfixL $3 (fromInteger $2)) }
- | INFIXR INTEGER qop SEMI { (de_qual $3, InfixR $3 (fromInteger $2)) }
- | INFIX INTEGER qop SEMI { (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 }
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)
+-- _ -> 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 (HsPreForAllTy [] $1) }
- | BANG atype { Banged (HsPreForAllTy [] $2) }
-
batype :: { RdrNameBangType }
-batype : atype { Unbanged (HsPreForAllTy [] $1) }
- | BANG atype { Banged (HsPreForAllTy [] $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 (HsPreForAllTy [] $3)) }
- | var DCOLON BANG atype { ([$1], Banged (HsPreForAllTy [] $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 instd { $1 `snocBag` $2 }
instd :: { RdrIfaceInst }
-instd : INSTANCE context DARROW gtycon restrict_inst SEMI { mk_inst $2 $4 $5 }
- | INSTANCE gtycon general_inst SEMI { 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