diff options
| author | John Ericson <John.Ericson@Obsidian.Systems> | 2021-01-11 10:45:16 -0500 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-01-22 15:01:25 -0500 |
| commit | faf164db1e03d52d44167bd3d24420dd17fe0f48 (patch) | |
| tree | c2a6d3960e3a5e4bd3465cb41e2ed208e3e4e0e7 /compiler/GHC/Core | |
| parent | 22d01924b1c09c4bf3e9b602a2c6efbc46ca070f (diff) | |
| download | haskell-faf164db1e03d52d44167bd3d24420dd17fe0f48.tar.gz | |
Cleanup primop constant folding rules in a few ways
- `leftZero`, `rightZero` and `zeroElem` could all be written using `isZeroLit`
- "modulo 1" rules could be written with `nonOneLit 1 $> Lit zero<type>`
All are due to @hsyl20; thanks!
Diffstat (limited to 'compiler/GHC/Core')
| -rw-r--r-- | compiler/GHC/Core/Opt/ConstantFold.hs | 48 |
1 files changed, 21 insertions, 27 deletions
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index d6d8ee906a..35491f4d0c 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -124,25 +124,21 @@ primOpRules nm = \case , rightIdentityCPlatform zeroi , equalArgs >> retLitNoC zeroi ] IntMulOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (*)) - , zeroElem zeroi + , zeroElem , identityPlatform onei , mulFoldingRules IntMulOp intOps ] IntQuotOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (intOp2 quot) - , leftZero zeroi + , leftZero , rightIdentityPlatform onei , equalArgs >> retLit onei ] IntRemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (intOp2 rem) - , leftZero zeroi - , do l <- getLiteral 1 - platform <- getPlatform - guard (l == onei platform) - retLit zeroi - , equalArgs >> retLit zeroi + , leftZero + , oneLit 1 >> retLit zeroi , equalArgs >> retLit zeroi ] IntAndOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.&.)) , idempotent - , zeroElem zeroi ] + , zeroElem ] IntOrOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.|.)) , idempotent , identityPlatform zeroi ] @@ -182,15 +178,12 @@ primOpRules nm = \case WordQuotOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (wordOp2 quot) , rightIdentityPlatform onew ] WordRemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (wordOp2 rem) - , leftZero zerow - , do l <- getLiteral 1 - platform <- getPlatform - guard (l == onew platform) - retLit zerow + , leftZero + , oneLit 1 >> retLit zerow , equalArgs >> retLit zerow ] WordAndOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.&.)) , idempotent - , zeroElem zerow ] + , zeroElem ] WordOrOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.|.)) , idempotent , identityPlatform zerow ] @@ -995,22 +988,20 @@ identityCPlatform :: (Platform -> Literal) -> RuleM CoreExpr identityCPlatform lit = leftIdentityCPlatform lit `mplus` rightIdentityCPlatform lit -leftZero :: (Platform -> Literal) -> RuleM CoreExpr -leftZero zero = do - platform <- getPlatform +leftZero :: RuleM CoreExpr +leftZero = do [Lit l1, _] <- getArgs - guard $ l1 == zero platform + guard $ isZeroLit l1 return $ Lit l1 -rightZero :: (Platform -> Literal) -> RuleM CoreExpr -rightZero zero = do - platform <- getPlatform +rightZero :: RuleM CoreExpr +rightZero = do [_, Lit l2] <- getArgs - guard $ l2 == zero platform + guard $ isZeroLit l2 return $ Lit l2 -zeroElem :: (Platform -> Literal) -> RuleM CoreExpr -zeroElem lit = leftZero lit `mplus` rightZero lit +zeroElem :: RuleM CoreExpr +zeroElem = leftZero `mplus` rightZero equalArgs :: RuleM () equalArgs = do @@ -1020,6 +1011,9 @@ equalArgs = do nonZeroLit :: Int -> RuleM () nonZeroLit n = getLiteral n >>= guard . not . isZeroLit +oneLit :: Int -> RuleM () +oneLit n = getLiteral n >>= guard . isOneLit + -- When excess precision is not requested, cut down the precision of the -- Rational value to that of Float/Double. We confuse host architecture -- and target architecture here, but it's convenient (and wrong :-). @@ -1348,7 +1342,7 @@ builtinRules enableBignumRules mkBasicRule divIntName 2 $ msum [ nonZeroLit 1 >> binaryLit (intOp2 div) - , leftZero zeroi + , leftZero , do [arg, Lit (LitNumber LitNumInt d)] <- getArgs Just n <- return $ exactLog2 d @@ -1358,7 +1352,7 @@ builtinRules enableBignumRules mkBasicRule modIntName 2 $ msum [ nonZeroLit 1 >> binaryLit (intOp2 mod) - , leftZero zeroi + , leftZero , do [arg, Lit (LitNumber LitNumInt d)] <- getArgs Just _ <- return $ exactLog2 d |