[Git][ghc/ghc][ghc-9.0] 2 commits: Fix documentation and fix "check" bignum backend (#18604)
Ben Gamari
gitlab at gitlab.haskell.org
Tue Sep 1 15:37:01 UTC 2020
Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC
Commits:
a3e90763 by Sylvain Henry at 2020-09-01T10:22:24+02:00
Fix documentation and fix "check" bignum backend (#18604)
(cherry-picked from 0a3723876c6c79a0a407d50f4baa2818a13f232e)
- - - - -
d5c3a027 by Sylvain Henry at 2020-09-01T10:22:46+02:00
Bignum: add BigNat compat functions (#18613)
(cherry-picked from a8a2568b7b64e5b9fca5b12df7da759de4db39ae)
- - - - -
6 changed files:
- libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs
- libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs
- libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs
- libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs
- libraries/ghc-bignum/src/GHC/Num/WordArray.hs
- libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
Changes:
=====================================
libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs
=====================================
@@ -129,8 +129,8 @@ mwaCompareOpBool mwa f g s =
0# -> case unexpectedValue of
!_ -> (# s, ra #)
-- see Note [ghc-bignum exceptions] in GHC.Num.Primitives
- _ -> case (ra ==# 1#) of -- don't compare MWAs if overflow signaled!
- 1# -> (# s, ra #)
+ _ -> case ra of -- don't compare MWAs if underflow signaled!
+ 0# -> (# s, ra #) -- underflow
_ -> case mwaTrimZeroes# mwa s of { s ->
case mwaTrimZeroes# mwb s of { s ->
case mwaCompare mwa mwb s of
=====================================
libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs
=====================================
@@ -113,7 +113,7 @@ foreign import ccall unsafe ghc_bignat_mul_word
-- The potential 0 most-significant Words will be removed by the caller if it is
-- not already done by the backend.
--
--- Return True to indicate overflow.
+-- Return False# to indicate underflow.
bignat_sub
:: MutableWordArray# RealWorld
-> WordArray#
@@ -136,7 +136,7 @@ foreign import ccall unsafe ghc_bignat_sub
-- The potential 0 most-significant Words will be removed by the caller if it is
-- not already done by the backend.
--
--- Return True to indicate overflow.
+-- Return False# to indicate underflow.
bignat_sub_word
:: MutableWordArray# RealWorld
-> WordArray#
=====================================
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', 1## #) -> (# s', 0# #) -- overflow
- (# s', _ #) -> (# s', 1# #) -- no overflow
+ (# s', 1## #) -> (# s', 0# #) -- underflow
+ (# s', _ #) -> (# s', 1# #) -- no underflow
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', 1## #) -> (# s', 0# #) -- overflow
- (# s', _ #) -> (# s', 1# #) -- no overflow
+ (# s', 1## #) -> (# s', 0# #) -- underflow
+ (# s', _ #) -> (# s', 1# #) -- no underflow
bignat_mul
:: MutableWordArray# RealWorld
=====================================
libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs
=====================================
@@ -131,13 +131,13 @@ bignat_sub_word mwa wa b = go b 0#
| 0## <- carry
= case mwaArrayCopy# mwa i wa i (sz -# i) s of
- s' -> (# s', 1# #) -- no overflow
+ s' -> (# s', 1# #) -- no underflow
| True
= case subWordC# (indexWordArray# wa i) carry of
(# 0##, 0# #)
| isTrue# (i ==# sz) -> case mwaShrink# mwa 1# s of
- s' -> (# s', 1# #) -- no overflow
+ s' -> (# s', 1# #) -- no underflow
(# l , c #) -> case mwaWrite# mwa i l s of
s1 -> go (int2Word# c) (i +# 1#) s1
=====================================
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 False# on overflow
+-- Return False# on underflow
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, 1# #) -- no overflow
+ go _ 0## s = (# s, 1# #) -- no underflow
go i y s
- | isTrue# (i >=# sz) = (# s, 0# #) -- overflow
+ | isTrue# (i >=# sz) = (# s, 0# #) -- underflow
| 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 False# on overflow.
+-- Return False# on underflow.
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, 1# #) -- no overflow
+ | isTrue# (i <# 0#) = (# s, 1# #) -- no underflow
| True
= case mwaSubInplaceWord# mwa (off +# i) (indexWordArray# wb i) s of
(# s2, 1# #) -> go (i -# 1#) s2
- (# s2, _ #) -> (# s2, 0# #) -- overflow
+ (# s2, _ #) -> (# s2, 0# #) -- underflow
-- | 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 False# on overflow.
+-- Return False# on underflow.
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, 1# #) -- no overflow
+ | isTrue# (i <# 0#) = (# s, 1# #) -- no underflow
| True
= case readWordArray# mwb i s of
(# s1, bi #) -> case mwaSubInplaceWord# mwa (off +# i) bi s1 of
(# s2, 1# #) -> go (i -# 1#) s2
- (# s2, _ #) -> (# s2, 0# #) -- overflow
+ (# s2, _ #) -> (# s2, 0# #) -- underflow
-- | Sub an array inplace and then trim zeroes
--
=====================================
libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
=====================================
@@ -50,9 +50,22 @@ module GHC.Integer.GMP.Internals
, zeroBigNat
, oneBigNat
+ -- ** Conversions to/from 'BigNat'
+
+ , wordToBigNat
+ , wordToBigNat2
+ , bigNatToInt
+ , bigNatToWord
+ , indexBigNat#
+ , importBigNatFromByteArray
+ , exportBigNatToMutableByteArray
+
+
-- ** 'BigNat' arithmetic operations
, plusBigNat
, plusBigNatWord
+ , minusBigNat
+ , minusBigNatWord
, timesBigNat
, timesBigNatWord
, sqrBigNat
@@ -112,6 +125,8 @@ import qualified GHC.Num.BigNat as B
import qualified GHC.Num.Primitives as P
import GHC.Types
import GHC.Prim
+import GHC.Exts (runRW#)
+import Control.Exception
{-# COMPLETE S#, Jp#, Jn# #-}
@@ -199,6 +214,19 @@ plusBigNat (BN# a) (BN# b) = BN# (B.bigNatAdd a b)
plusBigNatWord :: BigNat -> GmpLimb# -> BigNat
plusBigNatWord (BN# a) w = BN# (B.bigNatAddWord# a w)
+{-# DEPRECATED minusBigNat "Use bigNatSub instead" #-}
+minusBigNat :: BigNat -> BigNat -> BigNat
+minusBigNat (BN# a) (BN# b) = case B.bigNatSub a b of
+ (# () | #) -> throw Underflow
+ (# | r #) -> BN# r
+
+{-# DEPRECATED minusBigNatWord "Use bigNatSubWord# instead" #-}
+minusBigNatWord :: BigNat -> GmpLimb# -> BigNat
+minusBigNatWord (BN# a) b = case B.bigNatSubWord# a b of
+ (# () | #) -> throw Underflow
+ (# | r #) -> BN# r
+
+
{-# DEPRECATED timesBigNat "Use bigNatMul instead" #-}
timesBigNat :: BigNat -> BigNat -> BigNat
timesBigNat (BN# a) (BN# b) = BN# (B.bigNatMul a b)
@@ -344,3 +372,29 @@ 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 #)
+
+wordToBigNat :: Word# -> BigNat
+wordToBigNat w = BN# (B.bigNatFromWord# w)
+
+wordToBigNat2 :: Word# -> Word# -> BigNat
+wordToBigNat2 h l = BN# (B.bigNatFromWord2# h l)
+
+bigNatToInt :: BigNat -> Int#
+bigNatToInt (BN# b) = B.bigNatToInt# b
+
+bigNatToWord :: BigNat -> Word#
+bigNatToWord (BN# b) = B.bigNatToWord# b
+
+{-# DEPRECATED indexBigNat# "Use bigNatIndex# instead" #-}
+indexBigNat# :: BigNat -> GmpSize# -> GmpLimb#
+indexBigNat# (BN# b) i = B.bigNatIndex# b i
+
+{-# DEPRECATED importBigNatFromByteArray "Use bigNatFromByteArray# instead" #-}
+importBigNatFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> BigNat
+importBigNatFromByteArray ba off sz endian = case runRW# (B.bigNatFromByteArray# sz ba off endian) of
+ (# _, r #) -> BN# r
+
+{-# DEPRECATED exportBigNatToMutableByteArray "Use bigNatToMutableByteArray# instead" #-}
+exportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word
+exportBigNatToMutableByteArray (BN# ba) mba off endian = IO (\s -> case B.bigNatToMutableByteArray# ba mba off endian s of
+ (# s', r #) -> (# s', W# r #))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf8bb9e7855f680d850dd3ba22af0402b6b2f6df...d5c3a027ec0536bd4c36d99b4101aedf55a2d7d1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf8bb9e7855f680d850dd3ba22af0402b6b2f6df...d5c3a027ec0536bd4c36d99b4101aedf55a2d7d1
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/20200901/33e550d2/attachment-0001.html>
More information about the ghc-commits
mailing list