From: simonpj <unknown>
Date: Fri, 14 Jun 2002 14:00:49 +0000 (+0000)
Subject: [project @ 2002-06-14 14:00:49 by simonpj]
X-Git-Tag: Approx_11550_changesets_converted~1967
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=c5a96ed0c3563af8ae78793ad9f1f0fbb4c8c838;p=ghc-hetmet.git

[project @ 2002-06-14 14:00:49 by simonpj]
Wibble in Generics; fixes str002
---

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