ATs are now implicitTyThings

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

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 0d649fb..5f9c1d8 100644 (file)
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -70,16 +70,26 @@ data IfaceDecl
              ifType   :: IfaceType, 
              ifIdInfo :: IfaceIdInfo }
 
-  | IfaceData { ifName       :: OccName,               -- Type constructor
+  | IfaceData { ifName       :: OccName,       -- Type constructor
                ifTyVars     :: [IfaceTvBndr],  -- Type variables
                ifCtxt       :: IfaceContext,   -- The "stupid theta"
                ifCons       :: IfaceConDecls,  -- Includes new/data info
                ifRec        :: RecFlag,        -- Recursive or not?
-               ifGadtSyntax :: Bool,           -- True <=> declared using GADT syntax
-               ifGeneric    :: Bool            -- True <=> generic converter functions available
-    }                                          -- We need this for imported data decls, since the
-                                               -- imported modules may have been compiled with
-                                               -- different flags to the current compilation unit
+               ifGadtSyntax :: Bool,           -- True <=> declared using
+                                               -- GADT syntax 
+               ifGeneric    :: Bool,           -- True <=> generic converter
+                                               --          functions available
+                                               -- We need this for imported
+                                               -- data decls, since the
+                                               -- imported modules may have
+                                               -- been compiled with
+                                               -- different flags to the
+                                               -- current compilation unit 
+                ifFamInst    :: Maybe           -- Just _ <=> instance of fam
+                                 (IfaceTyCon,  --   Family tycon
+                                  [IfaceType], --   Instance types
+                                  Int    )     --   Unique index for naming
+    }
 
   | IfaceSyn  {        ifName    :: OccName,           -- Type constructor
                ifTyVars  :: [IfaceTvBndr],     -- Type variables
@@ -93,6 +103,7 @@ data IfaceDecl
                 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?
     }
@@ -129,8 +140,9 @@ data IfaceConDecl
        ifConCtxt    :: IfaceContext,           -- Non-stupid context
        ifConArgTys  :: [IfaceType],            -- Arg types
        ifConFields  :: [OccName],              -- ...ditto... (field labels)
-       ifConStricts :: [StrictnessMark] }      -- Empty (meaning all lazy), or 1-1 corresp with arg types
-                       
+       ifConStricts :: [StrictnessMark]}       -- Empty (meaning all lazy),
+                                               -- or 1-1 corresp with arg tys
+
 data IfaceInst 
   = IfaceInst { ifInstCls  :: IfaceExtName,            -- See comments with
                ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of Instance
@@ -248,9 +260,10 @@ pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 
 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
                         ifTyVars = tyvars, ifCons = condecls, 
-                        ifRec = isrec})
+                        ifRec = isrec, ifFamInst = mbFamInst})
   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
-       4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls])
+       4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
+               pprFamily mbFamInst])
   where
     pp_nd = case condecls of
                IfAbstractTyCon -> ptext SLIT("data")
@@ -260,21 +273,29 @@ pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
                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")
 pprGen False = ptext SLIT("Generics: no")
 
+pprFamily Nothing                  = ptext SLIT("FamilyInstance: none")
+pprFamily (Just (fam, tys, index)) = ptext SLIT("FamilyInstance:") <+> 
+                                    ppr fam <+> hsep (map ppr tys) <+>
+                                    brackets (ppr index)
+
 instance Outputable IfaceClassOp where
    ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
 
 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
-pprIfaceDeclHead context thing tyvars 
-  = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing), pprIfaceTvBndrs tyvars]
+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
@@ -526,6 +547,7 @@ eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
          ifRec d1     == ifRec   d2 && 
          ifGadtSyntax d1 == ifGadtSyntax   d2 && 
          ifGeneric d1 == ifGeneric d2) &&&
+    ifFamInst d1 `eqIfTc_fam` ifFamInst d2 &&&
     eqWith (ifTyVars d1) (ifTyVars d2) (\ env -> 
            eq_ifContext env (ifCtxt d1) (ifCtxt d2) &&& 
            eq_hsCD env (ifCons d1) (ifCons d2) 
@@ -533,6 +555,11 @@ eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
        -- The type variables of the data type do not scope
        -- over the constructors (any more), but they do scope
        -- over the stupid context in the IfaceConDecls
+  where
+    Nothing                  `eqIfTc_fam` Nothing                  = Equal
+    (Just (fam1, tys1, co1)) `eqIfTc_fam` (Just (fam2, tys2, co2)) = 
+      fam1 `eqIfTc` fam2 &&& eqListBy eqIfType tys1 tys2 &&& bool (co1 == co2)
+    _                       `eqIfTc_fam` _                        = NotEqual
 
 eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
   = bool (ifName d1 == ifName d2) &&&
@@ -546,6 +573,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)
        )