Commit 3bec1ac0 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Teach DmdAnal about free coercion variables

Coercion variables are used in casts and coercions, so the demand
analyser should jolly well not regard them as absent!

In fact this bug never makes a difference because even absent
unboxed-coercion arguments are passed anyway;
see WwLib.mk_abesnt_let, which returns Nothing for coercion Ids.

But it was simply wrong before and that is never cool.
parent d5773a49
......@@ -27,6 +27,7 @@ import Id
import CoreUtils ( exprIsHNF, exprType, exprIsTrivial )
import TyCon
import Type
import Coercion ( Coercion, coVarsOfCo )
import FamInstEnv
import Util
import Maybes ( isJust )
......@@ -131,13 +132,14 @@ dmdAnal env d e = -- pprTrace "dmdAnal" (ppr d <+> ppr e) $
dmdAnal' _ _ (Lit lit) = (nopDmdType, Lit lit)
dmdAnal' _ _ (Type ty) = (nopDmdType, Type ty) -- Doesn't happen, in fact
dmdAnal' _ _ (Coercion co) = (nopDmdType, Coercion co)
dmdAnal' _ _ (Coercion co)
= (unitDmdType (coercionDmdEnv co), Coercion co)
dmdAnal' env dmd (Var var)
= (dmdTransform env var dmd, Var var)
dmdAnal' env dmd (Cast e co)
= (dmd_ty, Cast e' co)
= (dmd_ty `bothDmdType` mkBothDmdArg (coercionDmdEnv co), Cast e' co)
where
(dmd_ty, e') = dmdAnal env dmd e
......@@ -504,7 +506,7 @@ dmdTransform env var dmd
else addVarDmd fn_ty var (mkOnceUsedDmd dmd)
| otherwise -- Local non-letrec-bound thing
= unitVarDmd var (mkOnceUsedDmd dmd)
= unitDmdType (unitVarEnv var (mkOnceUsedDmd dmd))
{-
************************************************************************
......@@ -700,9 +702,12 @@ a product type.
************************************************************************
-}
unitVarDmd :: Var -> Demand -> DmdType
unitVarDmd var dmd
= DmdType (unitVarEnv var dmd) [] topRes
unitDmdType :: DmdEnv -> DmdType
unitDmdType dmd_env = DmdType dmd_env [] topRes
coercionDmdEnv :: Coercion -> DmdEnv
coercionDmdEnv co = mapVarEnv (const topDmd) (coVarsOfCo co)
-- The VarSet from coVarsOfCo is really a VarEnv Var
addVarDmd :: DmdType -> Var -> Demand -> DmdType
addVarDmd (DmdType fv ds res) var dmd
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment