Commit 57372a7c authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

PrelRules: Handle Int left shifts of more than word-size bits

This should result in zero. Failing to realize this caused us to try
to constant-fold via the normal path, resulting in #14272.

Test Plan: Validate with coming tests

Reviewers: austin, simonpj

Subscribers: simonpj, rwbarton, thomie, hvr

GHC Trac Issues: #14272

Differential Revision: https://phabricator.haskell.org/D4025
parent 1d1b991e
......@@ -122,11 +122,11 @@ 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)
primOpRules nm ISllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL)
, rightIdentityDynFlags zeroi ]
primOpRules nm ISraOp = mkPrimOpRule nm 2 [ binaryLit (intOp2 Bits.shiftR)
primOpRules nm ISraOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftR)
, rightIdentityDynFlags zeroi ]
primOpRules nm ISrlOp = mkPrimOpRule nm 2 [ binaryLit (intOp2' shiftRightLogical)
primOpRules nm ISrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical
, rightIdentityDynFlags zeroi ]
-- Word operations
......@@ -157,8 +157,8 @@ primOpRules nm XorOp = mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor)
, equalArgs >> retLit zerow ]
primOpRules nm NotOp = mkPrimOpRule nm 1 [ unaryLit complementOp
, inversePrimOp NotOp ]
primOpRules nm SllOp = mkPrimOpRule nm 2 [ wordShiftRule (const Bits.shiftL) ]
primOpRules nm SrlOp = mkPrimOpRule nm 2 [ wordShiftRule shiftRightLogical ]
primOpRules nm SllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) ]
primOpRules nm SrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical ]
-- coercions
primOpRules nm Word2IntOp = mkPrimOpRule nm 1 [ liftLitDynFlags word2IntLit
......@@ -419,10 +419,10 @@ wordOp2 op dflags (MachWord w1) (MachWord w2)
= wordResult dflags (fromInteger w1 `op` fromInteger w2)
wordOp2 _ _ _ _ = Nothing -- Could find LitLit
wordShiftRule :: (DynFlags -> Integer -> Int -> Integer) -> RuleM CoreExpr
shiftRule :: (DynFlags -> Integer -> Int -> Integer) -> RuleM CoreExpr
-- Shifts take an Int; hence third arg of op is Int
-- See Note [Guarding against silly shifts]
wordShiftRule shift_op
shiftRule shift_op
= do { dflags <- getDynFlags
; [e1, Lit (MachInt shift_len)] <- getArgs
; case e1 of
......@@ -431,10 +431,16 @@ wordShiftRule shift_op
| shift_len < 0 || wordSizeInBits dflags < shift_len
-> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy
("Bad shift length" ++ show shift_len))
-- Do the shift at type Integer, but shift length is Int
Lit (MachInt x)
-> let op = shift_op dflags
in liftMaybe $ intResult dflags (x `op` fromInteger shift_len)
Lit (MachWord x)
-> let op = shift_op dflags
in liftMaybe $ wordResult dflags (x `op` fromInteger shift_len)
-- Do the shift at type Integer, but shift length is Int
_ -> mzero }
wordSizeInBits :: DynFlags -> Integer
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment