Commit 5341edf3 authored by Alec Theriault's avatar Alec Theriault Committed by Ben Gamari

Error out of invalid Int/Word bit shifts

Although the Haddock's for `shiftL` and `shiftR` do require the number
of bits to be non-negative, we should still check this before calling
out to primitives (which also have undefined behaviour for negative bit
shifts).

If a user _really_ wants to bypass checks that the number of bits is
sensible, they already have the aptly-named `unsafeShiftL`/`unsafeShiftR`
at their disposal.

See #16111.
parent a90a2aea
......@@ -474,12 +474,11 @@ shiftRule shift_op
; case e1 of
_ | shift_len == 0
-> return e1
| 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 (LitNumber nt x t)
| 0 < shift_len
, shift_len <= wordSizeInBits dflags
-> let op = shift_op dflags
y = x `op` fromInteger shift_len
in liftMaybe $ Just (Lit (mkLitNumberWrap dflags nt y t))
......
......@@ -205,7 +205,8 @@ class Eq a => Bits a where
x `complementBit` i = x `xor` bit i
{-| Shift the argument left by the specified number of bits
(which must be non-negative).
(which must be non-negative). Some instances may throw an
'Control.Exception.Overflow' exception if given a negative input.
An instance can define either this and 'shiftR' or the unified
'shift', depending on which is more convenient for the type in
......@@ -227,7 +228,8 @@ class Eq a => Bits a where
{-| Shift the first argument right by the specified number of bits. The
result is undefined for negative shift amounts and shift amounts
greater or equal to the 'bitSize'.
greater or equal to the 'bitSize'. Some instances may throw an
'Control.Exception.Overflow' exception if given a negative input.
Right shifts perform sign extension on signed number types;
i.e. they fill the top bits with 1 if the @x@ is negative
......@@ -450,9 +452,13 @@ instance Bits Int where
(I# x#) `shift` (I# i#)
| isTrue# (i# >=# 0#) = I# (x# `iShiftL#` i#)
| otherwise = I# (x# `iShiftRA#` negateInt# i#)
(I# x#) `shiftL` (I# i#) = I# (x# `iShiftL#` i#)
(I# x#) `shiftL` (I# i#)
| isTrue# (i# >=# 0#) = I# (x# `iShiftL#` i#)
| otherwise = overflowError
(I# x#) `unsafeShiftL` (I# i#) = I# (x# `uncheckedIShiftL#` i#)
(I# x#) `shiftR` (I# i#) = I# (x# `iShiftRA#` i#)
(I# x#) `shiftR` (I# i#)
| isTrue# (i# >=# 0#) = I# (x# `iShiftRA#` i#)
| otherwise = overflowError
(I# x#) `unsafeShiftR` (I# i#) = I# (x# `uncheckedIShiftRA#` i#)
{-# INLINE rotate #-} -- See Note [Constant folding for rotate]
......@@ -488,9 +494,13 @@ instance Bits Word where
(W# x#) `shift` (I# i#)
| isTrue# (i# >=# 0#) = W# (x# `shiftL#` i#)
| otherwise = W# (x# `shiftRL#` negateInt# i#)
(W# x#) `shiftL` (I# i#) = W# (x# `shiftL#` i#)
(W# x#) `shiftL` (I# i#)
| isTrue# (i# >=# 0#) = W# (x# `shiftL#` i#)
| otherwise = overflowError
(W# x#) `unsafeShiftL` (I# i#) = W# (x# `uncheckedShiftL#` i#)
(W# x#) `shiftR` (I# i#) = W# (x# `shiftRL#` i#)
(W# x#) `shiftR` (I# i#)
| isTrue# (i# >=# 0#) = W# (x# `shiftRL#` i#)
| otherwise = overflowError
(W# x#) `unsafeShiftR` (I# i#) = W# (x# `uncheckedShiftRL#` i#)
(W# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#) = W# x#
......
......@@ -185,9 +185,13 @@ instance Bits Int8 where
(I8# x#) `shift` (I# i#)
| isTrue# (i# >=# 0#) = I8# (narrow8Int# (x# `iShiftL#` i#))
| otherwise = I8# (x# `iShiftRA#` negateInt# i#)
(I8# x#) `shiftL` (I# i#) = I8# (narrow8Int# (x# `iShiftL#` i#))
(I8# x#) `shiftL` (I# i#)
| isTrue# (i# >=# 0#) = I8# (narrow8Int# (x# `iShiftL#` i#))
| otherwise = overflowError
(I8# x#) `unsafeShiftL` (I# i#) = I8# (narrow8Int# (x# `uncheckedIShiftL#` i#))
(I8# x#) `shiftR` (I# i#) = I8# (x# `iShiftRA#` i#)
(I8# x#) `shiftR` (I# i#)
| isTrue# (i# >=# 0#) = I8# (x# `iShiftRA#` i#)
| otherwise = overflowError
(I8# x#) `unsafeShiftR` (I# i#) = I8# (x# `uncheckedIShiftRA#` i#)
(I8# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#)
......@@ -385,9 +389,13 @@ instance Bits Int16 where
(I16# x#) `shift` (I# i#)
| isTrue# (i# >=# 0#) = I16# (narrow16Int# (x# `iShiftL#` i#))
| otherwise = I16# (x# `iShiftRA#` negateInt# i#)
(I16# x#) `shiftL` (I# i#) = I16# (narrow16Int# (x# `iShiftL#` i#))
(I16# x#) `shiftL` (I# i#)
| isTrue# (i# >=# 0#) = I16# (narrow16Int# (x# `iShiftL#` i#))
| otherwise = overflowError
(I16# x#) `unsafeShiftL` (I# i#) = I16# (narrow16Int# (x# `uncheckedIShiftL#` i#))
(I16# x#) `shiftR` (I# i#) = I16# (x# `iShiftRA#` i#)
(I16# x#) `shiftR` (I# i#)
| isTrue# (i# >=# 0#) = I16# (x# `iShiftRA#` i#)
| otherwise = overflowError
(I16# x#) `unsafeShiftR` (I# i#) = I16# (x# `uncheckedIShiftRA#` i#)
(I16# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#)
......@@ -587,10 +595,14 @@ instance Bits Int32 where
(I32# x#) `shift` (I# i#)
| isTrue# (i# >=# 0#) = I32# (narrow32Int# (x# `iShiftL#` i#))
| otherwise = I32# (x# `iShiftRA#` negateInt# i#)
(I32# x#) `shiftL` (I# i#) = I32# (narrow32Int# (x# `iShiftL#` i#))
(I32# x#) `shiftL` (I# i#)
| isTrue# (i# >=# 0#) = I32# (narrow32Int# (x# `iShiftL#` i#))
| otherwise = overflowError
(I32# x#) `unsafeShiftL` (I# i#) =
I32# (narrow32Int# (x# `uncheckedIShiftL#` i#))
(I32# x#) `shiftR` (I# i#) = I32# (x# `iShiftRA#` i#)
(I32# x#) `shiftR` (I# i#)
| isTrue# (i# >=# 0#) = I32# (x# `iShiftRA#` i#)
| otherwise = overflowError
(I32# x#) `unsafeShiftR` (I# i#) = I32# (x# `uncheckedIShiftRA#` i#)
(I32# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#)
......@@ -821,9 +833,13 @@ instance Bits Int64 where
(I64# x#) `shift` (I# i#)
| isTrue# (i# >=# 0#) = I64# (x# `iShiftL64#` i#)
| otherwise = I64# (x# `iShiftRA64#` negateInt# i#)
(I64# x#) `shiftL` (I# i#) = I64# (x# `iShiftL64#` i#)
(I64# x#) `shiftL` (I# i#)
| isTrue# (i# >=# 0#) = I64# (x# `iShiftL64#` i#)
| otherwise = overflowError
(I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL64#` i#)
(I64# x#) `shiftR` (I# i#) = I64# (x# `iShiftRA64#` i#)
(I64# x#) `shiftR` (I# i#)
| isTrue# (i# >=# 0#) = I64# (x# `iShiftRA64#` i#)
| otherwise = overflowError
(I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA64#` i#)
(I64# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#)
......@@ -994,9 +1010,13 @@ instance Bits Int64 where
(I64# x#) `shift` (I# i#)
| isTrue# (i# >=# 0#) = I64# (x# `iShiftL#` i#)
| otherwise = I64# (x# `iShiftRA#` negateInt# i#)
(I64# x#) `shiftL` (I# i#) = I64# (x# `iShiftL#` i#)
(I64# x#) `shiftL` (I# i#)
| isTrue# (i# >=# 0#) = I64# (x# `iShiftL#` i#)
| otherwise = overflowError
(I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL#` i#)
(I64# x#) `shiftR` (I# i#) = I64# (x# `iShiftRA#` i#)
(I64# x#) `shiftR` (I# i#)
| isTrue# (i# >=# 0#) = I64# (x# `iShiftRA#` i#)
| otherwise = overflowError
(I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA#` i#)
(I64# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#)
......
......@@ -177,10 +177,14 @@ instance Bits Word8 where
(W8# x#) `shift` (I# i#)
| isTrue# (i# >=# 0#) = W8# (narrow8Word# (x# `shiftL#` i#))
| otherwise = W8# (x# `shiftRL#` negateInt# i#)
(W8# x#) `shiftL` (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#))
(W8# x#) `shiftL` (I# i#)
| isTrue# (i# >=# 0#) = W8# (narrow8Word# (x# `shiftL#` i#))
| otherwise = overflowError
(W8# x#) `unsafeShiftL` (I# i#) =
W8# (narrow8Word# (x# `uncheckedShiftL#` i#))
(W8# x#) `shiftR` (I# i#) = W8# (x# `shiftRL#` i#)
(W8# x#) `shiftR` (I# i#)
| isTrue# (i# >=# 0#) = W8# (x# `shiftRL#` i#)
| otherwise = overflowError
(W8# x#) `unsafeShiftR` (I# i#) = W8# (x# `uncheckedShiftRL#` i#)
(W8# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#) = W8# x#
......@@ -361,10 +365,14 @@ instance Bits Word16 where
(W16# x#) `shift` (I# i#)
| isTrue# (i# >=# 0#) = W16# (narrow16Word# (x# `shiftL#` i#))
| otherwise = W16# (x# `shiftRL#` negateInt# i#)
(W16# x#) `shiftL` (I# i#) = W16# (narrow16Word# (x# `shiftL#` i#))
(W16# x#) `shiftL` (I# i#)
| isTrue# (i# >=# 0#) = W16# (narrow16Word# (x# `shiftL#` i#))
| otherwise = overflowError
(W16# x#) `unsafeShiftL` (I# i#) =
W16# (narrow16Word# (x# `uncheckedShiftL#` i#))
(W16# x#) `shiftR` (I# i#) = W16# (x# `shiftRL#` i#)
(W16# x#) `shiftR` (I# i#)
| isTrue# (i# >=# 0#) = W16# (x# `shiftRL#` i#)
| otherwise = overflowError
(W16# x#) `unsafeShiftR` (I# i#) = W16# (x# `uncheckedShiftRL#` i#)
(W16# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#) = W16# x#
......@@ -591,10 +599,14 @@ instance Bits Word32 where
(W32# x#) `shift` (I# i#)
| isTrue# (i# >=# 0#) = W32# (narrow32Word# (x# `shiftL#` i#))
| otherwise = W32# (x# `shiftRL#` negateInt# i#)
(W32# x#) `shiftL` (I# i#) = W32# (narrow32Word# (x# `shiftL#` i#))
(W32# x#) `shiftL` (I# i#)
| isTrue# (i# >=# 0#) = W32# (narrow32Word# (x# `shiftL#` i#))
| otherwise = overflowError
(W32# x#) `unsafeShiftL` (I# i#) =
W32# (narrow32Word# (x# `uncheckedShiftL#` i#))
(W32# x#) `shiftR` (I# i#) = W32# (x# `shiftRL#` i#)
(W32# x#) `shiftR` (I# i#)
| isTrue# (i# >=# 0#) = W32# (x# `shiftRL#` i#)
| otherwise = overflowError
(W32# x#) `unsafeShiftR` (I# i#) = W32# (x# `uncheckedShiftRL#` i#)
(W32# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#) = W32# x#
......@@ -758,9 +770,13 @@ instance Bits Word64 where
(W64# x#) `shift` (I# i#)
| isTrue# (i# >=# 0#) = W64# (x# `shiftL64#` i#)
| otherwise = W64# (x# `shiftRL64#` negateInt# i#)
(W64# x#) `shiftL` (I# i#) = W64# (x# `shiftL64#` i#)
(W64# x#) `shiftL` (I# i#)
| isTrue# (i# >=# 0#) = W64# (x# `shiftL64#` i#)
| otherwise = overflowError
(W64# x#) `unsafeShiftL` (I# i#) = W64# (x# `uncheckedShiftL64#` i#)
(W64# x#) `shiftR` (I# i#) = W64# (x# `shiftRL64#` i#)
(W64# x#) `shiftR` (I# i#)
| isTrue# (i# >=# 0#) = W64# (x# `shiftRL64#` i#)
| otherwise = overflowError
(W64# x#) `unsafeShiftR` (I# i#) = W64# (x# `uncheckedShiftRL64#` i#)
(W64# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#) = W64# x#
......@@ -907,9 +923,13 @@ instance Bits Word64 where
(W64# x#) `shift` (I# i#)
| isTrue# (i# >=# 0#) = W64# (x# `shiftL#` i#)
| otherwise = W64# (x# `shiftRL#` negateInt# i#)
(W64# x#) `shiftL` (I# i#) = W64# (x# `shiftL#` i#)
(W64# x#) `shiftL` (I# i#)
| isTrue# (i# >=# 0#) = W64# (x# `shiftL#` i#)
| otherwise = overflowError
(W64# x#) `unsafeShiftL` (I# i#) = W64# (x# `uncheckedShiftL#` i#)
(W64# x#) `shiftR` (I# i#) = W64# (x# `shiftRL#` i#)
(W64# x#) `shiftR` (I# i#)
| isTrue# (i# >=# 0#) = W64# (x# `shiftRL#` i#)
| otherwise = overflowError
(W64# x#) `unsafeShiftR` (I# i#) = W64# (x# `uncheckedShiftRL#` i#)
(W64# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#) = W64# x#
......
......@@ -17,6 +17,10 @@
* Add `foldMap'`, a strict version of `foldMap`, to `Foldable`.
* The `shiftL` and `shiftR` methods in the `Bits` instances of `Int`, `IntN`,
`Word`, and `WordN` now throw an overflow exception for negative shift
values (instead of being undefined behaviour).
## 4.12.0.0 *21 September 2018*
* Bundled with GHC 8.6.1
......
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