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/GHC/Word.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/GHC/Word.hs')
-rw-r--r-- | libraries/base/GHC/Word.hs | 40 |
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# |