[commit: ghc] wip/12368: dmdFix: Ensure that top-level binds are processes at least twice (b0b2f56)

[git at git.haskell.org]

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

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

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

commit b0b2f56e7e29024afeaa6e633c0de208fc6552c2
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Sat Jul 30 05:46:06 2016 -0400

    dmdFix: Ensure that top-level binds are processes at least twice
    
    even if we abort the iteration.
    
    I’m not sure if this is the final code I want to submit, but I’m pushing
    this onto a branch to see if it validates.


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

b0b2f56e7e29024afeaa6e633c0de208fc6552c2
 compiler/stranal/DmdAnal.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs
index 22e1faa..9bdc233 100644
--- a/compiler/stranal/DmdAnal.hs
+++ b/compiler/stranal/DmdAnal.hs
@@ -496,12 +496,20 @@ dmdFix top_lvl env orig_pairs
     -- 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)
+      where (lazy_fv, pairs') = abortingStep 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
             zapped_pairs = zapIdStrictness pairs'
 
+    -- We always need two passes over everything. If this is top-level, then
+    -- dmdFix is required to do at least two passes.
+    abortingStep :: [(Id, CoreExpr)] -> (DmdEnv, [(Id, CoreExpr)])
+    abortingStep pairs0 | isTopLevel top_lvl =
+        let (_, pairs1) = step True  (zapIdStrictness pairs0)
+        in                step False (zapIdStrictness pairs1)
+    abortingStep pairs0 = step True  (zapIdStrictness pairs0)
+
     -- The fixed-point varies the idStrictness field of the binders, and terminates if that
     -- annotation does not change any more.
     loop :: Int -> [(Id,CoreExpr)] -> (AnalEnv, DmdEnv, [(Id,CoreExpr)])