Enhanced constant folding

Until now GHC only supported basic constant folding (lit op lit, expr op
0, etc.).

This patch uses laws of +/-/* (associativity, commutativity,
distributivity) to support some constant folding into nested
expressions.

Examples of new transformations:

   - simple nesting: (10 + x) + 10 becomes 20 + x
   - deep nesting: 5 + x + (y + (z + (t + 5))) becomes 10 + (x + (y + (z + t)))
   - distribution: (5 + x) * 6 becomes 30 + 6*x
   - simple factorization: 5 + x + (x + (x + (x + 5))) becomes 10 + (4 *x)
   - siblings: (5 + 4*x) - (3*x + 2) becomes 3 + x

Test Plan: validate

Reviewers: simonpj, austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

GHC Trac Issues: #9136

Differential Revision: https://phabricator.haskell.org/D2858

(cherry picked from commit fea04defa64871caab6339ff3fc5511a272f37c7)

1 files changed, 10 insertions, 28 deletions

diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
index 9d4869df3f..78ba2b4c2d 100644
--- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr
+++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
@@ -1,7 +1,7 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 172, types: 62, coercions: 0, joins: 0/2}
+  = {terms: 150, types: 60, coercions: 0, joins: 0/0}
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 Roman.$trModule4 :: GHC.Prim.Addr#
@@ -59,29 +59,20 @@ Roman.foo3
   = Control.Exception.Base.patError @ 'GHC.Types.LiftedRep @ Int lvl
 
 Rec {
--- RHS size: {terms: 52, types: 6, coercions: 0, joins: 0/1}
+-- RHS size: {terms: 40, types: 5, coercions: 0, joins: 0/0}
 Roman.foo_$s$wgo [Occ=LoopBreaker]
   :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int#
-[GblId, Arity=2, Caf=NoCafRefs, Str=<S,U><S,U>, Unf=OtherCon []]
+[GblId, Arity=2, Caf=NoCafRefs, Str=<L,U><S,U>, Unf=OtherCon []]
 Roman.foo_$s$wgo
   = \ (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#) ->
-      let {
-        m :: GHC.Prim.Int#
-        [LclId]
-        m = GHC.Prim.+#
-              (GHC.Prim.+#
-                 (GHC.Prim.+#
-                    (GHC.Prim.+# (GHC.Prim.+# (GHC.Prim.+# sc sc) sc) sc) sc)
-                 sc)
-              sc } in
       case GHC.Prim.<=# sc1 0# of {
         __DEFAULT ->
           case GHC.Prim.<# sc1 100# of {
             __DEFAULT ->
               case GHC.Prim.<# sc1 500# of {
                 __DEFAULT ->
-                  Roman.foo_$s$wgo (GHC.Prim.+# m m) (GHC.Prim.-# sc1 1#);
-                1# -> Roman.foo_$s$wgo m (GHC.Prim.-# sc1 3#)
+                  Roman.foo_$s$wgo (GHC.Prim.*# 14# sc) (GHC.Prim.-# sc1 1#);
+                1# -> Roman.foo_$s$wgo (GHC.Prim.*# 7# sc) (GHC.Prim.-# sc1 3#)
               };
             1# -> Roman.foo_$s$wgo sc (GHC.Prim.-# sc1 2#)
           };
@@ -89,31 +80,22 @@ Roman.foo_$s$wgo
       }
 end Rec }
 
--- RHS size: {terms: 71, types: 19, coercions: 0, joins: 0/1}
+-- RHS size: {terms: 61, types: 18, coercions: 0, joins: 0/0}
 Roman.$wgo [InlPrag=NOUSERINLINE[2]]
   :: Maybe Int -> Maybe Int -> GHC.Prim.Int#
 [GblId,
  Arity=2,
  Str=<S,1*U><S,1*U>,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 30] 253 0}]
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [61 30] 249 0}]
 Roman.$wgo
   = \ (w :: Maybe Int) (w1 :: Maybe Int) ->
       case w1 of {
         Nothing -> case Roman.foo3 of wild1 { };
         Just x ->
           case x of { GHC.Types.I# ipv ->
-          let {
-            m :: GHC.Prim.Int#
-            [LclId]
-            m = GHC.Prim.+#
-                  (GHC.Prim.+#
-                     (GHC.Prim.+#
-                        (GHC.Prim.+# (GHC.Prim.+# (GHC.Prim.+# ipv ipv) ipv) ipv) ipv)
-                     ipv)
-                  ipv } in
           case w of {
-            Nothing -> Roman.foo_$s$wgo m 10#;
+            Nothing -> Roman.foo_$s$wgo (GHC.Prim.*# 7# ipv) 10#;
             Just n ->
               case n of { GHC.Types.I# x2 ->
               case GHC.Prim.<=# x2 0# of {
@@ -122,8 +104,8 @@ Roman.$wgo
                     __DEFAULT ->
                       case GHC.Prim.<# x2 500# of {
                         __DEFAULT ->
-                          Roman.foo_$s$wgo (GHC.Prim.+# m m) (GHC.Prim.-# x2 1#);
-                        1# -> Roman.foo_$s$wgo m (GHC.Prim.-# x2 3#)
+                          Roman.foo_$s$wgo (GHC.Prim.*# 14# ipv) (GHC.Prim.-# x2 1#);
+                        1# -> Roman.foo_$s$wgo (GHC.Prim.*# 7# ipv) (GHC.Prim.-# x2 3#)
                       };
                     1# -> Roman.foo_$s$wgo ipv (GHC.Prim.-# x2 2#)
                   };