Extend Class.Class to include the TyCons of ATs

[ghc-hetmet.git] / compiler / iface / IfaceSyn.lhs

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index e01cc31..07f4a18 100644 (file)
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -81,15 +81,19 @@ data IfaceDecl
                                                -- imported modules may have been compiled with
                                                -- different flags to the current compilation unit
 
-  | IfaceSyn  {        ifName   :: OccName,            -- Type constructor
-               ifTyVars :: [IfaceTvBndr],      -- Type variables
-               ifSynRhs :: IfaceType           -- synonym expansion
+  | IfaceSyn  {        ifName    :: OccName,           -- Type constructor
+               ifTyVars  :: [IfaceTvBndr],     -- Type variables
+               ifOpenSyn :: Bool,              -- Is an open family?
+               ifSynRhs  :: IfaceType          -- Type for an ordinary
+                                               -- synonym and kind for an
+                                               -- open family
     }
 
   | IfaceClass { ifCtxt    :: IfaceContext,    -- Context...
                 ifName    :: OccName,          -- Name of the class
                 ifTyVars  :: [IfaceTvBndr],    -- Type variables
                 ifFDs     :: [FunDep FastString], -- Functional dependencies
+                ifATs     :: [IfaceDecl],      -- Associated type families
                 ifSigs    :: [IfaceClassOp],   -- Method signatures
                 ifRec     :: RecFlag           -- Is newtype/datatype associated with the class recursive?
     }
@@ -104,11 +108,15 @@ data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
 
 data IfaceConDecls
   = IfAbstractTyCon            -- No info
+  | IfOpenDataTyCon            -- Open data family
+  | IfOpenNewTyCon             -- Open newtype family
   | IfDataTyCon [IfaceConDecl] -- data type decls
   | IfNewTyCon  IfaceConDecl   -- newtype decls
 
 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
 visibleIfConDecls IfAbstractTyCon  = []
+visibleIfConDecls IfOpenDataTyCon  = []
+visibleIfConDecls IfOpenNewTyCon   = []
 visibleIfConDecls (IfDataTyCon cs) = cs
 visibleIfConDecls (IfNewTyCon c)   = [c]
 
@@ -195,7 +203,7 @@ data IfaceNote = IfaceSCC CostCentre
                | IfaceCoreNote String
 
 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
-       -- Note: OccName, not IfaceBndr (and same with the case binder)
+       -- Note: FastString, not IfaceBndr (and same with the case binder)
        -- We reconstruct the kind/type of the thing from the context
        -- thus saving bulk in interface files
 
@@ -229,10 +237,16 @@ pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
 pprIfaceDecl (IfaceForeign {ifName = tycon})
   = hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
 
-pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, ifSynRhs = mono_ty})
+pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, 
+                       ifOpenSyn = False, ifSynRhs = mono_ty})
   = hang (ptext SLIT("type") <+> pprIfaceDeclHead [] tycon tyvars)
        4 (equals <+> ppr mono_ty)
 
+pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, 
+                       ifOpenSyn = True, ifSynRhs = mono_ty})
+  = hang (ptext SLIT("type family") <+> pprIfaceDeclHead [] tycon tyvars)
+       4 (dcolon <+> ppr mono_ty)
+
 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
                         ifTyVars = tyvars, ifCons = condecls, 
                         ifRec = isrec})
@@ -241,14 +255,18 @@ pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
   where
     pp_nd = case condecls of
                IfAbstractTyCon -> ptext SLIT("data")
+               IfOpenDataTyCon -> ptext SLIT("data family")
                IfDataTyCon _   -> ptext SLIT("data")
                IfNewTyCon _    -> ptext SLIT("newtype")
+               IfOpenNewTyCon  -> ptext SLIT("newtype family")
 
 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars, 
-                         ifFDs = fds, ifSigs = sigs, ifRec = isrec})
+                         ifFDs = fds, ifATs = ats, ifSigs = sigs, 
+                         ifRec = isrec})
   = hang (ptext SLIT("class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
        4 (vcat [pprRec isrec,
-               sep (map ppr sigs)])
+               sep (map ppr ats),
+               sep (map ppr sigs)])
 
 pprRec isrec = ptext SLIT("RecFlag") <+> ppr isrec
 pprGen True  = ptext SLIT("Generics: yes")
@@ -262,7 +280,9 @@ pprIfaceDeclHead context thing tyvars
   = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing), pprIfaceTvBndrs tyvars]
 
 pp_condecls tc IfAbstractTyCon  = ptext SLIT("{- abstract -}")
+pp_condecls tc IfOpenNewTyCon   = empty
 pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
+pp_condecls tc IfOpenDataTyCon  = empty
 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext SLIT(" |"))
                                                             (map (pprIfaceConDecl tc) cs))
 
@@ -529,6 +549,7 @@ eqIfDecl d1@(IfaceClass {}) d2@(IfaceClass {})
     eqWith (ifTyVars d1) (ifTyVars d2) (\ env -> 
          eq_ifContext env (ifCtxt d1) (ifCtxt d2)  &&&
          eqListBy (eq_hsFD env)    (ifFDs d1)  (ifFDs d2) &&&
+         eqListBy eqIfDecl         (ifATs d1)  (ifATs d2) &&&
          eqListBy (eq_cls_sig env) (ifSigs d1) (ifSigs d2)
        )
 
@@ -556,6 +577,8 @@ eq_hsCD env (IfDataTyCon c1) (IfDataTyCon c2)
 
 eq_hsCD env (IfNewTyCon c1)  (IfNewTyCon c2)  = eq_ConDecl env c1 c2
 eq_hsCD env IfAbstractTyCon  IfAbstractTyCon  = Equal
+eq_hsCD env IfOpenDataTyCon  IfOpenDataTyCon  = Equal
+eq_hsCD env IfOpenNewTyCon   IfOpenNewTyCon   = Equal
 eq_hsCD env d1              d2               = NotEqual
 
 eq_ConDecl env c1 c2