DmdAnal: Lazier infinite loopswip/lazier-loops

1 files changed, 9 insertions, 1 deletions

diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs
index bf1870c3ea..e59c8cc5a8 100644
--- a/compiler/GHC/Core/Opt/DmdAnal.hs
+++ b/compiler/GHC/Core/Opt/DmdAnal.hs
@@ -1890,18 +1890,26 @@ dmdFix top_lvl env let_dmd orig_pairs
         final_anal_env    = extendAnalEnvs top_lvl env (map fst pairs')
 
     step :: Bool -> [(Id, CoreExpr)] -> (DmdEnv, [(Id, CoreExpr)])
-    step first_round pairs = (lazy_fv, pairs')
+    step first_round pairs = (lazy_fv, pairs'')
       where
         -- In all but the first iteration, delete the virgin flag
         start_env | first_round = env
                   | otherwise   = nonVirgin env
 
+        bot_to_exn_div p@(id,rhs) | DmdSig ty <- idDmdSig id
+                                  , dt_div ty == botDiv
+                                  = (id `setIdDmdSig` DmdSig ty{dt_div=exnDiv},rhs)
+                                  | otherwise
+                                  = p
+
         start = (extendAnalEnvs top_lvl start_env (map fst pairs), emptyVarEnv)
 
         !((_,!lazy_fv), !pairs') = mapAccumL my_downRhs start pairs
                 -- mapAccumL: Use the new signature to do the next pair
                 -- The occurrence analyser has arranged them in a good order
                 -- so this can significantly reduce the number of iterations needed
+        !pairs'' | first_round = map bot_to_exn_div pairs' -- Note TODO
+                 | otherwise   = pairs'
 
         my_downRhs (env, lazy_fv) (id,rhs)
           = -- pprTrace "my_downRhs" (ppr id $$ ppr (idDmdSig id) $$ ppr sig) $