summaryrefslogtreecommitdiff
path: root/libraries/base/Data/Bits.hs
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2019-01-10 23:44:04 -0800
committerBen Gamari <ben@well-typed.com>2019-01-23 14:07:28 -0500
commit5341edf3635f2875271acc469570481c52000374 (patch)
tree98fad051d47888913fa8492170ff537330e5c7eb /libraries/base/Data/Bits.hs
parenta90a2aea94b306cf557e74c4c3ed65959d05c20c (diff)
downloadhaskell-5341edf3635f2875271acc469570481c52000374.tar.gz
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.
Diffstat (limited to 'libraries/base/Data/Bits.hs')
-rw-r--r--libraries/base/Data/Bits.hs22
1 files changed, 16 insertions, 6 deletions
diff --git a/libraries/base/Data/Bits.hs b/libraries/base/Data/Bits.hs
index 4226f8e967..000e663b83 100644
--- a/libraries/base/Data/Bits.hs
+++ b/libraries/base/Data/Bits.hs
@@ -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#