Commit 6ee07b49 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

Bignum: add support for negative shifts (fix #18499)

shiftR/shiftL support negative arguments despite Haskell 2010 report
saying otherwise. We explicitly test for negative values which is bad
(it gets in the way of constant folding, etc.). Anyway, for consistency
we fix Bits instancesof Integer/Natural.
parent 0bd60059
Pipeline #22718 passed with stages
in 317 minutes and 35 seconds
......@@ -537,8 +537,14 @@ instance Bits Integer where
(.|.) = integerOr
xor = integerXor
complement = integerComplement
shiftR x i = integerShiftR x (fromIntegral i)
shiftL x i = integerShiftL x (fromIntegral i)
unsafeShiftR x i = integerShiftR x (fromIntegral i)
unsafeShiftL x i = integerShiftL x (fromIntegral i)
shiftR x i@(I# i#)
| isTrue# (i# >=# 0#) = unsafeShiftR x i
| otherwise = overflowError
shiftL x i@(I# i#)
| isTrue# (i# >=# 0#) = unsafeShiftL x i
| otherwise = overflowError
shift x i | i >= 0 = integerShiftL x (fromIntegral i)
| otherwise = integerShiftR x (fromIntegral (negate i))
testBit x i = integerTestBit x (fromIntegral i)
......@@ -560,8 +566,14 @@ instance Bits Natural where
xor = naturalXor
complement _ = errorWithoutStackTrace
"Bits.complement: Natural complement undefined"
shiftR x i = naturalShiftR x (fromIntegral i)
shiftL x i = naturalShiftL x (fromIntegral i)
unsafeShiftR x i = naturalShiftR x (fromIntegral i)
unsafeShiftL x i = naturalShiftL x (fromIntegral i)
shiftR x i@(I# i#)
| isTrue# (i# >=# 0#) = unsafeShiftR x i
| otherwise = overflowError
shiftL x i@(I# i#)
| isTrue# (i# >=# 0#) = unsafeShiftL x i
| otherwise = overflowError
shift x i
| i >= 0 = naturalShiftL x (fromIntegral i)
| otherwise = naturalShiftR x (fromIntegral (negate i))
......
import Data.Bits
import Numeric.Natural
import GHC.Exception.Type
import Control.Exception
main :: IO ()
main = do
test ((42 `shiftR` (-1)) :: Integer)
test ((42 `shiftL` (-1)) :: Integer)
test ((42 `shiftR` (-1)) :: Natural)
test ((42 `shiftL` (-1)) :: Natural)
test ((42 `shiftR` (-1)) :: Word)
test ((42 `shiftL` (-1)) :: Word)
test ((42 `shiftR` (-1)) :: Int)
test ((42 `shiftL` (-1)) :: Int)
test ((42 `unsafeShiftR` 2) :: Integer)
test ((42 `unsafeShiftL` 2) :: Integer)
test ((42 `unsafeShiftR` 2) :: Natural)
test ((42 `unsafeShiftL` 2) :: Natural)
test ((42 `unsafeShiftR` 2) :: Word)
test ((42 `unsafeShiftL` 2) :: Word)
test ((42 `unsafeShiftR` 2) :: Int)
test ((42 `unsafeShiftL` 2) :: Int)
test :: Show a => a -> IO ()
test a = print a `catch` (\Overflow -> putStrLn "Overflow!")
Overflow!
Overflow!
Overflow!
Overflow!
Overflow!
Overflow!
Overflow!
Overflow!
10
168
10
168
10
168
10
168
......@@ -70,3 +70,4 @@ test('T15301', normal, compile_and_run, ['-O2'])
test('T497', normal, compile_and_run, ['-O'])
test('T17303', normal, compile_and_run, [''])
test('T18359', normal, compile_and_run, [''])
test('T18499', normal, compile_and_run, [''])
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