[commit: ghc] master: Add strength reduction rules (Fixes #7116) (838e2fd)

[Jan Stolarek]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/838e2fda9892e61da85187803cce45b3f815b86e

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

commit 838e2fda9892e61da85187803cce45b3f815b86e
Author: Jan Stolarek <jan.stolarek at p.lodz.pl>
Date:   Mon Jul 8 16:20:43 2013 +0100

    Add strength reduction rules (Fixes #7116)
    
    This patch adds rules for converting floating point multiplication
    of the form 2.0 * x and x * 2.0 into addition x + x.

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

 compiler/prelude/PrelRules.lhs |   27 ++++++++++++++++++++++++---
 1 file changed, 24 insertions(+), 3 deletions(-)

diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index e9d0f6b..b569840 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -197,7 +197,8 @@ primOpRules nm FloatAddOp   = mkPrimOpRule nm 2 [ binaryLit (floatOp2 (+))
 primOpRules nm FloatSubOp   = mkPrimOpRule nm 2 [ binaryLit (floatOp2 (-))
                                                 , rightIdentity zerof ]
 primOpRules nm FloatMulOp   = mkPrimOpRule nm 2 [ binaryLit (floatOp2 (*))
-                                                , identity onef ]
+                                                , identity onef
+                                                , strengthReduction twof FloatAddOp  ]
                          -- zeroElem zerof doesn't hold because of NaN
 primOpRules nm FloatDivOp   = mkPrimOpRule nm 2 [ guardFloatDiv >> binaryLit (floatOp2 (/))
                                                 , rightIdentity onef ]
@@ -210,7 +211,8 @@ primOpRules nm DoubleAddOp   = mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (+))
 primOpRules nm DoubleSubOp   = mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (-))
                                                  , rightIdentity zerod ]
 primOpRules nm DoubleMulOp   = mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (*))
-                                                 , identity oned ]
+                                                 , identity oned
+                                                 , strengthReduction twod DoubleAddOp  ]
                           -- zeroElem zerod doesn't hold because of NaN
 primOpRules nm DoubleDivOp   = mkPrimOpRule nm 2 [ guardDoubleDiv >> binaryLit (doubleOp2 (/))
                                                  , rightIdentity oned ]
@@ -296,11 +298,13 @@ onei  dflags = mkMachInt  dflags 1
 zerow dflags = mkMachWord dflags 0
 onew  dflags = mkMachWord dflags 1
 
-zerof, onef, zerod, oned :: Literal
+zerof, onef, twof, zerod, oned, twod :: Literal
 zerof = mkMachFloat 0.0
 onef  = mkMachFloat 1.0
+twof  = mkMachFloat 2.0
 zerod = mkMachDouble 0.0
 oned  = mkMachDouble 1.0
+twod  = mkMachDouble 2.0
 
 cmpOp :: (forall a . Ord a => a -> a -> Bool)
       -> Literal -> Literal -> Maybe CoreExpr
@@ -658,6 +662,23 @@ guardDoubleDiv = do
 -- is representable in Float/Double but not in (normalised)
 -- Rational. (#3676) Perhaps we should generate (0 :% (-1)) instead?
 
+strengthReduction :: Literal -> PrimOp -> RuleM CoreExpr
+strengthReduction two_lit add_op = do -- Note [Strength reduction]
+  arg <- msum [ do [arg, Lit mult_lit] <- getArgs
+                   guard (mult_lit == two_lit)
+                   return arg
+              , do [Lit mult_lit, arg] <- getArgs
+                   guard (mult_lit == two_lit)
+                   return arg ]
+  return $ Var (mkPrimOpId add_op) `App` arg `App` arg
+
+{- Note [Strength reduction]
+
+This rule turns multiplications of the form 2 * x and x * 2 into x + x addition
+because addition costs less than multiplication. See #7116
+
+-}
+
 trueVal, falseVal :: Expr CoreBndr
 trueVal       = Var trueDataConId
 falseVal      = Var falseDataConId