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
import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
import Literal ( Literal(..) )
import TyCon ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
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 )
import Class ( Class, classTyCon, classTyVars, classSelIds )
import Var ( Id, TyVar )
import VarSet ( isEmptyVarSet )
strict_info = mkStrictnessInfo (dataConRepStrictness data_con, False)
strict_info = mkStrictnessInfo (dataConRepStrictness data_con, False)
+ tycon = dataConTyCon data_con
cpr_info | isProductTyCon tycon &&
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
\end{code}
The wrapper for a constructor is an ordinary top-level binding that evaluates
import CoreSyn
import CoreUtils ( exprIsValue )
import Id ( Id, setIdCprInfo, idCprInfo, idArity,
import CoreSyn
import CoreUtils ( exprIsValue )
import Id ( Id, setIdCprInfo, idCprInfo, idArity,
- isBottomingId, idDemandInfo )
+ isBottomingId, idDemandInfo, isImplicitId )
import IdInfo ( CprInfo(..) )
import Demand ( isStrict )
import VarEnv
import IdInfo ( CprInfo(..) )
import Demand ( isStrict )
import VarEnv
-- Return environment extended with info from this binding
cprAnalBind :: CPREnv -> CoreBind -> (CPREnv, CoreBind)
cprAnalBind rho (NonRec b e)
-- 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
= (extendVarEnv rho b absval, NonRec b' e')
where
(e', absval) = cprAnalExpr rho e