X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FGenerics.lhs;fp=ghc%2Fcompiler%2Ftypes%2FGenerics.lhs;h=197fb2d4f6baca0a3195c5fe27ab9b74ca8cceb1;hb=c5a96ed0c3563af8ae78793ad9f1f0fbb4c8c838;hp=cc611618f350b32c408ed25fd01c4f14179d4b70;hpb=9505a207ac1da84fceb333b8b444ed364a478033;p=ghc-hetmet.git

diff --git a/ghc/compiler/types/Generics.lhs b/ghc/compiler/types/Generics.lhs
index cc61161..197fb2d 100644
--- a/ghc/compiler/types/Generics.lhs
+++ b/ghc/compiler/types/Generics.lhs
@@ -16,7 +16,7 @@ import TcType		( tcSplitTyConApp_maybe, tcSplitSigmaTy, tcSplitSigmaTy )
 import DataCon          ( DataCon, dataConOrigArgTys, dataConWrapId, isExistentialDataCon )
 
 import TyCon            ( TyCon, tyConTyVars, tyConDataCons_maybe, 
-			  tyConGenInfo, isNewTyCon, newTyConRep, isBoxedTupleTyCon
+			  tyConGenInfo, isNewTyCon, isBoxedTupleTyCon
 			)
 import Name		( Name, mkSystemName )
 import CoreSyn          ( mkLams, Expr(..), CoreExpr, AltCon(..), 
@@ -31,7 +31,7 @@ import TysWiredIn       ( genericTyCons,
 			  genUnitTyCon, genUnitDataCon, plusTyCon, inrDataCon,
 			  inlDataCon, crossTyCon, crossDataCon
 			)
-import IdInfo           ( noCafNoTyGenIdInfo, setUnfoldingInfo, setArityInfo )
+import IdInfo           ( noCafIdInfo, setUnfoldingInfo, setArityInfo )
 import CoreUnfold       ( mkTopUnfolding ) 
 
 import Maybe		( isNothing )
@@ -271,9 +271,9 @@ mkTyConGenInfo tycon [from_name, to_name]
     tycon_ty	   = mkTyConApp tycon tyvar_tys	-- T a b c
     tyvar_tys      = mkTyVarTys tyvars
 
-    from_id_info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkTopUnfolding from_fn
+    from_id_info = noCafIdInfo `setUnfoldingInfo` mkTopUnfolding from_fn
 				      `setArityInfo`     exprArity from_fn
-    to_id_info   = noCafNoTyGenIdInfo `setUnfoldingInfo` mkTopUnfolding to_fn
+    to_id_info   = noCafIdInfo `setUnfoldingInfo` mkTopUnfolding to_fn
 				      `setArityInfo`     exprArity to_fn
 	-- It's important to set the arity info, so that
 	-- the calling convention (gotten from arity) 
@@ -284,9 +284,9 @@ mkTyConGenInfo tycon [from_name, to_name]
 
     (from_fn, to_fn, rep_ty) 
 	| isNewTyCon tycon
-	= ( mkLams tyvars $ Lam x  $ mkNewTypeBody tycon newrep_ty (Var x),
+	= ( mkLams tyvars $ Lam x  $ mkNewTypeBody tycon the_arg_ty (Var x),
 	    Var (dataConWrapId the_datacon),
-	    newrep_ty )
+	    the_arg_ty )
 
 	| otherwise
 	= ( mkLams tyvars $ Lam x     $ Case (Var x) x from_alts,
@@ -300,8 +300,12 @@ mkTyConGenInfo tycon [from_name, to_name]
 	    ----------------------
 	    -- 	Newtypes only
     [the_datacon]  = datacons
-    (_, newrep_ty) = newTyConRep tycon
-       
+    the_arg_ty	   = head (dataConOrigArgTys the_datacon)
+		-- NB: we use the arg type of the data constructor, rather than
+		--     the representation type of the newtype; in degnerate (recursive)
+		--     cases the rep type might be (), but the arg type is still T:
+		-- 		newtype T = MkT T
+
 	    ----------------------
 	    -- 	Non-newtypes only
     -- Recurse over the sum first