[Git][ghc/ghc][ghc-9.0] 5 commits: Bignum: add support for negative shifts (fix #18499)
Ben Gamari
gitlab at gitlab.haskell.org
Thu Aug 13 22:20:09 UTC 2020
Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC
Commits:
32496789 by Sylvain Henry at 2020-08-11T17:43:13+02:00
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.
- - - - -
b4cccab3 by Sylvain Henry at 2020-08-11T17:48:05+02:00
Fix bug in Natural multiplication (fix #18509)
A bug was lingering in Natural multiplication (inverting two limbs)
despite QuickCheck tests used during the development leading to wrong
results (independently of the selected backend).
- - - - -
817f94f5 by Sylvain Henry at 2020-08-11T17:48:22+02:00
Bignum: fix powMod for gmp backend (#18515)
Also reenable integerPowMod test which had never been reenabled by
mistake.
- - - - -
eab2511e by Sylvain Henry at 2020-08-12T11:43:42+02:00
Bignum: add backward compat integer-gmp functions
Also enhance bigNatCheck# and isValidNatural test
- - - - -
3745bdb6 by Sylvain Henry at 2020-08-12T11:43:42+02:00
Bignum: add more BigNat compat functions in integer-gmp
- - - - -
19 changed files:
- libraries/base/Data/Bits.hs
- libraries/base/tests/isValidNatural.hs
- libraries/base/tests/isValidNatural.stdout
- libraries/ghc-bignum/src/GHC/Num/BigNat.hs
- libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs
- libraries/ghc-bignum/src/GHC/Num/Natural.hs
- libraries/ghc-bignum/src/GHC/Num/WordArray.hs
- libraries/integer-gmp/integer-gmp.cabal
- libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
- testsuite/tests/lib/integer/all.T
- testsuite/tests/lib/integer/integerPowMod.hs
- testsuite/tests/lib/integer/integerPowMod.stdout
- + testsuite/tests/numeric/should_run/T18499.hs
- + testsuite/tests/numeric/should_run/T18499.stdout
- + testsuite/tests/numeric/should_run/T18509.hs
- + testsuite/tests/numeric/should_run/T18509.stdout
- + testsuite/tests/numeric/should_run/T18515.hs
- + testsuite/tests/numeric/should_run/T18515.stdout
- testsuite/tests/numeric/should_run/all.T
Changes:
=====================================
libraries/base/Data/Bits.hs
=====================================
@@ -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))
=====================================
libraries/base/tests/isValidNatural.hs
=====================================
@@ -1,10 +1,19 @@
-{-# language MagicHash #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
import GHC.Num.Natural
import GHC.Num.BigNat
import GHC.Exts
+import GHC.IO
-main = print $ map naturalCheck [0, 1, maxWord, maxWord + 1, invalid]
- where
- maxWord = fromIntegral (maxBound :: Word)
- invalid = NB (bigNatOne# void#) -- 1 would fit into the NS constructor.
+main = do
+ let
+ maxWord = fromIntegral (maxBound :: Word)
+ invalid = NB (bigNatOne# void#) -- 1 would fit into the NS constructor.
+
+ -- byteArray whose size is not a multiple of Word size
+ invalid2 <- IO $ \s -> case newByteArray# 27# s of
+ (# s', mba #) -> case unsafeFreezeByteArray# mba s' of
+ (# s'', ba #) -> (# s'', NB ba #)
+
+ print $ map naturalCheck [0, 1, maxWord, maxWord + 1, invalid, invalid2]
=====================================
libraries/base/tests/isValidNatural.stdout
=====================================
@@ -1 +1 @@
-[True,True,True,True,False]
+[True,True,True,True,False,False]
=====================================
libraries/ghc-bignum/src/GHC/Num/BigNat.hs
=====================================
@@ -80,6 +80,10 @@ data BigNat = BN# { unBigNat :: BigNat# }
bigNatCheck# :: BigNat# -> Bool#
bigNatCheck# bn
| 0# <- bigNatSize# bn = 1#
+ -- check that size is a multiple of Word size
+ | r <- remInt# (sizeofByteArray# bn) WORD_SIZE_IN_BYTES#
+ , isTrue# (r /=# 0#) = 0#
+ -- check that most-significant limb isn't zero
| 0## <- bigNatIndex# bn (bigNatSize# bn -# 1#) = 0#
| True = 1#
@@ -228,8 +232,8 @@ bigNatToWordList bn = go (bigNatSize# bn)
-- | Convert two Word# (most-significant first) into a BigNat
bigNatFromWord2# :: Word# -> Word# -> BigNat#
bigNatFromWord2# 0## 0## = bigNatZero# void#
-bigNatFromWord2# 0## n = bigNatFromWord# n
-bigNatFromWord2# w1 w2 = wordArrayFromWord2# w1 w2
+bigNatFromWord2# 0## l = bigNatFromWord# l
+bigNatFromWord2# h l = wordArrayFromWord2# h l
-- | Convert a BigNat into a Word#
bigNatToWord# :: BigNat# -> Word#
=====================================
libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs
=====================================
@@ -349,7 +349,8 @@ bignat_powmod
-> State# RealWorld
-> State# RealWorld
bignat_powmod r b e m s =
- ioVoid (integer_gmp_powm# r b (wordArraySize# b) e (wordArraySize# e) m (wordArraySize# m)) s
+ case ioInt# (integer_gmp_powm# r b (wordArraySize# b) e (wordArraySize# e) m (wordArraySize# m)) s of
+ (# s', n #) -> mwaSetSize# r (narrowGmpSize# n) s'
----------------------------------------------------------------------
=====================================
libraries/ghc-bignum/src/GHC/Num/Natural.hs
=====================================
@@ -86,8 +86,8 @@ naturalFromWord# x = NS x
-- | Convert two Word# (most-significant first) into a Natural
naturalFromWord2# :: Word# -> Word# -> Natural
naturalFromWord2# 0## 0## = naturalZero
-naturalFromWord2# 0## n = NS n
-naturalFromWord2# w1 w2 = NB (bigNatFromWord2# w2 w1)
+naturalFromWord2# 0## l = NS l
+naturalFromWord2# h l = NB (bigNatFromWord2# h l)
-- | Create a Natural from a Word
naturalFromWord :: Word -> Natural
=====================================
libraries/ghc-bignum/src/GHC/Num/WordArray.hs
=====================================
@@ -121,12 +121,14 @@ withNewWordArrayTrimedMaybe# sz act = case runRW# io of (# _, a #) -> a
-- | Create a WordArray# from two Word#
--
--- `byteArrayFromWord2# msw lsw = lsw:msw`
+-- `wordArrayFromWord2# h l
+-- where h is the most significant word
+-- l is the least significant word
wordArrayFromWord2# :: Word# -> Word# -> WordArray#
-wordArrayFromWord2# msw lsw =
+wordArrayFromWord2# h l =
withNewWordArray# 2# \mwa s ->
- case mwaWrite# mwa 0# lsw s of
- s -> mwaWrite# mwa 1# msw s
+ case mwaWrite# mwa 0# l s of
+ s -> mwaWrite# mwa 1# h s
-- | Create a WordArray# from one Word#
wordArrayFromWord# :: Word# -> WordArray#
=====================================
libraries/integer-gmp/integer-gmp.cabal
=====================================
@@ -26,6 +26,7 @@ library
build-depends:
base >= 4.11 && < 5
, ghc-prim
+ , ghc-bignum
exposed-modules:
GHC.Integer.GMP.Internals
=====================================
libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
=====================================
@@ -5,6 +5,7 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE BlockArguments #-}
#include "MachDeps.h"
@@ -42,12 +43,73 @@ module GHC.Integer.GMP.Internals
, GmpLimb, GmpLimb#
, GmpSize, GmpSize#
+ -- **
+
+ , isValidBigNat#
+ , sizeofBigNat#
+ , zeroBigNat
+ , oneBigNat
+
+ -- ** 'BigNat' arithmetic operations
+ , plusBigNat
+ , plusBigNatWord
+ , timesBigNat
+ , timesBigNatWord
+ , sqrBigNat
+
+ , quotRemBigNat
+ , quotRemBigNatWord
+ , quotBigNatWord
+ , quotBigNat
+ , remBigNat
+ , remBigNatWord
+
+ , gcdBigNat
+ , gcdBigNatWord
+
+ -- ** 'BigNat' logic operations
+ , shiftRBigNat
+ , shiftLBigNat
+ , testBitBigNat
+ , clearBitBigNat
+ , complementBitBigNat
+ , setBitBigNat
+ , andBigNat
+ , xorBigNat
+ , popCountBigNat
+ , orBigNat
+ , bitBigNat
+
+ -- ** 'BigNat' comparison predicates
+ , isZeroBigNat
+
+ , compareBigNatWord
+ , compareBigNat
+ , eqBigNatWord
+ , eqBigNatWord#
+ , eqBigNat
+ , eqBigNat#
+ , gtBigNatWord#
+
+ -- * Import/export functions
+ -- ** Compute size of serialisation
+ , sizeInBaseBigNat
+ , sizeInBaseInteger
+ , sizeInBaseWord#
+
+ -- ** Export
+ , exportBigNatToAddr
+
+ -- ** Import
+ , importBigNatFromAddr
) where
import GHC.Integer
import GHC.Natural
import GHC.Num.Integer (Integer(..))
import qualified GHC.Num.Integer as I
+import qualified GHC.Num.BigNat as B
+import qualified GHC.Num.Primitives as P
import GHC.Types
import GHC.Prim
@@ -112,3 +174,173 @@ type GmpLimb = Word
type GmpLimb# = Word#
type GmpSize = Int
type GmpSize# = Int#
+
+{-# DEPRECATED sizeofBigNat# "Use bigNatSize# instead" #-}
+sizeofBigNat# :: BigNat -> GmpSize#
+sizeofBigNat# (BN# i) = B.bigNatSize# i
+
+{-# DEPRECATED isValidBigNat# "Use bigNatCheck# instead" #-}
+isValidBigNat# :: BigNat -> Int#
+isValidBigNat# (BN# i) = B.bigNatCheck# i
+
+{-# DEPRECATED zeroBigNat "Use bigNatZero instead" #-}
+zeroBigNat :: BigNat
+zeroBigNat = B.bigNatZero
+
+{-# DEPRECATED oneBigNat "Use bigNatOne instead" #-}
+oneBigNat :: BigNat
+oneBigNat = B.bigNatOne
+
+{-# DEPRECATED plusBigNat "Use bigNatAdd instead" #-}
+plusBigNat :: BigNat -> BigNat -> BigNat
+plusBigNat (BN# a) (BN# b) = BN# (B.bigNatAdd a b)
+
+{-# DEPRECATED plusBigNatWord "Use bigNatAddWord# instead" #-}
+plusBigNatWord :: BigNat -> GmpLimb# -> BigNat
+plusBigNatWord (BN# a) w = BN# (B.bigNatAddWord# a w)
+
+{-# DEPRECATED timesBigNat "Use bigNatMul instead" #-}
+timesBigNat :: BigNat -> BigNat -> BigNat
+timesBigNat (BN# a) (BN# b) = BN# (B.bigNatMul a b)
+
+{-# DEPRECATED timesBigNatWord "Use bigNatMulWord# instead" #-}
+timesBigNatWord :: BigNat -> GmpLimb# -> BigNat
+timesBigNatWord (BN# a) w = BN# (B.bigNatMulWord# a w)
+
+{-# DEPRECATED sqrBigNat "Use bigNatSqr instead" #-}
+sqrBigNat :: BigNat -> BigNat
+sqrBigNat (BN# a) = BN# (B.bigNatSqr a)
+
+{-# DEPRECATED quotRemBigNat "Use bigNatQuotRem# instead" #-}
+quotRemBigNat :: BigNat -> BigNat -> (# BigNat,BigNat #)
+quotRemBigNat (BN# a) (BN# b) = case B.bigNatQuotRem# a b of
+ (# q, r #) -> (# BN# q, BN# r #)
+
+{-# DEPRECATED quotRemBigNatWord "Use bigNatQuotRemWord# instead" #-}
+quotRemBigNatWord :: BigNat -> GmpLimb# -> (# BigNat, GmpLimb# #)
+quotRemBigNatWord (BN# a) b = case B.bigNatQuotRemWord# a b of
+ (# q, r #) -> (# BN# q, r #)
+
+{-# DEPRECATED quotBigNat "Use bigNatQuot instead" #-}
+quotBigNat :: BigNat -> BigNat -> BigNat
+quotBigNat (BN# a) (BN# b) = BN# (B.bigNatQuot a b)
+
+{-# DEPRECATED quotBigNatWord "Use bigNatQuotWord# instead" #-}
+quotBigNatWord :: BigNat -> GmpLimb# -> BigNat
+quotBigNatWord (BN# a) b = BN# (B.bigNatQuotWord# a b)
+
+{-# DEPRECATED remBigNat "Use bigNatRem instead" #-}
+remBigNat :: BigNat -> BigNat -> BigNat
+remBigNat (BN# a) (BN# b) = BN# (B.bigNatRem a b)
+
+{-# DEPRECATED remBigNatWord "Use bigNatRemWord# instead" #-}
+remBigNatWord :: BigNat -> GmpLimb# -> Word#
+remBigNatWord (BN# a) b = B.bigNatRemWord# a b
+
+{-# DEPRECATED gcdBigNatWord "Use bigNatGcdWord# instead" #-}
+gcdBigNatWord :: BigNat -> Word# -> Word#
+gcdBigNatWord (BN# a) b = B.bigNatGcdWord# a b
+
+{-# DEPRECATED gcdBigNat "Use bigNatGcd instead" #-}
+gcdBigNat:: BigNat -> BigNat -> BigNat
+gcdBigNat (BN# a) (BN# b) = BN# (B.bigNatGcd a b)
+
+{-# DEPRECATED shiftRBigNat "Use bigNatShiftR# instead" #-}
+shiftRBigNat :: BigNat -> Int# -> BigNat
+shiftRBigNat (BN# a) i = BN# (B.bigNatShiftR# a (int2Word# i))
+
+{-# DEPRECATED shiftLBigNat "Use bigNatShiftL# instead" #-}
+shiftLBigNat :: BigNat -> Int# -> BigNat
+shiftLBigNat (BN# a) i = BN# (B.bigNatShiftL# a (int2Word# i))
+
+{-# DEPRECATED testBitBigNat "Use bigNatTestBit# instead" #-}
+testBitBigNat :: BigNat -> Int# -> Bool
+testBitBigNat (BN# a) i = isTrue# (B.bigNatTestBit# a (int2Word# i))
+
+{-# DEPRECATED clearBitBigNat "Use bigNatClearBit# instead" #-}
+clearBitBigNat :: BigNat -> Int# -> BigNat
+clearBitBigNat (BN# a) i = BN# (B.bigNatClearBit# a (int2Word# i))
+
+{-# DEPRECATED complementBitBigNat "Use bigNatComplementBit# instead" #-}
+complementBitBigNat :: BigNat -> Int# -> BigNat
+complementBitBigNat (BN# a) i = BN# (B.bigNatComplementBit# a (int2Word# i))
+
+{-# DEPRECATED setBitBigNat "Use bigNatSetBit# instead" #-}
+setBitBigNat :: BigNat -> Int# -> BigNat
+setBitBigNat (BN# a) i = BN# (B.bigNatSetBit# a (int2Word# i))
+
+{-# DEPRECATED andBigNat "Use bigNatAnd instead" #-}
+andBigNat :: BigNat -> BigNat -> BigNat
+andBigNat (BN# a) (BN# b) = BN# (B.bigNatAnd a b)
+
+{-# DEPRECATED orBigNat "Use bigNatOr instead" #-}
+orBigNat :: BigNat -> BigNat -> BigNat
+orBigNat (BN# a) (BN# b) = BN# (B.bigNatOr a b)
+
+{-# DEPRECATED xorBigNat "Use bigNatXor instead" #-}
+xorBigNat :: BigNat -> BigNat -> BigNat
+xorBigNat (BN# a) (BN# b) = BN# (B.bigNatXor a b)
+
+{-# DEPRECATED popCountBigNat "Use bigNatPopCount# instead" #-}
+popCountBigNat :: BigNat -> Int#
+popCountBigNat (BN# a) = word2Int# (B.bigNatPopCount# a)
+
+{-# DEPRECATED bitBigNat "Use bigNatBit# instead" #-}
+bitBigNat :: Int# -> BigNat
+bitBigNat i = BN# (B.bigNatBit# (int2Word# i))
+
+{-# DEPRECATED isZeroBigNat "Use bigNatIsZero instead" #-}
+isZeroBigNat :: BigNat -> Bool
+isZeroBigNat (BN# a) = B.bigNatIsZero a
+
+{-# DEPRECATED compareBigNat "Use bigNatCompare instead" #-}
+compareBigNat :: BigNat -> BigNat -> Ordering
+compareBigNat (BN# a) (BN# b) = B.bigNatCompare a b
+
+{-# DEPRECATED compareBigNatWord "Use bigNatCompareWord# instead" #-}
+compareBigNatWord :: BigNat -> GmpLimb# -> Ordering
+compareBigNatWord (BN# a) w = B.bigNatCompareWord# a w
+
+{-# DEPRECATED eqBigNatWord "Use bigNatEqWord# instead" #-}
+eqBigNatWord :: BigNat -> GmpLimb# -> Bool
+eqBigNatWord (BN# a) w = isTrue# (B.bigNatEqWord# a w)
+
+{-# DEPRECATED eqBigNatWord# "Use bigNatEqWord# instead" #-}
+eqBigNatWord# :: BigNat -> GmpLimb# -> Int#
+eqBigNatWord# (BN# a) w = B.bigNatEqWord# a w
+
+{-# DEPRECATED eqBigNat# "Use bigNatEq# instead" #-}
+eqBigNat# :: BigNat -> BigNat -> Int#
+eqBigNat# (BN# a) (BN# b) = B.bigNatEq# a b
+
+{-# DEPRECATED eqBigNat "Use bigNatEq instead" #-}
+eqBigNat :: BigNat -> BigNat -> Bool
+eqBigNat (BN# a) (BN# b) = B.bigNatEq a b
+
+{-# DEPRECATED gtBigNatWord# "Use bigNatGtWord# instead" #-}
+gtBigNatWord# :: BigNat -> GmpLimb# -> Int#
+gtBigNatWord# (BN# a) w = B.bigNatGtWord# a w
+
+{-# DEPRECATED sizeInBaseBigNat "Use bigNatSizeInBase# instead" #-}
+sizeInBaseBigNat :: BigNat -> Int# -> Word#
+sizeInBaseBigNat (BN# a) b = B.bigNatSizeInBase# (int2Word# b) a
+
+{-# DEPRECATED sizeInBaseInteger "Use integerSizeInBase# instead" #-}
+sizeInBaseInteger :: Integer -> Int# -> Word#
+sizeInBaseInteger i b = I.integerSizeInBase# (int2Word# b) i
+
+{-# DEPRECATED sizeInBaseWord# "Use wordSizeInBase# instead" #-}
+sizeInBaseWord# :: Word# -> Int# -> Word#
+sizeInBaseWord# a b = P.wordSizeInBase# (int2Word# b) a
+
+{-# DEPRECATED importBigNatFromAddr "Use bigNatFromAddr# instead" #-}
+importBigNatFromAddr :: Addr# -> Word# -> Int# -> IO BigNat
+importBigNatFromAddr addr sz endian = IO \s ->
+ case B.bigNatFromAddr# sz addr endian s of
+ (# s', b #) -> (# s', BN# b #)
+
+{-# DEPRECATED exportBigNatToAddr "Use bigNatToAddr# instead" #-}
+exportBigNatToAddr :: BigNat -> Addr# -> Int# -> IO Word
+exportBigNatToAddr (BN# b) addr endian = IO \s ->
+ case B.bigNatToAddr# b addr endian s of
+ (# s', w #) -> (# s', W# w #)
=====================================
testsuite/tests/lib/integer/all.T
=====================================
@@ -5,11 +5,11 @@ test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding']
test('fromToInteger', [], makefile_test, ['fromToInteger'])
test('IntegerConversionRules', [], makefile_test, ['IntegerConversionRules'])
test('gcdInteger', normal, compile_and_run, [''])
+test('integerPowMod', [], compile_and_run, [''])
# skip ghci as it doesn't support unboxed tuples
test('integerImportExport', [omit_ways(['ghci'])], compile_and_run, [''])
# Disable GMP only tests
#test('integerGcdExt', [omit_ways(['ghci'])], compile_and_run, [''])
-#test('integerPowMod', [], compile_and_run, [''])
#test('integerGmpInternals', [], compile_and_run, [''])
=====================================
testsuite/tests/lib/integer/integerPowMod.hs
=====================================
@@ -7,19 +7,12 @@ import Control.Monad
import GHC.Word
import GHC.Base
-import qualified GHC.Integer.GMP.Internals as I
-
-powModSecInteger :: Integer -> Integer -> Integer -> Integer
-powModSecInteger = I.powModSecInteger
-
-powModInteger :: Integer -> Integer -> Integer -> Integer
-powModInteger = I.powModInteger
+import GHC.Natural
main :: IO ()
main = do
- print $ powModInteger b e m
- print $ powModInteger b e (m-1)
- print $ powModSecInteger b e (m-1)
+ print $ powModNatural b e m
+ print $ powModNatural b e (m-1)
where
b = 2988348162058574136915891421498819466320163312926952423791023078876139
=====================================
testsuite/tests/lib/integer/integerPowMod.stdout
=====================================
@@ -1,3 +1,2 @@
1527229998585248450016808958343740453059
682382427572745901624116300491295556924
-682382427572745901624116300491295556924
=====================================
testsuite/tests/numeric/should_run/T18499.hs
=====================================
@@ -0,0 +1,27 @@
+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!")
=====================================
testsuite/tests/numeric/should_run/T18499.stdout
=====================================
@@ -0,0 +1,16 @@
+Overflow!
+Overflow!
+Overflow!
+Overflow!
+Overflow!
+Overflow!
+Overflow!
+Overflow!
+10
+168
+10
+168
+10
+168
+10
+168
=====================================
testsuite/tests/numeric/should_run/T18509.hs
=====================================
@@ -0,0 +1,6 @@
+import Numeric.Natural
+
+main :: IO ()
+main = do
+ print $ (0xFFFFFFFF0 * 0xFFFFFFFF0 :: Natural)
+ print $ (2 :: Natural) ^ (190 :: Int)
=====================================
testsuite/tests/numeric/should_run/T18509.stdout
=====================================
@@ -0,0 +1,2 @@
+4722366480670621958400
+1569275433846670190958947355801916604025588861116008628224
=====================================
testsuite/tests/numeric/should_run/T18515.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE MagicHash #-}
+
+import GHC.Num.BigNat
+import GHC.Num.Integer
+
+main :: IO ()
+main =
+ let b = integerToBigNatClamp# 251943445928310882947152017889649234
+ e = integerToBigNatClamp# 503886891856621765894304035779298468
+ m = integerToBigNatClamp# 503886891856621765894304035779298469
+ r = integerFromBigNat# (bigNatPowMod b e m)
+ in print r
=====================================
testsuite/tests/numeric/should_run/T18515.stdout
=====================================
@@ -0,0 +1 @@
+1
=====================================
testsuite/tests/numeric/should_run/all.T
=====================================
@@ -70,3 +70,6 @@ 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, [''])
+test('T18509', normal, compile_and_run, [''])
+test('T18515', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a10505e74ad9833d37d84afb9bf2cd031fd0ea71...3745bdb69b19e43da5b6a26597e1a95d17cca929
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a10505e74ad9833d37d84afb9bf2cd031fd0ea71...3745bdb69b19e43da5b6a26597e1a95d17cca929
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200813/d234e0ab/attachment-0001.html>
More information about the ghc-commits
mailing list