[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

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index bda97b4..4d2a1ee 100644 (file)
--- 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 (file)
--- 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