summaryrefslogtreecommitdiff
path: root/libraries/base/GHC/Word.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/GHC/Word.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/GHC/Word.hs')
-rw-r--r--libraries/base/GHC/Word.hs40
1 files changed, 30 insertions, 10 deletions
diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs
index 5ea827e2c8..d19a31dfb2 100644
--- a/libraries/base/GHC/Word.hs
+++ b/libraries/base/GHC/Word.hs
@@ -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#