[commit: ghc] wip/12368: dmdFix abortion: Get lazy_fv from set of free variables (a1acc1f)

[git at git.haskell.org]

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

On branch  : wip/12368
Link       : http://ghc.haskell.org/trac/ghc/changeset/a1acc1f4b23ef96f869acec284348bf8588c9546/ghc

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

commit a1acc1f4b23ef96f869acec284348bf8588c9546
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Jul 26 16:05:42 2016 +0200

    dmdFix abortion: Get lazy_fv from set of free variables
    
    hopefully more reliable.


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

a1acc1f4b23ef96f869acec284348bf8588c9546
 compiler/stranal/DmdAnal.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs
index 22e1faa..fb0b4c5 100644
--- a/compiler/stranal/DmdAnal.hs
+++ b/compiler/stranal/DmdAnal.hs
@@ -24,6 +24,7 @@ import Data.List
 import DataCon
 import Id
 import CoreUtils        ( exprIsHNF, exprType, exprIsTrivial )
+import CoreFVs
 import TyCon
 import Type
 import Coercion         ( Coercion, coVarsOfCo )
@@ -495,11 +496,12 @@ dmdFix top_lvl env orig_pairs
     -- If fixed-point iteration does not yield a result we use this instead
     -- See Note [Safe abortion in the fixed-point iteration]
     abort :: (AnalEnv, DmdEnv, [(Id,CoreExpr)])
-    abort = (env, lazy_fv', zapped_pairs)
-      where (lazy_fv, pairs') = step True (zapIdStrictness orig_pairs)
+    abort = (env, lazy_fv, zapped_pairs)
+      where (_, pairs')  = step True (zapIdStrictness orig_pairs)
             -- Note [Lazy and unleasheable free variables]
-            non_lazy_fvs = plusVarEnvList $ map (strictSigDmdEnv . idStrictness . fst) pairs'
-            lazy_fv'     = lazy_fv `plusVarEnv` mapVarEnv (const topDmd) non_lazy_fvs
+            lazy_fv      = mkVarEnv [ (v, topDmd)
+                                    | (_,rhs) <- orig_pairs
+                                    , v <- exprFreeIdsList rhs ]
             zapped_pairs = zapIdStrictness pairs'
 
     -- The fixed-point varies the idStrictness field of the binders, and terminates if that