[Git][ghc/ghc][master] 2 commits: Bignum: add backward compat integer-gmp functions
Marge Bot
gitlab at gitlab.haskell.org
Wed Aug 5 07:59:32 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
d613ed76 by Sylvain Henry at 2020-08-05T03:59:27-04:00
Bignum: add backward compat integer-gmp functions
Also enhance bigNatCheck# and isValidNatural test
- - - - -
3f2f7718 by Sylvain Henry at 2020-08-05T03:59:27-04:00
Bignum: add more BigNat compat functions in integer-gmp
- - - - -
5 changed files:
- libraries/base/tests/isValidNatural.hs
- libraries/base/tests/isValidNatural.stdout
- libraries/ghc-bignum/src/GHC/Num/BigNat.hs
- libraries/integer-gmp/integer-gmp.cabal
- libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
Changes:
=====================================
libraries/base/tests/isValidNatural.hs
=====================================
@@ -3,8 +3,16 @@
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# (# #)) -- 1 would fit into the NS constructor.
+main = do
+ let
+ maxWord = fromIntegral (maxBound :: Word)
+ invalid = NB (bigNatOne# (# #)) -- 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#
=====================================
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 #)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef2ae81a394df573510b12b7e11bba0c931249d8...3f2f771869c65125ba013a5dd2b213061efe0fc2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef2ae81a394df573510b12b7e11bba0c931249d8...3f2f771869c65125ba013a5dd2b213061efe0fc2
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/20200805/8d623a08/attachment-0001.html>
More information about the ghc-commits
mailing list