Iteratively try to fold expressions before constant propagation

Before this change the constant expression

   _ccI::I64 = (16 >> 7) + 1;

wouldn't be propagated, as it wouldn't be completely folded.  This
meant that this expression wouldn't be unrolled

    thawArray# arr# 0# 16# s#

The new code generator already does this correctly.

1 files changed, 5 insertions, 2 deletions

diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index dab866e186..28f21e21f3 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -24,6 +24,7 @@ module CmmOpt (
 #include "HsVersions.h"
 
 import OldCmm
+import CmmNode (wrapRecExp)
 import CmmUtils
 import CLabel
 import StaticFlags
@@ -180,8 +181,7 @@ cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts
 
         -- used (foldable to literal): try to inline at all the use sites
   | Just n <- lookupUFM uses u,
-    CmmMachOp op es <- expr,
-    e@(CmmLit _) <- cmmMachOpFold op es
+    e@(CmmLit _) <- wrapRecExp foldExp expr
   =
 #ifdef NCG_DEBUG
      trace ("nativeGen: inlining " ++ showSDoc (pprStmt stmt)) $
@@ -200,6 +200,9 @@ cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts
      trace ("nativeGen: inlining " ++ showSDoc (pprStmt stmt)) $
 #endif
      cmmMiniInlineStmts uses stmts'
+ where
+  foldExp (CmmMachOp op args) = cmmMachOpFold op args
+  foldExp e = e
 
 cmmMiniInlineStmts uses (stmt:stmts)
   = stmt : cmmMiniInlineStmts uses stmts