Commit 42244668 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

Reimplement im/export primitives for integer-gmp2

The import/export operations were available in `integer-gmp-0.5.1`
already, but need to be reimplemented from scratch for the
`integer-gmp-1.0.0` rewrite.

This also adds a few more operations than were previously available for
use w/ the `BigNat` type (which will be useful for implementing
serialisation for the upcoming `Natural` type)

Specifically, the following operations are (re)added (albeit with
slightly different type-signatures):

 - `sizeInBaseBigNat`
 - `sizeInBaseInteger`
 - `sizeInBaseWord#`

 - `exportBigNatToAddr`
 - `exportIntegerToAddr`
 - `exportWordToAddr`
 - `exportBigNatToMutableByteArray`
 - `exportIntegerToMutableByteArray`
 - `exportWordToMutableByteArray`

 - `importBigNatFromAddr`
 - `importIntegerFromAddr`
 - `importBigNatFromByteArray`
 - `importIntegerFromByteArray`

NOTE: The `integerGmpInternals` test-case is updated but not yet
      re-enabled as it contains tests for other primitives which aren't
      yet reimplemented.

This addresses #9281

Reviewed By: austin, duncan

Differential Revision: https://phabricator.haskell.org/D480
parent 7c748d9f
......@@ -288,3 +288,164 @@ integer_gmp_mpn_tdiv_r (mp_limb_t r[],
mpn_tdiv_qr(q, r, 0, n, nn, d, dn);
}
}
/* Wraps GMP's 'mpz_sizeinbase()' function */
HsWord
integer_gmp_mpn_sizeinbase(const mp_limb_t s[], const mp_size_t sn,
const HsInt base)
{
assert (2 <= base && base <= 256);
if (!sn) return 1;
const mpz_t zs = {{
._mp_alloc = sn,
._mp_size = sn,
._mp_d = (mp_limb_t*)s
}};
return mpz_sizeinbase(zs, base);
}
/* Single-limb version of 'integer_gmp_mpn_sizeinbase()' */
HsWord
integer_gmp_mpn_sizeinbase1(const mp_limb_t s, const HsInt base)
{
return s ? integer_gmp_mpn_sizeinbase(&s, 1, base) : 1;
}
/* Wrapper around GMP's 'mpz_export()' function */
HsWord
integer_gmp_mpn_export(const mp_limb_t s[], const mp_size_t sn,
void *destptr, HsInt destofs, HsInt msbf)
{
/* TODO: implement w/o GMP, c.f. 'integer_gmp_mpn_import()' */
assert (msbf == 0 || msbf == 1);
if (!sn || (sn == 1 && !s[0]))
return 0;
const mpz_t zs = {{
._mp_alloc = sn,
._mp_size = sn,
._mp_d = (mp_limb_t*)s
}};
size_t written = 0;
// mpz_export (void *rop, size_t *countp, int order, size_t size, int endian,
// size_t nails, const mpz_t op)
(void) mpz_export(((char *)destptr)+destofs, &written, !msbf ? -1 : 1,
/* size */ 1, /* endian */ 0, /* nails */ 0, zs);
return written;
}
/* Single-limb version of 'integer_gmp_mpn_export()' */
HsWord
integer_gmp_mpn_export1(const mp_limb_t s,
void *destptr, const HsInt destofs, const HsInt msbf)
{
/* TODO: implement w/o GMP */
return integer_gmp_mpn_export(&s, 1, destptr, destofs, msbf);
}
/* Import single limb from memory location
*
* We can't use GMP's 'mpz_import()'
*/
inline HsWord
integer_gmp_mpn_import1(const uint8_t *srcptr, const HsWord srcofs,
const HsWord srclen, const HsInt msbf)
{
assert (msbf == 0 || msbf == 1);
assert (srclen <= SIZEOF_HSWORD);
srcptr += srcofs;
HsWord result = 0;
if (msbf)
for (unsigned i = 0; i < srclen; ++i)
result |= (HsWord)srcptr[i] << ((srclen-i-1)*8);
else // lsbf
for (unsigned i = 0; i < srclen; ++i)
result |= (HsWord)srcptr[i] << (i*8);
return result;
}
/* import into mp_limb_t[] from memory location */
void
integer_gmp_mpn_import(mp_limb_t * restrict r, const uint8_t * restrict srcptr,
const HsWord srcofs, const HsWord srclen,
const HsInt msbf)
{
assert (msbf == 0 || msbf == 1);
srcptr += srcofs;
const unsigned limb_cnt_rem = srclen % SIZEOF_HSWORD;
const mp_size_t limb_cnt = srclen / SIZEOF_HSWORD;
if (msbf) {
if (limb_cnt_rem) { // partial limb
r[limb_cnt] = integer_gmp_mpn_import1(srcptr, 0, limb_cnt_rem, 1);
srcptr += limb_cnt_rem;
}
for (unsigned ri = 0; ri < limb_cnt; ++ri) {
r[limb_cnt-ri-1] = integer_gmp_mpn_import1(srcptr, 0, SIZEOF_HSWORD, 1);
srcptr += SIZEOF_HSWORD;
}
} else { // lsbf
for (unsigned ri = 0; ri < limb_cnt; ++ri) {
r[ri] = integer_gmp_mpn_import1(srcptr, 0, SIZEOF_HSWORD, 0);
srcptr += SIZEOF_HSWORD;
}
if (limb_cnt_rem) // partial limb
r[limb_cnt] = integer_gmp_mpn_import1(srcptr, 0, limb_cnt_rem, 0);
}
}
/* Scan for first non-zero byte starting at srcptr[srcofs], ending at
* srcptr[srcofs+srclen-1];
*
* If no non-zero byte found, returns srcofs+srclen; otherwise returns
* index of srcptr where first non-zero byte was found.
*/
HsWord
integer_gmp_scan_nzbyte(const uint8_t *srcptr,
const HsWord srcofs, const HsWord srclen)
{
// TODO: consider implementing this function in Haskell-land
srcptr += srcofs;
for (unsigned i = 0; i < srclen; ++i)
if (srcptr[i])
return srcofs+i;
return srcofs+srclen;
}
/* Reverse scan for non-zero byte
* starting at srcptr[srcofs+srclen-1], ending at srcptr[srcofs].
*
* Returns new length srclen1 such that srcptr[srcofs+i] == 0 for
* srclen1 <= i < srclen.
*/
HsWord
integer_gmp_rscan_nzbyte(const uint8_t *srcptr,
const HsWord srcofs, const HsWord srclen)
{
// TODO: consider implementing this function in Haskell-land
srcptr += srcofs;
for (unsigned i = srclen; i > 0; --i)
if (srcptr[i-1])
return i;
return 0;
}
......@@ -118,9 +118,163 @@ module GHC.Integer.GMP.Internals
-- * Miscellaneous GMP-provided operations
, gcdInt
-- * Import/export functions
-- ** Compute size of serialisation
, sizeInBaseBigNat
, sizeInBaseInteger
, sizeInBaseWord#
-- ** Export
, exportBigNatToAddr
, exportIntegerToAddr
, exportWordToAddr
, exportBigNatToMutableByteArray
, exportIntegerToMutableByteArray
, exportWordToMutableByteArray
-- ** Import
, importBigNatFromAddr
, importIntegerFromAddr
, importBigNatFromByteArray
, importIntegerFromByteArray
) where
import GHC.Integer.Type
import GHC.Integer
import GHC.Prim
import GHC.Types
default ()
-- | Compute number of digits (without sign) in given @/base/@.
--
-- This function wraps @mpz_sizeinbase()@ which has some
-- implementation pecularities to take into account:
--
-- * \"@'sizeInBaseInteger' 0 /base/ = 1@\"
-- (see also comment in 'exportIntegerToMutableByteArray').
--
-- * This function is only defined if @/base/ >= 2#@ and @/base/ <= 256#@
-- (Note: the documentation claims that only @/base/ <= 62#@ is
-- supported, however the actual implementation supports up to base 256).
--
-- * If @/base/@ is a power of 2, the result will be exact. In other
-- cases (e.g. for @/base/ = 10#@), the result /may/ be 1 digit too large
-- sometimes.
--
-- * \"@'sizeInBaseInteger' /i/ 2#@\" can be used to determine the most
-- significant bit of @/i/@.
--
-- /Since: 0.5.1.0/
sizeInBaseInteger :: Integer -> Int# -> Word#
sizeInBaseInteger (S# i#) = sizeInBaseWord# (int2Word# (absI# i#))
sizeInBaseInteger (Jp# bn) = sizeInBaseBigNat bn
sizeInBaseInteger (Jn# bn) = sizeInBaseBigNat bn
-- | Version of 'sizeInBaseInteger' operating on 'BigNat'
--
-- /Since: 1.0.0.0/
sizeInBaseBigNat :: BigNat -> Int# -> Word#
sizeInBaseBigNat bn@(BN# ba#) = c_mpn_sizeinbase# ba# (sizeofBigNat# bn)
foreign import ccall unsafe "integer_gmp_mpn_sizeinbase"
c_mpn_sizeinbase# :: ByteArray# -> GmpSize# -> Int# -> Word#
-- | Version of 'sizeInBaseInteger' operating on 'Word#'
--
-- /Since: 1.0.0.0/
foreign import ccall unsafe "integer_gmp_mpn_sizeinbase1"
sizeInBaseWord# :: Word# -> Int# -> Word#
-- | Dump 'Integer' (without sign) to @/addr/@ in base-256 representation.
--
-- @'exportIntegerToAddr' /i/ /addr/ /e/@
--
-- See description of 'exportIntegerToMutableByteArray' for more details.
--
-- /Since: 1.0.0.0/
exportIntegerToAddr :: Integer -> Addr# -> Int# -> IO Word
exportIntegerToAddr (S# i#) = exportWordToAddr (W# (int2Word# (absI# i#)))
exportIntegerToAddr (Jp# bn) = exportBigNatToAddr bn
exportIntegerToAddr (Jn# bn) = exportBigNatToAddr bn
-- | Version of 'exportIntegerToAddr' operating on 'BigNat's.
exportBigNatToAddr :: BigNat -> Addr# -> Int# -> IO Word
exportBigNatToAddr bn@(BN# ba#) addr e
= c_mpn_exportToAddr# ba# (sizeofBigNat# bn) addr 0# e
foreign import ccall unsafe "integer_gmp_mpn_export"
c_mpn_exportToAddr# :: ByteArray# -> GmpSize# -> Addr# -> Int# -> Int#
-> IO Word
-- | Version of 'exportIntegerToAddr' operating on 'Word's.
exportWordToAddr :: Word -> Addr# -> Int# -> IO Word
exportWordToAddr (W# w#) addr
= c_mpn_export1ToAddr# w# addr 0# -- TODO: we don't calling GMP for that
foreign import ccall unsafe "integer_gmp_mpn_export1"
c_mpn_export1ToAddr# :: GmpLimb# -> Addr# -> Int# -> Int#
-> IO Word
-- | Dump 'Integer' (without sign) to mutable byte-array in base-256
-- representation.
--
-- The call
--
-- @'exportIntegerToMutableByteArray' /i/ /mba/ /offset/ /msbf/@
--
-- writes
--
-- * the 'Integer' @/i/@
--
-- * into the 'MutableByteArray#' @/mba/@ starting at @/offset/@
--
-- * with most significant byte first if @msbf@ is @1#@ or least
-- significant byte first if @msbf@ is @0#@, and
--
-- * returns number of bytes written.
--
-- Use \"@'sizeInBaseInteger' /i/ 256#@\" to compute the exact number of
-- bytes written in advance for @/i/ /= 0@. In case of @/i/ == 0@,
-- 'exportIntegerToMutableByteArray' will write and report zero bytes
-- written, whereas 'sizeInBaseInteger' report one byte.
--
-- It's recommended to avoid calling 'exportIntegerToMutableByteArray' for small
-- integers as this function would currently convert those to big
-- integers in msbf to call @mpz_export()@.
--
-- /Since: 1.0.0.0/
exportIntegerToMutableByteArray :: Integer -> MutableByteArray# RealWorld
-> Word# -> Int# -> IO Word
exportIntegerToMutableByteArray (S# i#)
= exportWordToMutableByteArray (W# (int2Word# (absI# i#)))
exportIntegerToMutableByteArray (Jp# bn) = exportBigNatToMutableByteArray bn
exportIntegerToMutableByteArray (Jn# bn) = exportBigNatToMutableByteArray bn
-- | Version of 'exportIntegerToMutableByteArray' operating on 'BigNat's.
--
-- /Since: 1.0.0.0/
exportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word#
-> Int# -> IO Word
exportBigNatToMutableByteArray bn@(BN# ba#)
= c_mpn_exportToMutableByteArray# ba# (sizeofBigNat# bn)
foreign import ccall unsafe "integer_gmp_mpn_export"
c_mpn_exportToMutableByteArray# :: ByteArray# -> GmpSize#
-> MutableByteArray# RealWorld -> Word#
-> Int# -> IO Word
-- | Version of 'exportIntegerToMutableByteArray' operating on 'Word's.
--
-- /Since: 1.0.0.0/
exportWordToMutableByteArray :: Word -> MutableByteArray# RealWorld -> Word#
-> Int# -> IO Word
exportWordToMutableByteArray (W# w#) = c_mpn_export1ToMutableByteArray# w#
foreign import ccall unsafe "integer_gmp_mpn_export1"
c_mpn_export1ToMutableByteArray# :: GmpLimb# -> MutableByteArray# RealWorld
-> Word# -> Int# -> IO Word
......@@ -1559,6 +1559,105 @@ byteArrayToBigNat# ba# n0#
| isTrue# (neWord# (indexWordArray# ba# i#) 0##) = i# +# 1#
| True = fmssl (i# -# 1#)
-- | Read 'Integer' (without sign) from memory location at @/addr/@ in
-- base-256 representation.
--
-- @'importIntegerFromAddr' /addr/ /size/ /msbf/@
--
-- See description of 'importIntegerFromByteArray' for more details.
--
-- /Since: 1.0.0.0/
importIntegerFromAddr :: Addr# -> Word# -> Int# -> IO Integer
importIntegerFromAddr addr len msbf = IO $ do
bn <- liftIO (importBigNatFromAddr addr len msbf)
return (bigNatToInteger bn)
-- | Version of 'importIntegerFromAddr' constructing a 'BigNat'
importBigNatFromAddr :: Addr# -> Word# -> Int# -> IO BigNat
importBigNatFromAddr _ 0## _ = IO (\s -> (# s, zeroBigNat #))
importBigNatFromAddr addr len0 1# = IO $ do -- MSBF
W# ofs <- liftIO (c_scan_nzbyte_addr addr 0## len0)
let len = len0 `minusWord#` ofs
addr' = addr `plusAddr#` (word2Int# ofs)
importBigNatFromAddr# addr' len 1#
importBigNatFromAddr addr len0 _ = IO $ do -- LSBF
W# len <- liftIO (c_rscan_nzbyte_addr addr 0## len0)
importBigNatFromAddr# addr len 0#
foreign import ccall unsafe "integer_gmp_scan_nzbyte"
c_scan_nzbyte_addr :: Addr# -> Word# -> Word# -> IO Word
foreign import ccall unsafe "integer_gmp_rscan_nzbyte"
c_rscan_nzbyte_addr :: Addr# -> Word# -> Word# -> IO Word
-- | Helper for 'importBigNatFromAddr'
importBigNatFromAddr# :: Addr# -> Word# -> Int# -> S RealWorld BigNat
importBigNatFromAddr# _ 0## _ = return zeroBigNat
importBigNatFromAddr# addr len msbf = do
mbn@(MBN# mba#) <- newBigNat# n#
() <- liftIO (c_mpn_import_addr mba# addr 0## len msbf)
unsafeFreezeBigNat# mbn
where
-- n = ceiling(len / SIZEOF_HSWORD), i.e. number of limbs required
n# = (word2Int# len +# (SIZEOF_HSWORD# -# 1#)) `quotInt#` SIZEOF_HSWORD#
foreign import ccall unsafe "integer_gmp_mpn_import"
c_mpn_import_addr :: MutableByteArray# RealWorld -> Addr# -> Word# -> Word#
-> Int# -> IO ()
-- | Read 'Integer' (without sign) from byte-array in base-256 representation.
--
-- The call
--
-- @'importIntegerFromByteArray' /ba/ /offset/ /size/ /msbf/@
--
-- reads
--
-- * @/size/@ bytes from the 'ByteArray#' @/ba/@ starting at @/offset/@
--
-- * with most significant byte first if @/msbf/@ is @1#@ or least
-- significant byte first if @/msbf/@ is @0#@, and
--
-- * returns a new 'Integer'
--
-- /Since: 1.0.0.0/
importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer
importIntegerFromByteArray ba ofs len msbf
= bigNatToInteger (importBigNatFromByteArray ba ofs len msbf)
-- | Version of 'importIntegerFromByteArray' constructing a 'BigNat'
importBigNatFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> BigNat
importBigNatFromByteArray _ _ 0## _ = zeroBigNat
importBigNatFromByteArray ba ofs0 len0 1# = runS $ do -- MSBF
W# ofs <- liftIO (c_scan_nzbyte_bytearray ba ofs0 len0)
let len = (len0 `plusWord#` ofs0) `minusWord#` ofs
importBigNatFromByteArray# ba ofs len 1#
importBigNatFromByteArray ba ofs len0 _ = runS $ do -- LSBF
W# len <- liftIO (c_rscan_nzbyte_bytearray ba ofs len0)
importBigNatFromByteArray# ba ofs len 0#
foreign import ccall unsafe "integer_gmp_scan_nzbyte"
c_scan_nzbyte_bytearray :: ByteArray# -> Word# -> Word# -> IO Word
foreign import ccall unsafe "integer_gmp_rscan_nzbyte"
c_rscan_nzbyte_bytearray :: ByteArray# -> Word# -> Word# -> IO Word
-- | Helper for 'importBigNatFromByteArray'
importBigNatFromByteArray# :: ByteArray# -> Word# -> Word# -> Int#
-> S RealWorld BigNat
importBigNatFromByteArray# _ _ 0## _ = return zeroBigNat
importBigNatFromByteArray# ba ofs len msbf = do
mbn@(MBN# mba#) <- newBigNat# n#
() <- liftIO (c_mpn_import_bytearray mba# ba ofs len msbf)
unsafeFreezeBigNat# mbn
where
-- n = ceiling(len / SIZEOF_HSWORD), i.e. number of limbs required
n# = (word2Int# len +# (SIZEOF_HSWORD# -# 1#)) `quotInt#` SIZEOF_HSWORD#
foreign import ccall unsafe "integer_gmp_mpn_import"
c_mpn_import_bytearray :: MutableByteArray# RealWorld -> ByteArray# -> Word#
-> Word# -> Int# -> IO ()
-- | Test whether all internal invariants are satisfied by 'BigNat' value
--
-- Returns @1#@ if valid, @0#@ otherwise.
......
......@@ -9,7 +9,7 @@ import Control.Monad
import GHC.Word
import GHC.Base
import GHC.Integer.GMP.Internals (Integer(S#,J#))
import GHC.Integer.GMP.Internals (Integer(S#,Jp#,Jn#))
import qualified GHC.Integer.GMP.Internals as I
gcdExtInteger :: Integer -> Integer -> (Integer, Integer)
......@@ -19,18 +19,16 @@ powInteger :: Integer -> Word -> Integer
powInteger b (W# w#) = I.powInteger b w#
exportInteger :: Integer -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word
exportInteger i mba o e = IO $ \s -> case I.exportIntegerToMutableByteArray i mba o e s of
(# s', l #) -> (# s', W# l #)
exportInteger = I.exportIntegerToMutableByteArray
exportIntegerAddr :: Integer -> Addr# -> Int# -> IO Word
exportIntegerAddr i a e = IO $ \s -> case I.exportIntegerToAddr i a e s of
(# s', l #) -> (# s', W# l #)
exportIntegerAddr = I.exportIntegerToAddr
importInteger :: ByteArray# -> Word# -> Word# -> Int# -> Integer
importInteger = I.importIntegerFromByteArray
importIntegerAddr :: Addr# -> Word# -> Int# -> IO Integer
importIntegerAddr a l e = IO $ \s -> case I.importIntegerFromAddr a l e s of
(# s', i #) -> (# s', i #)
importIntegerAddr a l e = I.importIntegerFromAddr a l e
{- Reference implementation for 'powModInteger'
......@@ -109,41 +107,41 @@ main = do
let a = byteArrayContents# (unsafeCoerce# mba)
print =<< importIntegerAddr a 0## 1#
print =<< importIntegerAddr a 0## -1#
print =<< importIntegerAddr a 0## 0#
print =<< importIntegerAddr (plusAddr# a 22#) 1## 1#
print =<< importIntegerAddr (plusAddr# a 97#) 1## -1#
print =<< importIntegerAddr (plusAddr# a 22#) 1## 1#
print =<< importIntegerAddr (plusAddr# a 97#) 1## 0#
print =<< importIntegerAddr a 23## 1#
print =<< importIntegerAddr a 23## -1#
print =<< importIntegerAddr a 23## 0#
-- no-op
print =<< exportIntegerAddr 0 (plusAddr# a 0#) 1#
-- write into array
print =<< exportIntegerAddr b (plusAddr# a 5#) 1#
print =<< exportIntegerAddr e (plusAddr# a 50#) -1#
print =<< exportIntegerAddr b (plusAddr# a 5#) 1#
print =<< exportIntegerAddr e (plusAddr# a 50#) 0#
print =<< exportInteger m mba 85## 1#
print =<< exportInteger m mba 105## -1#
print =<< exportInteger m mba 105## 0#
print =<< importIntegerAddr (plusAddr# a 85#) 17## 1#
print =<< importIntegerAddr (plusAddr# a 105#) 17## -1#
print =<< importIntegerAddr (plusAddr# a 105#) 17## 0#
-- read back full array
print =<< importIntegerAddr a 128## 1#
print =<< importIntegerAddr a 128## -1#
print =<< importIntegerAddr a 128## 0#
freezeByteArray mba
print $ importInteger ba 0## 0## 1#
print $ importInteger ba 0## 0## -1#
print $ importInteger ba 0## 0## 0#
print $ importInteger ba 5## 29## 1#
print $ importInteger ba 50## 29## -1#
print $ importInteger ba 50## 29## 0#
print $ importInteger ba 0## 128## 1#
print $ importInteger ba 0## 128## -1#
print $ importInteger ba 0## 128## 0#
return ()
where
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment