X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FExternalCore.lhs;h=359419ca0654a1f8f3da9479b60ead108cc10e1c;hp=5754f844bc203e14a940e55b95d250a8c860ac39;hb=86add45dbfb6f962b65e371143dd467ae783f9e7;hpb=2fbab1a0f1a017799e8f5130bdf1078060623f29 diff --git a/compiler/coreSyn/ExternalCore.lhs b/compiler/coreSyn/ExternalCore.lhs index 5754f84..359419c 100644 --- a/compiler/coreSyn/ExternalCore.lhs +++ b/compiler/coreSyn/ExternalCore.lhs @@ -4,26 +4,24 @@ \begin{code} module ExternalCore where - data Module = Module Mname [Tdef] [Vdefg] data Tdef = Data (Qual Tcon) [Tbind] [Cdef] - | Newtype (Qual Tcon) [Tbind] Axiom (Maybe Ty) + | Newtype (Qual Tcon) (Qual Tcon) [Tbind] Ty data Cdef - = Constr Dcon [Tbind] [Ty] - | GadtConstr Dcon Ty - --- Newtype coercion -type Axiom = (Qual Tcon, Kind) + = Constr (Qual Dcon) [Tbind] [Ty] + | GadtConstr (Qual Dcon) Ty data Vdefg = Rec [Vdef] | Nonrec Vdef -type Vdef = (Bool,Var,Ty,Exp) -- Top level bindings are unqualified now +-- Top-level bindings are qualified, so that the printer doesn't have to pass +-- around the module name. +type Vdef = (Bool,Qual Var,Ty,Exp) data Exp = Var (Qual Var) @@ -52,11 +50,21 @@ data Alt type Vbind = (Var,Ty) type Tbind = (Tvar,Kind) +-- Internally, we represent types and coercions separately; but for +-- the purposes of external core (at least for now) it's still +-- convenient to collapse them into a single type. data Ty = Tvar Tvar | Tcon (Qual Tcon) | Tapp Ty Ty | Tforall Tbind Ty +-- We distinguish primitive coercions because External Core treats +-- them specially, so we have to print them out with special syntax. + | TransCoercion Ty Ty + | SymCoercion Ty + | UnsafeCoercion Ty Ty + | InstCoercion Ty Ty + | NthCoercion Int Ty data Kind = Klifted @@ -86,7 +94,7 @@ type Id = String primMname :: Mname -- For truly horrible reasons, this must be z-encoded. -- With any hope, the z-encoding will die soon. -primMname = "ghc-prim:GHCziPrim" +primMname = "ghczmprim:GHCziPrim" tcArrow :: Qual Tcon tcArrow = (primMname, "(->)")