X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FBuildTyCl.lhs;h=333d8084ce4a301144cadb1ddcde85b41ef3c47c;hp=0e50f959d2d7d4c59986e22f0d77ed71be9f7aac;hb=6777144f7522d8db5935737e12fa451ca3211e6d;hpb=fd6ccd023fe4c1d4124a4fe504e07a23bf433722

diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index 0e50f95..333d808 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -7,7 +7,7 @@
 module BuildTyCl (
 	buildSynTyCon, buildAlgTyCon, buildDataCon,
 	buildClass,
-	mkAbstractTyConRhs, mkOpenDataTyConRhs, mkOpenNewTyConRhs,
+	mkAbstractTyConRhs, mkOpenDataTyConRhs, 
 	mkNewTyConRhs, mkDataTyConRhs 
     ) where
 
@@ -28,7 +28,6 @@ import Class
 import TyCon
 import Type
 import Coercion
-import Outputable
 
 import Data.List
 \end{code}
@@ -36,16 +35,29 @@ import Data.List
 
 \begin{code}
 ------------------------------------------------------
-buildSynTyCon :: Name -> [TyVar] -> SynTyConRhs -> TyCon
-buildSynTyCon name tvs rhs@(OpenSynTyCon rhs_ki)
-  = mkSynTyCon name kind tvs rhs
-  where
-    kind = mkArrowKinds (map tyVarKind tvs) rhs_ki
-buildSynTyCon name tvs rhs@(SynonymTyCon rhs_ty)
-  = mkSynTyCon name kind tvs rhs
-  where
-    kind = mkArrowKinds (map tyVarKind tvs) (typeKind rhs_ty)
+buildSynTyCon :: Name -> [TyVar] 
+              -> SynTyConRhs 
+	      -> Maybe (TyCon, [Type])  -- family instance if applicable
+              -> TcRnIf m n TyCon
 
+buildSynTyCon tc_name tvs rhs@(OpenSynTyCon rhs_ki _) _
+  = let
+      kind = mkArrowKinds (map tyVarKind tvs) rhs_ki
+    in
+    return $ mkSynTyCon tc_name kind tvs rhs NoParentTyCon
+    
+buildSynTyCon tc_name tvs rhs@(SynonymTyCon rhs_ty) mb_family
+  = do { -- We need to tie a knot as the coercion of a data instance depends
+	 -- on the instance representation tycon and vice versa.
+       ; tycon <- fixM (\ tycon_rec -> do 
+	 { parent <- mkParentInfo mb_family tc_name tvs tycon_rec
+	 ; let { tycon   = mkSynTyCon tc_name kind tvs rhs parent
+	       ; kind    = mkArrowKinds (map tyVarKind tvs) (typeKind rhs_ty)
+	       }
+         ; return tycon
+         })
+       ; return tycon 
+       }
 
 ------------------------------------------------------
 buildAlgTyCon :: Name -> [TyVar] 
@@ -62,7 +74,7 @@ buildAlgTyCon tc_name tvs stupid_theta rhs is_rec want_generics gadt_syn
   = do { -- We need to tie a knot as the coercion of a data instance depends
 	 -- on the instance representation tycon and vice versa.
        ; tycon <- fixM (\ tycon_rec -> do 
-	 { parent <- parentInfo mb_family tycon_rec
+	 { parent <- mkParentInfo mb_family tc_name tvs tycon_rec
 	 ; let { tycon = mkAlgTyCon tc_name kind tvs stupid_theta rhs
 				    fields parent is_rec want_generics gadt_syn
 	       ; kind    = mkArrowKinds (map tyVarKind tvs) liftedTypeKind
@@ -72,38 +84,38 @@ buildAlgTyCon tc_name tvs stupid_theta rhs is_rec want_generics gadt_syn
          })
        ; return tycon 
        }
-  where
-    -- If a family tycon with instance types is given, the current tycon is an
-    -- instance of that family and we need to
-    --
-    -- (1) create a coercion that identifies the family instance type and the
-    --     representation type from Step (1); ie, it is of the form 
-    --	   `Co tvs :: F ts :=: R tvs', where `Co' is the name of the coercion,
-    --	   `F' the family tycon and `R' the (derived) representation tycon,
-    --	   and
-    -- (2) produce a `AlgTyConParent' value containing the parent and coercion
-    --     information.
-    --
-    parentInfo Nothing                  rep_tycon = 
-      return NoParentTyCon
-    parentInfo (Just (family, instTys)) rep_tycon =
-      do { -- Create the coercion
-	 ; co_tycon_name <- newImplicitBinder tc_name mkInstTyCoOcc
-	 ; let co_tycon = mkDataInstCoercion co_tycon_name tvs
-					     family instTys rep_tycon
-	 ; return $ FamilyTyCon family instTys co_tycon
-	 }
-    
 
+-- If a family tycon with instance types is given, the current tycon is an
+-- instance of that family and we need to
+--
+-- (1) create a coercion that identifies the family instance type and the
+--     representation type from Step (1); ie, it is of the form 
+--	   `Co tvs :: F ts :=: R tvs', where `Co' is the name of the coercion,
+--	   `F' the family tycon and `R' the (derived) representation tycon,
+--	   and
+-- (2) produce a `TyConParent' value containing the parent and coercion
+--     information.
+--
+mkParentInfo :: Maybe (TyCon, [Type]) 
+             -> Name -> [TyVar] 
+             -> TyCon 
+             -> TcRnIf m n TyConParent
+mkParentInfo Nothing                  _       _   _         =
+  return NoParentTyCon
+mkParentInfo (Just (family, instTys)) tc_name tvs rep_tycon =
+  do { -- Create the coercion
+     ; co_tycon_name <- newImplicitBinder tc_name mkInstTyCoOcc
+     ; let co_tycon = mkFamInstCoercion co_tycon_name tvs
+                                        family instTys rep_tycon
+     ; return $ FamilyTyCon family instTys co_tycon
+     }
+    
 ------------------------------------------------------
 mkAbstractTyConRhs :: AlgTyConRhs
 mkAbstractTyConRhs = AbstractTyCon
 
 mkOpenDataTyConRhs :: AlgTyConRhs
-mkOpenDataTyConRhs = OpenDataTyCon
-
-mkOpenNewTyConRhs :: AlgTyConRhs
-mkOpenNewTyConRhs = OpenNewTyCon
+mkOpenDataTyConRhs = OpenTyCon Nothing
 
 mkDataTyConRhs :: [DataCon] -> AlgTyConRhs
 mkDataTyConRhs cons
@@ -141,7 +153,7 @@ mkNewTyConRhs tycon_name tycon con
     etad_rhs :: Type	-- return a TyCon without pulling on rhs_ty
 			-- See Note [Tricky iface loop] in LoadIface
     (etad_tvs, etad_rhs) = eta_reduce (reverse tvs) rhs_ty
-
+ 
     eta_reduce :: [TyVar]		-- Reversed
 	       -> Type			-- Rhs type
 	       -> ([TyVar], Type)	-- Eta-reduced version (tyvars in normal order)