Ticket #7116: 7116.patch

File 7116.patch, 4.8 KB (added by pcapriotti, 7 years ago)
  • compiler/prelude/PrelRules.lhs

    From dcdb4645dde7f4c0a991527995ae5f0422dc2444 Mon Sep 17 00:00:00 2001
    From: Paolo Capriotti <p.capriotti@gmail.com>
    Date: Mon, 10 Sep 2012 16:03:38 +0100
    Subject: [PATCH] Add PrelRule: x * 2 -> x + x.
    
    ---
     compiler/prelude/PrelRules.lhs |   30 +++++++++++++++++++++++++-----
     1 file changed, 25 insertions(+), 5 deletions(-)
    
    diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
    index b5b350b..ed102e2 100644
    a b primOpRules nm IntSubOp = mkPrimOpRule nm 2 [ binaryLit (intOp2 (-)) 
    8585                                               , equalArgs >> return (Lit zeroi) ]
    8686primOpRules nm IntMulOp    = mkPrimOpRule nm 2 [ binaryLit (intOp2 (*))
    8787                                               , zeroElem zeroi
    88                                                , identity onei ]
     88                                               , identity onei
     89                                               , strengthReduction twoi IntAddOp ]
    8990primOpRules nm IntQuotOp   = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (intOp2 quot)
    9091                                               , leftZero zeroi
    9192                                               , rightIdentity onei
    primOpRules nm WordSubOp = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (-)) 
    112113                                               , rightIdentity zerow
    113114                                               , equalArgs >> return (Lit zerow) ]
    114115primOpRules nm WordMulOp   = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (*))
    115                                                , identity onew ]
     116                                               , identity onew
     117                                               , strengthReduction twow WordAddOp ]
    116118primOpRules nm WordQuotOp  = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (wordOp2 quot)
    117119                                               , rightIdentity onew ]
    118120primOpRules nm WordRemOp   = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (wordOp2 rem)
    primOpRules nm FloatAddOp = mkPrimOpRule nm 2 [ binaryLit (floatOp2 (+)) 
    160162primOpRules nm FloatSubOp   = mkPrimOpRule nm 2 [ binaryLit (floatOp2 (-))
    161163                                                , rightIdentity zerof ]
    162164primOpRules nm FloatMulOp   = mkPrimOpRule nm 2 [ binaryLit (floatOp2 (*))
    163                                                 , identity onef ]
     165                                                , identity onef
     166                                                , strengthReduction twof FloatAddOp ]
    164167                         -- zeroElem zerof doesn't hold because of NaN
    165168primOpRules nm FloatDivOp   = mkPrimOpRule nm 2 [ guardFloatDiv >> binaryLit (floatOp2 (/))
    166169                                                , rightIdentity onef ]
    primOpRules nm DoubleAddOp = mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (+)) 
    172175primOpRules nm DoubleSubOp   = mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (-))
    173176                                                 , rightIdentity zerod ]
    174177primOpRules nm DoubleMulOp   = mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (*))
    175                                                  , identity oned ]
     178                                                 , identity oned
     179                                                 , strengthReduction twod DoubleAddOp ]
    176180                          -- zeroElem zerod doesn't hold because of NaN
    177181primOpRules nm DoubleDivOp   = mkPrimOpRule nm 2 [ guardDoubleDiv >> binaryLit (doubleOp2 (/))
    178182                                                 , rightIdentity oned ]
    mkRelOpRule nm cmp extra 
    249253                        else falseVal) ]
    250254
    251255-- common constants
    252 zeroi, onei, zerow, onew, zerof, onef, zerod, oned :: Literal
     256zeroi, onei, twoi, zerow, onew, twow :: Literal
     257zerof, onef, twof, zerod, oned, twod :: Literal
     258
    253259zeroi = mkMachInt 0
    254260onei  = mkMachInt 1
     261twoi  = mkMachInt 2
    255262zerow = mkMachWord 0
    256263onew  = mkMachWord 1
     264twow  = mkMachWord 2
    257265zerof = mkMachFloat 0.0
    258266onef  = mkMachFloat 1.0
     267twof  = mkMachFloat 2.0
    259268zerod = mkMachDouble 0.0
    260269oned  = mkMachDouble 1.0
     270twod  = mkMachDouble 2.0
    261271
    262272cmpOp :: (forall a . Ord a => a -> a -> Bool)
    263273      -> Literal -> Literal -> Maybe CoreExpr
    rightIdentity id_lit = do 
    512522identity :: Literal -> RuleM CoreExpr
    513523identity lit = leftIdentity lit `mplus` rightIdentity lit
    514524
     525strengthReduction :: Literal -> PrimOp -> RuleM CoreExpr
     526strengthReduction lit op = do
     527  arg <- msum [ do [arg, Lit mult] <- getArgs
     528                   guard (mult == lit)
     529                   return arg
     530              , do [Lit mult, arg] <- getArgs
     531                   guard (mult == lit)
     532                   return arg ]
     533  return $ Var (mkPrimOpId op) `App` arg `App` arg
     534
    515535leftZero :: Literal -> RuleM CoreExpr
    516536leftZero zero = do
    517537  [Lit l1, _] <- getArgs