diff options
author | Alec Theriault <alec.theriault@gmail.com> | 2019-01-10 23:44:04 -0800 |
---|---|---|
committer | Ben Gamari <ben@well-typed.com> | 2019-01-23 14:07:28 -0500 |
commit | 5341edf3635f2875271acc469570481c52000374 (patch) | |
tree | 98fad051d47888913fa8492170ff537330e5c7eb /libraries/base/Data/Bits.hs | |
parent | a90a2aea94b306cf557e74c4c3ed65959d05c20c (diff) | |
download | haskell-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.hs | 22 |
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# |