From d057b483d3683839058fee62a4ca56c806108ef6 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Fri, 8 Dec 2000 12:13:13 +0000
Subject: [PATCH] [project @ 2000-12-08 12:13:13 by simonpj] Correct CPR
 information.  How it ever worked I don't know.

* The CPR info on a newtype constructor should be NoCPR, whereas
  before it was ReturnsCPR!

* Minor: don't change CPR info on implicit Ids
---
 ghc/compiler/basicTypes/MkId.lhs        |   21 +++++++--------------
 ghc/compiler/cprAnalysis/CprAnalyse.lhs |    5 ++++-
 2 files changed, 11 insertions(+), 15 deletions(-)

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index bda97b4..4d2a1ee 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -50,7 +50,7 @@ import CoreUtils	( exprType, mkInlineMe )
 import CoreUnfold 	( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
 import Literal		( Literal(..) )
 import TyCon		( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
-                          tyConTheta, isProductTyCon, isUnboxedTupleTyCon )
+                          tyConTheta, isProductTyCon, isDataTyCon )
 import Class		( Class, classTyCon, classTyVars, classSelIds )
 import Var		( Id, TyVar )
 import VarSet		( isEmptyVarSet )
@@ -178,20 +178,13 @@ mkDataConId work_name data_con
 
     strict_info = mkStrictnessInfo (dataConRepStrictness data_con, False)
 
+    tycon = dataConTyCon data_con
     cpr_info | isProductTyCon tycon && 
-	       not (isUnboxedTupleTyCon tycon) && 
-	       arity > 0 			= ReturnsCPR
-	     | otherwise 			= NoCPRInfo
-	     where
-		tycon = dataConTyCon data_con
-		-- Newtypes don't have a worker at all
-		-- 
-		-- If we are a product with 0 args we must be void(like)
-		-- We can't create an unboxed tuple with 0 args for this
-		-- and since Void has only one, constant value it should 
-		-- just mean returning a pointer to a pre-existing cell. 
-		-- So we won't really gain from doing anything fancy
-		-- and we treat this case as Top.
+	       isDataTyCon tycon    &&
+	       arity > 0 		= ReturnsCPR
+	     | otherwise 		= NoCPRInfo
+	-- ReturnsCPR is only true for products that are real data types;
+	-- that is, not unboxed tuples or newtypes
 \end{code}
 
 The wrapper for a constructor is an ordinary top-level binding that evaluates
diff --git a/ghc/compiler/cprAnalysis/CprAnalyse.lhs b/ghc/compiler/cprAnalysis/CprAnalyse.lhs
index ecba677..760d142 100644
--- a/ghc/compiler/cprAnalysis/CprAnalyse.lhs
+++ b/ghc/compiler/cprAnalysis/CprAnalyse.lhs
@@ -11,7 +11,7 @@ import CoreLint		( showPass, endPass )
 import CoreSyn
 import CoreUtils	( exprIsValue )
 import Id               ( Id, setIdCprInfo, idCprInfo, idArity,
-			  isBottomingId, idDemandInfo )
+			  isBottomingId, idDemandInfo, isImplicitId )
 import IdInfo           ( CprInfo(..) )
 import Demand		( isStrict )
 import VarEnv
@@ -155,6 +155,9 @@ with ids decorated with their CPR info.
 -- Return environment extended with info from this binding 
 cprAnalBind :: CPREnv -> CoreBind -> (CPREnv, CoreBind)
 cprAnalBind rho (NonRec b e) 
+  | isImplicitId b	-- Don't touch the CPR info on constructors, selectors etc
+  = (rho, NonRec b e)	
+  | otherwise
   = (extendVarEnv rho b absval, NonRec b' e')
   where
     (e', absval) = cprAnalExpr rho e
-- 
1.7.10.4