diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-08-24 19:21:53 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-08-26 04:51:35 -0400 |
commit | dc476a5040cdc64c177de0f78edaafec0972cff4 (patch) | |
tree | 7b2c5add9c12472c84d9ff8b13fd95ec2075ae28 /libraries/ghc-bignum | |
parent | 0b17fa185aec793861364afd9a05aa4219fbc019 (diff) | |
download | haskell-dc476a5040cdc64c177de0f78edaafec0972cff4.tar.gz |
Bignum: fix BigNat subtraction (#18604)
There was a confusion between the boolean expected by
withNewWordArrayTrimedMaybe and the boolean returned by subtracting
functions.
Diffstat (limited to 'libraries/ghc-bignum')
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/BigNat.hs | 2 | ||||
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs | 8 | ||||
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs | 6 | ||||
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/WordArray.hs | 22 |
4 files changed, 19 insertions, 19 deletions
diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs index 8b5b4d31e3..e38c807ede 100644 --- a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs +++ b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs @@ -506,7 +506,7 @@ bigNatSubUnsafe a b let szA = wordArraySize# a in withNewWordArrayTrimed# szA \mwa s-> case inline bignat_sub mwa a b s of - (# s', 0# #) -> s' + (# s', 1# #) -> s' (# s', _ #) -> case raiseUnderflow of !_ -> s' -- see Note [ghc-bignum exceptions] in diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs index 965b7c76ec..d316c65e82 100644 --- a/libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs +++ b/libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs @@ -92,8 +92,8 @@ bignat_sub {-# INLINE bignat_sub #-} bignat_sub mwa wa wb s = case ioWord# (c_mpn_sub mwa wa (wordArraySize# wa) wb (wordArraySize# wb)) s of - (# s', 0## #) -> (# s', 0# #) - (# s', _ #) -> (# s', 1# #) + (# s', 1## #) -> (# s', 0# #) -- overflow + (# s', _ #) -> (# s', 1# #) -- no overflow bignat_sub_word :: MutableWordArray# RealWorld @@ -104,8 +104,8 @@ bignat_sub_word {-# INLINE bignat_sub_word #-} bignat_sub_word mwa wa b s = case ioWord# (c_mpn_sub_1 mwa wa (wordArraySize# wa) b) s of - (# s', 0## #) -> (# s', 0# #) - (# s', _ #) -> (# s', 1# #) + (# s', 1## #) -> (# s', 0# #) -- overflow + (# s', _ #) -> (# s', 1# #) -- no overflow bignat_mul :: MutableWordArray# RealWorld diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs index 2d06a730a0..592a434337 100644 --- a/libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs +++ b/libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs @@ -127,17 +127,17 @@ bignat_sub_word mwa wa b = go b 0# !sz = wordArraySize# wa go carry i s | isTrue# (i >=# sz) - = (# s, carry `neWord#` 0## #) + = (# s, carry `eqWord#` 0## #) | 0## <- carry = case mwaArrayCopy# mwa i wa i (sz -# i) s of - s' -> (# s', 0# #) + s' -> (# s', 1# #) -- no overflow | True = case subWordC# (indexWordArray# wa i) carry of (# 0##, 0# #) | isTrue# (i ==# sz) -> case mwaShrink# mwa 1# s of - s' -> (# s', 0# #) + s' -> (# s', 1# #) -- no overflow (# l , c #) -> case mwaWrite# mwa i l s of s1 -> go (int2Word# c) (i +# 1#) s1 diff --git a/libraries/ghc-bignum/src/GHC/Num/WordArray.hs b/libraries/ghc-bignum/src/GHC/Num/WordArray.hs index 9b98f74293..eded6a83ee 100644 --- a/libraries/ghc-bignum/src/GHC/Num/WordArray.hs +++ b/libraries/ghc-bignum/src/GHC/Num/WordArray.hs @@ -318,7 +318,7 @@ mwaAddInplaceWord# mwa i y s = case readWordArray# mwa i s of -- | Sub Word# inplace (at the specified offset) in the mwa with carry -- propagation. -- --- Return True# on overflow +-- Return False# on overflow mwaSubInplaceWord# :: MutableWordArray# d -> Int# @@ -328,9 +328,9 @@ mwaSubInplaceWord# mwaSubInplaceWord# mwa ii iw s1 = case mwaSize# mwa s1 of (# is, sz #) -> let - go _ 0## s = (# s, 0# #) -- no overflow + go _ 0## s = (# s, 1# #) -- no overflow go i y s - | isTrue# (i >=# sz) = (# s, 1# #) -- overflow + | isTrue# (i >=# sz) = (# s, 0# #) -- overflow | True = case readWordArray# mwa i s of (# s1, x #) -> let !(# l,h #) = subWordC# x y in case mwaWrite# mwa i l s1 of @@ -368,16 +368,16 @@ mwaTrimCompare k mwa wb s1 -- -- We don't trim the resulting array! -- --- Return True# on overflow. +-- Return False# on overflow. mwaSubInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> (# State# d, Bool# #) mwaSubInplaceArray mwa off wb = go (wordArraySize# wb -# 1#) where go i s - | isTrue# (i <# 0#) = (# s, 0# #) -- no overflow + | isTrue# (i <# 0#) = (# s, 1# #) -- no overflow | True = case mwaSubInplaceWord# mwa (off +# i) (indexWordArray# wb i) s of - (# s2, 0# #) -> go (i -# 1#) s2 - (# s2, _ #) -> (# s2, 1# #) -- overflow + (# s2, 1# #) -> go (i -# 1#) s2 + (# s2, _ #) -> (# s2, 0# #) -- overflow -- | Add array inplace (a the specified offset) in the mwa with carry propagation. -- @@ -398,19 +398,19 @@ mwaAddInplaceArray mwa off wb = go 0# 0## -- -- We don't trim the resulting array! -- --- Return True# on overflow. +-- Return False# on overflow. mwaSubInplaceMutableArray :: MutableWordArray# d -> Int# -> MutableWordArray# d -> State# d -> (# State# d, Bool# #) mwaSubInplaceMutableArray mwa off mwb s0 = case mwaSize# mwb s0 of (# s1, szB #) -> go (szB -# 1#) s1 where go i s - | isTrue# (i <# 0#) = (# s, 0# #) -- no overflow + | isTrue# (i <# 0#) = (# s, 1# #) -- no overflow | True = case readWordArray# mwb i s of (# s1, bi #) -> case mwaSubInplaceWord# mwa (off +# i) bi s1 of - (# s2, 0# #) -> go (i -# 1#) s2 - (# s2, _ #) -> (# s2, 1# #) -- overflow + (# s2, 1# #) -> go (i -# 1#) s2 + (# s2, _ #) -> (# s2, 0# #) -- overflow -- | Sub an array inplace and then trim zeroes -- |