X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FIfaceSyn.lhs;h=1e9e00fc19125dfdcf5c4429df36c4339d2614fd;hb=262c142b90c94ca1aa577c950a6ceae1f255e2d6;hp=ad4c913df16364291e52ca378b277351c1613cb7;hpb=d33c0b24a0306cc57161b7ed7ff2510d0b017b11;p=ghc-hetmet.git

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index ad4c913..1e9e00f 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -77,14 +77,21 @@ data IfaceDecl
     						-- current compilation unit 
                 ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
                                                 -- Just <=> instance of family
+                                                -- Invariant: 
+                                                --   ifCons /= IfOpenDataTyCon
+                                                --   for family instances
     }
 
   | IfaceSyn  {	ifName    :: OccName,		-- Type constructor
 		ifTyVars  :: [IfaceTvBndr],	-- Type variables
 		ifOpenSyn :: Bool,		-- Is an open family?
-		ifSynRhs  :: IfaceType		-- Type for an ordinary
+		ifSynRhs  :: IfaceType,		-- Type for an ordinary
 						-- synonym and kind for an
 						-- open family
+                ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
+                                                -- Just <=> instance of family
+                                                -- Invariant: ifOpenSyn == False
+                                                --   for family instances
     }
 
   | IfaceClass { ifCtxt    :: IfaceContext, 	-- Context...
@@ -108,14 +115,12 @@ 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]
 
@@ -393,9 +398,10 @@ pprIfaceDecl (IfaceForeign {ifName = tycon})
   = hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
 
 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, 
-		        ifOpenSyn = False, ifSynRhs = mono_ty})
+		        ifOpenSyn = False, ifSynRhs = mono_ty, 
+                        ifFamInst = mbFamInst})
   = hang (ptext SLIT("type") <+> pprIfaceDeclHead [] tycon tyvars)
-       4 (equals <+> ppr mono_ty)
+       4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
 
 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, 
 		        ifOpenSyn = True, ifSynRhs = mono_ty})
@@ -414,7 +420,6 @@ pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
 		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, ifATs = ats, ifSigs = sigs, 
@@ -440,7 +445,6 @@ pprIfaceDeclHead context thing tyvars
 	  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(" |"))
@@ -716,14 +720,10 @@ 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)) `eqIfTc_fam` (Just (fam2, tys2)) = 
-      fam1 `eqIfTc` fam2 &&& eqListBy eqIfType tys1 tys2
-    _		        `eqIfTc_fam` _                   = NotEqual
 
 eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
   = bool (ifName d1 == ifName d2) &&&
+    ifFamInst d1 `eqIfTc_fam` ifFamInst d2 &&&
     eqWith (ifTyVars d1) (ifTyVars d2) (\ env -> 
           eq_ifType env (ifSynRhs d1) (ifSynRhs d2)
         )
@@ -744,6 +744,15 @@ eqIfDecl _ _ = NotEqual	-- default case
 eqWith :: [IfaceTvBndr] -> [IfaceTvBndr] -> (EqEnv -> IfaceEq) -> IfaceEq
 eqWith = eq_ifTvBndrs emptyEqEnv
 
+eqIfTc_fam :: Maybe (IfaceTyCon, [IfaceType]) 
+           -> Maybe (IfaceTyCon, [IfaceType])
+           -> IfaceEq
+Nothing             `eqIfTc_fam` Nothing             = Equal
+(Just (fam1, tys1)) `eqIfTc_fam` (Just (fam2, tys2)) = 
+  fam1 `eqIfTc` fam2 &&& eqListBy eqIfType tys1 tys2
+_		        `eqIfTc_fam` _               = NotEqual
+
+
 -----------------------
 eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2 && ifOFlag d1 == ifOFlag d2)
 -- All other changes are handled via the version info on the dfun
@@ -766,7 +775,6 @@ 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