[commit: ghc] master: Add BuiltinRules for constant-folding not# and notI# (logical complement) (8fd7d58)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/8fd7d581da448d81fc2f9d47366c36c5f57ed564/ghc

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

commit 8fd7d581da448d81fc2f9d47366c36c5f57ed564
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Mar 13 12:15:52 2014 +0000

    Add BuiltinRules for constant-folding not# and notI# (logical complement)
    
    I don't know why these constant-folding rules were implemented for
    and/or/xor but not for 'not'.
    
    Adding them is part of the fix for Trac #8832.
    (The other part is in Data.Bits.)


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

8fd7d581da448d81fc2f9d47366c36c5f57ed564
 compiler/prelude/PrelRules.lhs |    9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 11367ed..7867806 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -111,6 +111,8 @@ primOpRules nm OrIOp       = mkPrimOpRule nm 2 [ binaryLit (intOp2 (.|.))
 primOpRules nm XorIOp      = mkPrimOpRule nm 2 [ binaryLit (intOp2 xor)
                                                , identityDynFlags zeroi
                                                , equalArgs >> retLit zeroi ]
+primOpRules nm NotIOp      = mkPrimOpRule nm 1 [ unaryLit complementOp
+                                               , inversePrimOp NotIOp ]
 primOpRules nm IntNegOp    = mkPrimOpRule nm 1 [ unaryLit negOp
                                                , inversePrimOp IntNegOp ]
 primOpRules nm ISllOp      = mkPrimOpRule nm 2 [ binaryLit (intOp2 Bits.shiftL)
@@ -141,6 +143,8 @@ primOpRules nm OrOp        = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.|.))
 primOpRules nm XorOp       = mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor)
                                                , identityDynFlags zerow
                                                , equalArgs >> retLit zerow ]
+primOpRules nm NotOp       = mkPrimOpRule nm 1 [ unaryLit complementOp
+                                               , inversePrimOp NotOp ]
 primOpRules nm SllOp       = mkPrimOpRule nm 2 [ wordShiftRule Bits.shiftL ]
 primOpRules nm SrlOp       = mkPrimOpRule nm 2 [ wordShiftRule shiftRightLogical ]
 
@@ -345,6 +349,11 @@ negOp dflags (MachDouble d)   = Just (mkDoubleVal dflags (-d))
 negOp dflags (MachInt i)      = intResult dflags (-i)
 negOp _      _                = Nothing
 
+complementOp :: DynFlags -> Literal -> Maybe CoreExpr  -- Binary complement
+complementOp dflags (MachWord i) = wordResult dflags (complement i)
+complementOp dflags (MachInt i)  = intResult  dflags (complement i)
+complementOp _      _            = Nothing
+
 --------------------------
 intOp2 :: (Integral a, Integral b)
        => (a -> b -> Integer)