From d613ed7624cbf39192d2a8cf29ab0c0fd2980a15 Mon Sep 17 00:00:00 2001
From: Sylvain Henry <sylvain@haskus.fr>
Date: Thu, 30 Jul 2020 17:30:09 +0200
Subject: Bignum: add backward compat integer-gmp functions

Also enhance bigNatCheck# and isValidNatural test
---
 libraries/base/tests/isValidNatural.hs             | 16 +++++++++++----
 libraries/base/tests/isValidNatural.stdout         |  2 +-
 libraries/ghc-bignum/src/GHC/Num/BigNat.hs         |  4 ++++
 .../integer-gmp/src/GHC/Integer/GMP/Internals.hs   | 24 ++++++++++++++++++++++
 4 files changed, 41 insertions(+), 5 deletions(-)

diff --git a/libraries/base/tests/isValidNatural.hs b/libraries/base/tests/isValidNatural.hs
index cd2ae4a9fc..a9b48c82e2 100644
--- a/libraries/base/tests/isValidNatural.hs
+++ b/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]
diff --git a/libraries/base/tests/isValidNatural.stdout b/libraries/base/tests/isValidNatural.stdout
index ccb5c6c2d0..b61d30517b 100644
--- a/libraries/base/tests/isValidNatural.stdout
+++ b/libraries/base/tests/isValidNatural.stdout
@@ -1 +1 @@
-[True,True,True,True,False]
+[True,True,True,True,False,False]
diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
index 4aeedafc9d..8b5b4d31e3 100644
--- a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
+++ b/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#
 
diff --git a/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs b/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
index f754e42862..ebd0e0f6d7 100644
--- a/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
+++ b/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
@@ -42,12 +42,20 @@ module GHC.Integer.GMP.Internals
     , GmpLimb, GmpLimb#
     , GmpSize, GmpSize#
 
+      -- **
+
+    , isValidBigNat#
+    , sizeofBigNat#
+    , zeroBigNat
+    , oneBigNat
+
     ) 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 GHC.Types
 import GHC.Prim
 
@@ -112,3 +120,19 @@ 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
-- 
cgit v1.2.1