[commit: ghc] cardinality: a bug with lazy FVs fixed (c7b561f)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : cardinality

http://hackage.haskell.org/trac/ghc/changeset/c7b561faf3560a5616558ee66ffc099098a03d4d

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

commit c7b561faf3560a5616558ee66ffc099098a03d4d
Author: Ilya Sergey <[email protected]>
Date:   Thu Sep 27 02:06:01 2012 +0100

    a bug with lazy FVs fixed

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

 compiler/stranal/DmdAnal.lhs |   12 +++++++++---
 1 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 4dcf4ce..aaac680 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -277,7 +277,7 @@ dmdAnal _ env dmd (Let (NonRec id rhs) body)
 
         -- Add lazy free variables
 	body_ty2		   = addLazyFVs body_ty1 lazy_fv
-        -- Add  cardinality demands 
+        -- Add unleashed cardinality demands 
         unleashed_fv               = unleash_card_dmds (id, id_dmd)
         body_ty3                   = addLazyFVs body_ty2 unleashed_fv                      
     in
@@ -730,6 +730,8 @@ is <L,A>).
 -- Unleashing the usage demands on free variables of a binding
 -- basing on the demand from the body
 -- See Note [Aggregated demand for cardinality] 
+
+-- Recursive bindings are automaticaly marked as used
 unleash_card_dmds :: (Var, Demand) -> DmdEnv
 unleash_card_dmds (id, id_dmd)
   | isAbs id_dmd
@@ -737,10 +739,14 @@ unleash_card_dmds (id, id_dmd)
     = emptyDmdEnv
   | otherwise 
     = let StrictSig (DmdType fv _ _) = idStrictness id
-          arity		           = idArity id
+          arity		             = idArity id
           threshold_dmd              = mkThresholdDmd arity 
+          -- we are dealing only with usage, therefore 
+          -- stricntess component in 'fv' should be set to L
+          lazified_fv                = deferEnv fv            
           unleashed_fv               = if id_dmd `pre` threshold_dmd
-                                       then fv else markAsUsedEnv fv
+                                       then lazified_fv
+                                       else markAsUsedEnv lazified_fv
        in unleashed_fv
 
 annotateBndr :: DmdType -> Var -> (DmdType, (Var, Demand))