X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FBuildTyCl.lhs;h=d1118c01286375ae1cca62c81235d0ee599cd1c8;hb=0b86bc9b022a5965d2b35f143ff4b919f784e676;hp=e4c392b6a55fe6d2e46b9be604b772275d7ce285;hpb=3e0b6b2542d8464bfba365b97a6e4b95c3885f10;p=ghc-hetmet.git

diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index e4c392b..d1118c0 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -82,13 +82,24 @@ mkNewTyConRhs :: Name -> TyCon -> DataCon -> TcRnIf m n AlgTyConRhs
 -- because the latter is part of a knot, whereas the former is not.
 mkNewTyConRhs tycon_name tycon con 
   = do	{ co_tycon_name <- newImplicitBinder tycon_name mkNewTyCoOcc
-	; let co_tycon = mkNewTypeCoercion co_tycon_name tycon tvs rhs_ty 
+	; let co_tycon = mkNewTypeCoercion co_tycon_name tycon tvs rhs_ty
+              cocon_maybe 
+                | all_coercions || isRecursiveTyCon tycon 
+                = Just co_tycon
+                | otherwise              
+                = Nothing
 	; return (NewTyCon { data_con = con, 
- 		       	     nt_co = co_tycon,
+ 		       	     nt_co = cocon_maybe, 
+                             -- Coreview looks through newtypes with a Nothing
+                             -- for nt_co, or uses explicit coercions otherwise
 		       	     nt_rhs = rhs_ty,
 		       	     nt_etad_rhs = eta_reduce tvs rhs_ty,
 		       	     nt_rep = mkNewTyConRep tycon rhs_ty }) }
   where
+        -- if all_coercions is True then we use coercions for all newtypes
+        -- otherwise we use coercions for recursive newtypes and look through
+        -- non-recursive newtypes
+    all_coercions = True
     tvs    = tyConTyVars tycon
     rhs_ty = head (dataConInstOrigArgTys con (mkTyVarTys tvs))
 	-- Instantiate the data con with the 
@@ -116,9 +127,8 @@ mkNewTyConRep :: TyCon		-- The original type constructor
 -- Remember that the representation type is the *ultimate* representation
 -- type, looking through other newtypes.
 -- 
--- The non-recursive newtypes are easy, because they look transparent
--- to splitTyConApp_maybe, but recursive ones really are represented as
--- TyConApps (see TypeRep).
+-- splitTyConApp_maybe no longer looks through newtypes, so we must
+-- deal explicitly with this case
 -- 
 -- The trick is to to deal correctly with recursive newtypes
 -- such as	newtype T = MkT T
@@ -133,10 +143,11 @@ mkNewTyConRep tc rhs_ty
 	= case splitTyConApp_maybe rep_ty of
 	    Just (tc, tys)
 		| tc `elem` tcs -> unitTy	-- Recursive loop
-		| isNewTyCon tc -> ASSERT( isRecursiveTyCon tc )
-					-- Non-recursive ones have been 
-					-- dealt with by splitTyConApp_maybe
-				   go (tc:tcs) (substTyWith tvs tys rhs_ty)
+		| isNewTyCon tc -> 
+                    if isRecursiveTyCon tc then
+			go (tc:tcs) (substTyWith tvs tys rhs_ty)
+                    else
+                        substTyWith tvs tys rhs_ty
 		where
 		  (tvs, rhs_ty) = newTyConRhs tc