[commit: ghc] master: Teach DmdAnal about free coercion variables (3bec1ac)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/3bec1ac0117d4c46b2cc5012dca9a07d481137be/ghc

>---------------------------------------------------------------

commit 3bec1ac0117d4c46b2cc5012dca9a07d481137be
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Apr 20 15:57:54 2015 +0100

    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.


>---------------------------------------------------------------

3bec1ac0117d4c46b2cc5012dca9a07d481137be
 compiler/stranal/DmdAnal.hs | 17 +++++++++++------
 1 file changed, 11 insertions(+), 6 deletions(-)

diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs
index 2520f2a..4117eae 100644
--- a/compiler/stranal/DmdAnal.hs
+++ b/compiler/stranal/DmdAnal.hs
@@ -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