diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2021-07-06 17:26:29 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-07-15 23:29:09 -0400 |
| commit | de98a0ce8f184c9653477ee41602f999c7a381e1 (patch) | |
| tree | 0a4ecccb30c949934e1b07e69c66f77f88b6b088 | |
| parent | 9992159318d0f0c3fcf1c1ae060bb15d0b5fc1a8 (diff) | |
| download | haskell-de98a0ce8f184c9653477ee41602f999c7a381e1.tar.gz | |
Additional constant-folding rule for binary AND/OR
Add a constant folding rule allowing the subsumption of an application
if the same argument is applied twice, e.g.
(v .&. 0xFF) .&. 0xFF ~~> v .&. 0xFF
(v .|. 0xFF) .|. 0xFF ~~> v .|. 0xFF
| -rw-r--r-- | compiler/GHC/Core/Opt/ConstantFold.hs | 61 |
1 files changed, 51 insertions, 10 deletions
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index 9917db7584..df3fbf3b73 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -156,10 +156,14 @@ primOpRules nm = \case , equalArgs $> Lit zeroW8 ] Word8AndOp -> mkPrimOpRule nm 2 [ binaryLit (word8Op2 (.&.)) , idempotent - , zeroElem ] + , zeroElem + , sameArgIdempotentCommut Word8AndOp + ] Word8OrOp -> mkPrimOpRule nm 2 [ binaryLit (word8Op2 (.|.)) , idempotent - , identity zeroW8 ] + , identity zeroW8 + , sameArgIdempotentCommut Word8OrOp + ] Word8XorOp -> mkPrimOpRule nm 2 [ binaryLit (word8Op2 xor) , identity zeroW8 , equalArgs $> Lit zeroW8 ] @@ -223,10 +227,14 @@ primOpRules nm = \case , equalArgs $> Lit zeroW16 ] Word16AndOp -> mkPrimOpRule nm 2 [ binaryLit (word16Op2 (.&.)) , idempotent - , zeroElem ] + , zeroElem + , sameArgIdempotentCommut Word16AndOp + ] Word16OrOp -> mkPrimOpRule nm 2 [ binaryLit (word16Op2 (.|.)) , idempotent - , identity zeroW16 ] + , identity zeroW16 + , sameArgIdempotentCommut Word16OrOp + ] Word16XorOp -> mkPrimOpRule nm 2 [ binaryLit (word16Op2 xor) , identity zeroW16 , equalArgs $> Lit zeroW16 ] @@ -290,10 +298,14 @@ primOpRules nm = \case , equalArgs $> Lit zeroW32 ] Word32AndOp -> mkPrimOpRule nm 2 [ binaryLit (word32Op2 (.&.)) , idempotent - , zeroElem ] + , zeroElem + , sameArgIdempotentCommut Word32AndOp + ] Word32OrOp -> mkPrimOpRule nm 2 [ binaryLit (word32Op2 (.|.)) , idempotent - , identity zeroW32 ] + , identity zeroW32 + , sameArgIdempotentCommut Word32OrOp + ] Word32XorOp -> mkPrimOpRule nm 2 [ binaryLit (word32Op2 xor) , identity zeroW32 , equalArgs $> Lit zeroW32 ] @@ -333,10 +345,14 @@ primOpRules nm = \case , equalArgs >> retLit zeroi ] IntAndOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.&.)) , idempotent - , zeroElem ] + , zeroElem + , sameArgIdempotentCommut IntAndOp + ] IntOrOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.|.)) , idempotent - , identityPlatform zeroi ] + , identityPlatform zeroi + , sameArgIdempotentCommut IntOrOp + ] IntXorOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 xor) , identityPlatform zeroi , equalArgs >> retLit zeroi ] @@ -378,10 +394,14 @@ primOpRules nm = \case , equalArgs >> retLit zerow ] WordAndOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.&.)) , idempotent - , zeroElem ] + , zeroElem + , sameArgIdempotentCommut WordAndOp + ] WordOrOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.|.)) , idempotent - , identityPlatform zerow ] + , identityPlatform zerow + , sameArgIdempotentCommut WordOrOp + ] WordXorOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor) , identityPlatform zerow , equalArgs >> retLit zerow ] @@ -1121,6 +1141,27 @@ idempotent = do [e1, e2] <- getArgs guard $ cheapEqExpr e1 e2 return e1 +-- | Match +-- (op (op v e) e) +-- or (op e (op v e)) +-- or (op (op e v) e) +-- or (op e (op e v)) +-- and return the innermost (op v e) or (op e v). +sameArgIdempotentCommut :: PrimOp -> RuleM CoreExpr +sameArgIdempotentCommut op = do + let is_op = \case + BinOpApp v op' e | op == op' -> Just (v,e) + _ -> Nothing + [a,b] <- getArgs + case (a,b) of + (is_op -> Just (e1,e2), e3) + | cheapEqExpr e2 e3 -> return a + | cheapEqExpr e1 e3 -> return a + (e3, is_op -> Just (e1,e2)) + | cheapEqExpr e2 e3 -> return b + | cheapEqExpr e1 e3 -> return b + _ -> mzero + {- Note [Guarding against silly shifts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |