[commit: ghc] wip/T9136: Also perform reassociation for Word (cc2e4e2)

[git at git.haskell.org]

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

On branch  : wip/T9136
Link       : http://ghc.haskell.org/trac/ghc/changeset/cc2e4e2db6eba4d05317ad71b2c691826ad435c5/ghc

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

commit cc2e4e2db6eba4d05317ad71b2c691826ad435c5
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri May 23 18:25:53 2014 +0200

    Also perform reassociation for Word


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

cc2e4e2db6eba4d05317ad71b2c691826ad435c5
 compiler/prelude/PrelRules.lhs                    | 11 ++++++++---
 testsuite/tests/simplCore/should_compile/T9136.hs | 14 ++++++++++++++
 2 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 77e5671..8a0569a 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -130,9 +130,14 @@ primOpRules nm ISrlOp      = mkPrimOpRule nm 2 [ binaryLit (intOp2 shiftRightLog
 
 -- Word operations
 primOpRules nm WordAddOp   = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (+))
-                                               , identityDynFlags zerow ]
+                                               , identityDynFlags zerow
+                                               , assocBinaryLit WordAddOp (wordOp2 (+))
+                                               , litsToRight WordAddOp
+                                               , treesToLeft WordAddOp
+                                               , litsGoUp WordAddOp ]
 primOpRules nm WordSubOp   = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (-))
                                                , rightIdentityDynFlags zerow
+                                               , minusToPlus WordSubOp
                                                , equalArgs >> retLit zerow ]
 primOpRules nm WordMulOp   = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (*))
                                                , identityDynFlags onew ]
@@ -841,8 +846,8 @@ strengthReduction two_lit add_op = do -- Note [Strength reduction]
 -- = ((x + y) + 2) + 3 -- using litsGoUp
 -- = (x + y) + 5       -- using assocBinaryLit
 --
--- An expression like "x -# 2" is turned into "x +# (-2)" (minusToPlus) and
--- then also takes part in this scheme.
+-- For Ints, an expression like "x -# 2" is turned into "x +# (-2)"
+-- (minusToPlus) and then also takes part in this scheme.
 
 -- Note [What's true and false]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/testsuite/tests/simplCore/should_compile/T9136.hs b/testsuite/tests/simplCore/should_compile/T9136.hs
index 4b6aed7..37ad1ae 100644
--- a/testsuite/tests/simplCore/should_compile/T9136.hs
+++ b/testsuite/tests/simplCore/should_compile/T9136.hs
@@ -1,5 +1,7 @@
 module T9136 where
 
+import Data.Word
+
 -- In all these example, no 8 should be found in the final code
 foo1 :: Int -> Int
 foo1 x = (x + 8) - 1
@@ -12,3 +14,15 @@ foo3 x y = ((8 + x) + y) - 2
 
 foo4 :: Int -> Int -> Int
 foo4 x y = (8 + x) + (y - 3)
+
+word1 :: Word -> Word
+word1 x = (x + 8) + 1
+
+word2 :: Word -> Word
+word2 x = (8 + x) + 2
+
+word3 :: Word -> Word -> Word
+word3 x y = ((8 + x) + y) + 2
+
+word4 :: Word -> Word -> Word
+word4 x y = (8 + x) + (y + 3)