[commit: ghc] cardinality: Unsafe version of the analysis is retored. (78fae51)

Ilya Sergey ilya.sergey at cs.kuleuven.be
Fri Jan 18 19:28:13 CET 2013


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

On branch  : cardinality

http://hackage.haskell.org/trac/ghc/changeset/78fae512a368371b9a4faf90b50abe6f1da59fff

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

commit 78fae512a368371b9a4faf90b50abe6f1da59fff
Author: Ilya Sergey <ilya.sergey at gmail.com>
Date:   Fri Jan 18 22:27:07 2013 +0400

    Unsafe version of the analysis is retored.

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

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

diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index b7f2c9c..1d20ce2 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -322,7 +322,9 @@ dmdAnal dflags _ env dmd (Let (NonRec id rhs) body)
 	body_ty2		   = addLazyFVs body_ty1 lazy_fv
         -- Add unleashed cardinality demands 
         unleashed_fv               = unleashCardDmds_single (id2, id_dmd)
-        body_ty3                   = addNewFVs body_ty2 unleashed_fv
+        body_ty3                   = -- pprTrace "dmdAnal:unleashed" 
+                                     --    (ppr id2 <+> ppr unleashed_fv) $
+                                     addNewFVs body_ty2 unleashed_fv
         
         -- Annotate top-level lambdas at RHS basing on the aggregated demand info
         -- See Note [Annotatig lambdas at right-hand side] 
@@ -434,13 +436,13 @@ unleashCardDmds_single (id, id_dmd)
 -- unleashCardFix :: DmdEnv -> DmdEnv
 -- unleashCardFix env
 --   = let 
---         pairs = varEnvElts env
+--         pairs = keyValuePairs env
 --         env'  = env `bothDmdEnv` unleashCardDmds_many pairs
 --      in if found_fixpoint env env'
 --         then env'
 --         else unleashCardFix env'
 --     where 
---         found_fixpoint e1 e2 = all (same_in_env e1 e2) (map snd $ varEnvElts e2)   
+--         found_fixpoint e1 e2 = all (same_in_env e1 e2) (map snd $ keyValuePairs e2)   
 --         same_in_env e1 e2 id = lookupVarEnv_NF e1 id == lookupVarEnv_NF e2 id
 
 -- unleashCardDmds_many :: [(Var, Demand)] -> DmdEnv





More information about the ghc-commits mailing list