Skip to content
Snippets Groups Projects
Commit 22c23c6b authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel :man_dancing:
Browse files

Rename `{import,export}Integer`


This renames to more verbose names which include the type these
operations import/export from/to:

 - `importIntegerFromByteArray`, and
 - `exportIntegerToMutableByteArray`.

This follows the naming convention used for other primitive operations,
such as the recently added `copyMutableByteArrayToAddr` operation.

Signed-off-by: Herbert Valerio Riedel's avatarHerbert Valerio Riedel <hvr@gnu.org>
parent dfd65a28
No related branches found
No related tags found
No related merge requests found
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
module GHC.Integer.GMP.Internals (Integer(..), gcdInt, gcdInteger, gcdExtInteger, lcmInteger, powInteger, powModInteger, powModSecInteger, recipModInteger, nextPrimeInteger, testPrimeInteger, sizeInBaseInteger, importInteger, exportInteger) module GHC.Integer.GMP.Internals (Integer(..), gcdInt, gcdInteger, gcdExtInteger, lcmInteger, powInteger, powModInteger, powModSecInteger, recipModInteger, nextPrimeInteger, testPrimeInteger, sizeInBaseInteger, importIntegerFromByteArray, exportIntegerToMutableByteArray)
where where
import GHC.Integer.Type import GHC.Integer.Type
......
...@@ -50,8 +50,8 @@ module GHC.Integer.GMP.Prim ( ...@@ -50,8 +50,8 @@ module GHC.Integer.GMP.Prim (
testPrimeInteger#, testPrimeInteger#,
sizeInBaseInteger#, sizeInBaseInteger#,
exportInteger#, exportIntegerToMutableByteArray#,
importInteger#, importIntegerFromByteArray#,
#if WORD_SIZE_IN_BITS < 64 #if WORD_SIZE_IN_BITS < 64
int64ToInteger#, integerToInt64#, int64ToInteger#, integerToInt64#,
...@@ -231,12 +231,12 @@ foreign import prim "integer_cmm_sizeInBasezh" sizeInBaseInteger# ...@@ -231,12 +231,12 @@ foreign import prim "integer_cmm_sizeInBasezh" sizeInBaseInteger#
-- | -- |
-- --
foreign import prim "integer_cmm_exportIntegerzh" exportInteger# foreign import prim "integer_cmm_exportIntegerToMutableByteArrayzh" exportIntegerToMutableByteArray#
:: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #)
-- | -- |
-- --
foreign import prim "integer_cmm_importIntegerzh" importInteger# foreign import prim "integer_cmm_importIntegerFromByteArrayzh" importIntegerFromByteArray#
:: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray# #) :: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray# #)
-- | -- |
......
...@@ -47,7 +47,7 @@ import GHC.Integer.GMP.Prim ( ...@@ -47,7 +47,7 @@ import GHC.Integer.GMP.Prim (
testBitInteger#, mul2ExpInteger#, fdivQ2ExpInteger#, testBitInteger#, mul2ExpInteger#, fdivQ2ExpInteger#,
powInteger#, powModInteger#, powModSecInteger#, recipModInteger#, powInteger#, powModInteger#, powModSecInteger#, recipModInteger#,
nextPrimeInteger#, testPrimeInteger#, nextPrimeInteger#, testPrimeInteger#,
sizeInBaseInteger#, exportInteger#, importInteger#, sizeInBaseInteger#, exportIntegerToMutableByteArray#, importIntegerFromByteArray#,
#if WORD_SIZE_IN_BITS < 64 #if WORD_SIZE_IN_BITS < 64
int64ToInteger#, integerToInt64#, int64ToInteger#, integerToInt64#,
word64ToInteger#, integerToWord64#, word64ToInteger#, integerToWord64#,
...@@ -686,7 +686,7 @@ nextPrimeInteger (J# s d) = case nextPrimeInteger# s d of (# s', d' #) -> J# s' ...@@ -686,7 +686,7 @@ nextPrimeInteger (J# s d) = case nextPrimeInteger# s d of (# s', d' #) -> J# s'
-- This function wraps @mpz_sizeinbase()@ which has some -- This function wraps @mpz_sizeinbase()@ which has some
-- implementation pecularities to take into account: -- implementation pecularities to take into account:
-- --
-- * @sizeInBaseInteger 0 base = 1@ (see also comment in 'exportInteger'). -- * @sizeInBaseInteger 0 base = 1@ (see also comment in 'exportIntegerToMutableByteArray').
-- --
-- * This function is only defined if @base >= 2#@ and @base <= 256#@ -- * This function is only defined if @base >= 2#@ and @base <= 256#@
-- (Note: the documentation claims that only @base <= 62#@ is -- (Note: the documentation claims that only @base <= 62#@ is
...@@ -705,7 +705,7 @@ sizeInBaseInteger (J# s d) b = sizeInBaseInteger# s d b ...@@ -705,7 +705,7 @@ sizeInBaseInteger (J# s d) b = sizeInBaseInteger# s d b
-- | Dump 'Integer' (without sign) to mutable byte-array in base-256 representation. -- | Dump 'Integer' (without sign) to mutable byte-array in base-256 representation.
-- --
-- The call @exportInteger i mba offset order@ writes -- The call @exportIntegerToMutableByteArray i mba offset order@ writes
-- --
-- * the 'Integer' @i@ -- * the 'Integer' @i@
-- --
...@@ -718,20 +718,20 @@ sizeInBaseInteger (J# s d) b = sizeInBaseInteger# s d b ...@@ -718,20 +718,20 @@ sizeInBaseInteger (J# s d) b = sizeInBaseInteger# s d b
-- --
-- Use @sizeInBaseInteger i 256#@ to compute the exact number of bytes -- Use @sizeInBaseInteger i 256#@ to compute the exact number of bytes
-- written in advance for @i /= 0@. In case of @i == 0@, -- written in advance for @i /= 0@. In case of @i == 0@,
-- 'exportInteger' will write and report zero bytes written, whereas -- 'exportIntegerToMutableByteArray' will write and report zero bytes written, whereas
-- 'sizeInBaseInteger' report one byte. -- 'sizeInBaseInteger' report one byte.
-- --
-- It's recommended to avoid calling 'exportInteger' for small -- It's recommended to avoid calling 'exportIntegerToMutableByteArray' for small
-- integers as this function would currently convert those to big -- integers as this function would currently convert those to big
-- integers in order to call @mpz_export()@. -- integers in order to call @mpz_export()@.
{-# NOINLINE exportInteger #-} {-# NOINLINE exportIntegerToMutableByteArray #-}
exportInteger :: Integer -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) exportIntegerToMutableByteArray :: Integer -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #)
exportInteger j@(S# _) mba o e = exportInteger (toBig j) mba o e -- TODO exportIntegerToMutableByteArray j@(S# _) mba o e = exportIntegerToMutableByteArray (toBig j) mba o e -- TODO
exportInteger (J# s d) mba o e = exportInteger# s d mba o e exportIntegerToMutableByteArray (J# s d) mba o e = exportIntegerToMutableByteArray# s d mba o e
-- | Read 'Integer' (without sign) from byte-array in base-256 representation. -- | Read 'Integer' (without sign) from byte-array in base-256 representation.
-- --
-- The call @importInteger ba offset size order@ reads -- The call @importIntegerFromByteArray ba offset size order@ reads
-- --
-- * @size@ bytes from the 'ByteArray#' @mba@ starting at @offset@ -- * @size@ bytes from the 'ByteArray#' @mba@ starting at @offset@
-- --
...@@ -740,12 +740,12 @@ exportInteger (J# s d) mba o e = exportInteger# s d mba o e ...@@ -740,12 +740,12 @@ exportInteger (J# s d) mba o e = exportInteger# s d mba o e
-- --
-- * returns a new 'Integer' -- * returns a new 'Integer'
-- --
-- It's recommended to avoid calling 'importInteger' for known to be -- It's recommended to avoid calling 'importIntegerFromByteArray' for known to be
-- small integers as this function currently always returns a big -- small integers as this function currently always returns a big
-- integer even if it would fit into a small integer. -- integer even if it would fit into a small integer.
{-# NOINLINE importInteger #-} {-# NOINLINE importIntegerFromByteArray #-}
importInteger :: ByteArray# -> Word# -> Word# -> Int# -> Integer importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer
importInteger ba o l e = case importInteger# ba o l e of (# s', d' #) -> J# s' d' importIntegerFromByteArray ba o l e = case importIntegerFromByteArray# ba o l e of (# s', d' #) -> J# s' d'
\end{code} \end{code}
......
...@@ -69,7 +69,7 @@ import "integer-gmp" integer_cbits_decodeDouble; ...@@ -69,7 +69,7 @@ import "integer-gmp" integer_cbits_decodeDouble;
the case for all the platforms that GHC supports, currently. the case for all the platforms that GHC supports, currently.
-------------------------------------------------------------------------- */ -------------------------------------------------------------------------- */
integer_cmm_importIntegerzh (P_ ba, W_ of, W_ sz, W_ e) integer_cmm_importIntegerFromByteArrayzh (P_ ba, W_ of, W_ sz, W_ e)
{ {
W_ src_ptr; W_ src_ptr;
W_ mp_result; W_ mp_result;
...@@ -90,7 +90,7 @@ again: ...@@ -90,7 +90,7 @@ again:
} }
/* :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) */ /* :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) */
integer_cmm_exportIntegerzh (W_ s1, P_ d1, P_ mba, W_ of, W_ e) integer_cmm_exportIntegerToMutableByteArrayzh (W_ s1, P_ d1, P_ mba, W_ of, W_ e)
{ {
W_ dst_ptr; W_ dst_ptr;
W_ mp_tmp; W_ mp_tmp;
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment