summaryrefslogtreecommitdiff
path: root/libraries/ghc-bignum/src/GHC/Num
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-08-24 19:21:53 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-08-26 04:51:35 -0400
commitdc476a5040cdc64c177de0f78edaafec0972cff4 (patch)
tree7b2c5add9c12472c84d9ff8b13fd95ec2075ae28 /libraries/ghc-bignum/src/GHC/Num
parent0b17fa185aec793861364afd9a05aa4219fbc019 (diff)
downloadhaskell-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/src/GHC/Num')
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/BigNat.hs2
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs8
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs6
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/WordArray.hs22
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
--