diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2019-12-02 08:57:52 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-12-03 07:12:13 -0500 |
| commit | 7a51b587ad6a154f89542641593c2b5b2c3f3dde (patch) | |
| tree | c97b2c288eaf8fa4b79bd5ad13c645a7f0cbba27 /compiler/prelude | |
| parent | 35afe4f3b1591740ab8454ebe4c0ec206d2b7e14 (diff) | |
| download | haskell-7a51b587ad6a154f89542641593c2b5b2c3f3dde.tar.gz | |
Add constant folding rule (#16402)
narrowN (x .&. m)
m .&. (2^N-1) = 2^N-1
==> narrowN x
e.g. narrow16 (x .&. 0x12FFFF) ==> narrow16 x
Diffstat (limited to 'compiler/prelude')
| -rw-r--r-- | compiler/prelude/PrelRules.hs | 38 |
1 files changed, 32 insertions, 6 deletions
diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index bdcbecfe59..c6c27f8ffe 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -191,29 +191,35 @@ primOpRules nm Int2WordOp = mkPrimOpRule nm 1 [ liftLitDynFlags int2WordLit primOpRules nm Narrow8IntOp = mkPrimOpRule nm 1 [ liftLit narrow8IntLit , subsumedByPrimOp Narrow8IntOp , Narrow8IntOp `subsumesPrimOp` Narrow16IntOp - , Narrow8IntOp `subsumesPrimOp` Narrow32IntOp ] + , Narrow8IntOp `subsumesPrimOp` Narrow32IntOp + , narrowSubsumesAnd AndIOp Narrow8IntOp 8 ] primOpRules nm Narrow16IntOp = mkPrimOpRule nm 1 [ liftLit narrow16IntLit , subsumedByPrimOp Narrow8IntOp , subsumedByPrimOp Narrow16IntOp - , Narrow16IntOp `subsumesPrimOp` Narrow32IntOp ] + , Narrow16IntOp `subsumesPrimOp` Narrow32IntOp + , narrowSubsumesAnd AndIOp Narrow16IntOp 16 ] primOpRules nm Narrow32IntOp = mkPrimOpRule nm 1 [ liftLit narrow32IntLit , subsumedByPrimOp Narrow8IntOp , subsumedByPrimOp Narrow16IntOp , subsumedByPrimOp Narrow32IntOp - , removeOp32 ] + , removeOp32 + , narrowSubsumesAnd AndIOp Narrow32IntOp 32 ] primOpRules nm Narrow8WordOp = mkPrimOpRule nm 1 [ liftLit narrow8WordLit , subsumedByPrimOp Narrow8WordOp , Narrow8WordOp `subsumesPrimOp` Narrow16WordOp - , Narrow8WordOp `subsumesPrimOp` Narrow32WordOp ] + , Narrow8WordOp `subsumesPrimOp` Narrow32WordOp + , narrowSubsumesAnd AndOp Narrow8WordOp 8 ] primOpRules nm Narrow16WordOp = mkPrimOpRule nm 1 [ liftLit narrow16WordLit , subsumedByPrimOp Narrow8WordOp , subsumedByPrimOp Narrow16WordOp - , Narrow16WordOp `subsumesPrimOp` Narrow32WordOp ] + , Narrow16WordOp `subsumesPrimOp` Narrow32WordOp + , narrowSubsumesAnd AndOp Narrow16WordOp 16 ] primOpRules nm Narrow32WordOp = mkPrimOpRule nm 1 [ liftLit narrow32WordLit , subsumedByPrimOp Narrow8WordOp , subsumedByPrimOp Narrow16WordOp , subsumedByPrimOp Narrow32WordOp - , removeOp32 ] + , removeOp32 + , narrowSubsumesAnd AndOp Narrow32WordOp 32 ] primOpRules nm OrdOp = mkPrimOpRule nm 1 [ liftLit char2IntLit , inversePrimOp ChrOp ] primOpRules nm ChrOp = mkPrimOpRule nm 1 [ do [Lit lit] <- getArgs @@ -649,6 +655,26 @@ subsumedByPrimOp primop = do matchPrimOpId primop primop_id return e +-- | narrow subsumes bitwise `and` with full mask (cf #16402): +-- +-- narrowN (x .&. m) +-- m .&. (2^N-1) = 2^N-1 +-- ==> narrowN x +-- +-- e.g. narrow16 (x .&. 0xFFFF) +-- ==> narrow16 x +-- +narrowSubsumesAnd :: PrimOp -> PrimOp -> Int -> RuleM CoreExpr +narrowSubsumesAnd and_primop narrw n = do + [Var primop_id `App` x `App` y] <- getArgs + matchPrimOpId and_primop primop_id + let mask = bit n -1 + g v (Lit (LitNumber _ m _)) = do + guard (m .&. mask == mask) + return (Var (mkPrimOpId narrw) `App` v) + g _ _ = mzero + g x y <|> g y x + idempotent :: RuleM CoreExpr idempotent = do [e1, e2] <- getArgs guard $ cheapEqExpr e1 e2 |