Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- type WordArray# = ByteArray#
- type MutableWordArray# = MutableByteArray#
- data WordArray = WordArray WordArray#
- data MutableWordArray s = MutableWordArray (MutableWordArray# s)
- wordsToBytes# :: Int# -> Int#
- bytesToWords# :: Int# -> Int#
- withNewWordArray# :: Int# -> (MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld) -> WordArray#
- withNewWordArray2# :: Int# -> Int# -> (MutableWordArray# RealWorld -> MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld) -> (# WordArray#, WordArray# #)
- newWordArray# :: Int# -> State# s -> (# State# s, MutableWordArray# s #)
- withNewWordArrayTrimed# :: Int# -> (MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld) -> WordArray#
- withNewWordArray2Trimed# :: Int# -> Int# -> (MutableWordArray# RealWorld -> MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld) -> (# WordArray#, WordArray# #)
- withNewWordArrayTrimedMaybe# :: Int# -> (MutableWordArray# RealWorld -> State# RealWorld -> (# State# RealWorld, Bool# #)) -> (# (# #) | WordArray# #)
- wordArrayFromWord2# :: Word# -> Word# -> WordArray#
- wordArrayFromWord# :: Word# -> WordArray#
- wordArraySize# :: WordArray# -> Int#
- mwaSize# :: MutableWordArray# s -> State# s -> (# State# s, Int# #)
- wordArrayLast# :: WordArray# -> Word#
- mwaArrayCopy# :: MutableByteArray# s -> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
- mwaShrink# :: MutableByteArray# s -> Int# -> State# s -> State# s
- mwaSetSize# :: MutableByteArray# s -> Int# -> State# s -> State# s
- mwaInitCopyShrink# :: MutableByteArray# s -> WordArray# -> State# s -> State# s
- mwaTrimZeroes# :: MutableByteArray# s -> State# s -> State# s
- mwaClz :: MutableWordArray# s -> State# s -> (# State# s, Int# #)
- mwaClzAt :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Int# #)
- waClzAt :: WordArray# -> Int# -> Int#
- wordArrayCompareMSWords :: WordArray# -> WordArray# -> Ordering
- mwaInitArrayPlusWord :: MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
- mwaWriteOrShrink :: MutableWordArray# s -> Word# -> Int# -> State# s -> State# s
- mwaWriteMostSignificant :: MutableWordArray# s -> Word# -> State# s -> State# s
- mwaInitArrayBinOp :: MutableWordArray# s -> WordArray# -> WordArray# -> (Word# -> Word# -> Word#) -> State# s -> State# s
- mwaWrite# :: MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
- mwaFill# :: MutableWordArray# s -> Word# -> Word# -> Word# -> State# s -> State# s
- mwaAddInplaceWord# :: MutableWordArray# d -> Int# -> Word# -> State# d -> State# d
- mwaSubInplaceWord# :: MutableWordArray# d -> Int# -> Word# -> State# d -> (# State# d, Bool# #)
- mwaTrimCompare :: Int# -> MutableWordArray# s -> WordArray# -> State# s -> (# State# s, Ordering #)
- mwaSubInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> (# State# d, Bool# #)
- mwaAddInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> State# d
- mwaSubInplaceMutableArray :: MutableWordArray# d -> Int# -> MutableWordArray# d -> State# d -> (# State# d, Bool# #)
- mwaSubInplaceArrayTrim :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> State# d
- mwaReadOrZero :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Word# #)
- mwaRead# :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Word# #)
Documentation
type WordArray# = ByteArray# Source #
Unlifted array of Word
data MutableWordArray s Source #
wordsToBytes# :: Int# -> Int# Source #
Convert limb count into byte count
bytesToWords# :: Int# -> Int# Source #
Convert byte count into limb count
:: Int# | Size in Word |
-> (MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld) | |
-> WordArray# |
Create a new WordArray# of the given size (*in Word#*) and apply the action to it before returning it frozen
:: Int# | Size in Word |
-> Int# | Ditto |
-> (MutableWordArray# RealWorld -> MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld) | |
-> (# WordArray#, WordArray# #) |
Create two new WordArray# of the given sizes (*in Word#*) and apply the action to them before returning them frozen
newWordArray# :: Int# -> State# s -> (# State# s, MutableWordArray# s #) Source #
Create a new WordArray#
withNewWordArrayTrimed# Source #
:: Int# | Size in Word |
-> (MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld) | |
-> WordArray# |
Create a new WordArray# of the given size (*in Word#*), apply the action to it, trim its most significant zeroes, then return it frozen
withNewWordArray2Trimed# Source #
:: Int# | Size in Word |
-> Int# | Ditto |
-> (MutableWordArray# RealWorld -> MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld) | |
-> (# WordArray#, WordArray# #) |
Create two new WordArray# of the given sizes (*in Word#*), apply the action to them, trim their most significant zeroes, then return them frozen
withNewWordArrayTrimedMaybe# Source #
:: Int# | Size in Word |
-> (MutableWordArray# RealWorld -> State# RealWorld -> (# State# RealWorld, Bool# #)) | |
-> (# (# #) | WordArray# #) |
Create a new WordArray# of the given size (*in Word#*), apply the action to it. If the action returns true#, trim its most significant zeroes, then return it frozen. Otherwise, return ().
wordArrayFromWord2# :: Word# -> Word# -> WordArray# Source #
Create a WordArray# from two Word#
`wordArrayFromWord2# h l where h is the most significant word l is the least significant word
wordArrayFromWord# :: Word# -> WordArray# Source #
Create a WordArray# from one Word#
wordArraySize# :: WordArray# -> Int# Source #
Word array size
mwaSize# :: MutableWordArray# s -> State# s -> (# State# s, Int# #) Source #
Equality test for WordArray#
Get size in Words
wordArrayLast# :: WordArray# -> Word# Source #
Get the last Word (must be non empty!)
mwaArrayCopy# :: MutableByteArray# s -> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s Source #
Copy Words from a WordArray
Don't do anything if the number of words to copy is <= 0
mwaShrink# :: MutableByteArray# s -> Int# -> State# s -> State# s Source #
Shrink last words of a WordArray
mwaSetSize# :: MutableByteArray# s -> Int# -> State# s -> State# s Source #
Set size
mwaInitCopyShrink# :: MutableByteArray# s -> WordArray# -> State# s -> State# s Source #
Copy the WordArray into the MWA and shrink the size of MWA to the one of the WordArray
mwaTrimZeroes# :: MutableByteArray# s -> State# s -> State# s Source #
Trim ending zeroes
mwaClzAt :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Int# #) Source #
Count leading zero Words starting at given position
wordArrayCompareMSWords :: WordArray# -> WordArray# -> Ordering Source #
Compare the most signiciant limbs of a and b. The comparison stops (i.e. returns EQ) when there isn't enough lims in a or b to perform another comparison.
mwaInitArrayPlusWord :: MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s Source #
Compute MutableWordArray <- WordArray + Word
The MutableWordArray may not be initialized and will be erased anyway.
Input: Size(MutableWordArray) = Size(WordArray) + 1 Output: Size(MutableWordArray) = Size(WordArray) [+ 1]
mwaWriteOrShrink :: MutableWordArray# s -> Word# -> Int# -> State# s -> State# s Source #
Write the most-significant Word: * if it is 0: shrink the array of 1 Word * otherwise: write it
mwaWriteMostSignificant :: MutableWordArray# s -> Word# -> State# s -> State# s Source #
Compute the index of the most-significant Word and write it.
mwaInitArrayBinOp :: MutableWordArray# s -> WordArray# -> WordArray# -> (Word# -> Word# -> Word#) -> State# s -> State# s Source #
MutableWordArray <- zipWith op wa1 wa2
Required output: Size(MutableWordArray) = min Size(wa1) Size(wa2)
mwaWrite# :: MutableWordArray# s -> Int# -> Word# -> State# s -> State# s Source #
Write an element of the MutableWordArray
mwaFill# :: MutableWordArray# s -> Word# -> Word# -> Word# -> State# s -> State# s Source #
Fill some part of a MutableWordArray with the given Word#
mwaAddInplaceWord# :: MutableWordArray# d -> Int# -> Word# -> State# d -> State# d Source #
Add Word# inplace (a the specified offset) in the mwa with carry propagation.
mwaSubInplaceWord# :: MutableWordArray# d -> Int# -> Word# -> State# d -> (# State# d, Bool# #) Source #
Sub Word# inplace (at the specified offset) in the mwa with carry propagation.
Return False# on underflow
mwaTrimCompare :: Int# -> MutableWordArray# s -> WordArray# -> State# s -> (# State# s, Ordering #) Source #
Trim a
of k
less significant limbs and then compare the result with b
"mwa" doesn't need to be trimmed
mwaSubInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> (# State# d, Bool# #) Source #
Sub array inplace (at the specified offset) in the mwa with carry propagation.
We don't trim the resulting array!
Return False# on underflow.
mwaAddInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> State# d Source #
Add array inplace (a the specified offset) in the mwa with carry propagation.
Upper bound of the result mutable aray is not checked against overflow.
mwaSubInplaceMutableArray :: MutableWordArray# d -> Int# -> MutableWordArray# d -> State# d -> (# State# d, Bool# #) Source #
Sub array inplace (at the specified offset) in the mwa with carry propagation.
We don't trim the resulting array!
Return False# on underflow.
mwaSubInplaceArrayTrim :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> State# d Source #
Sub an array inplace and then trim zeroes
Don't check overflow. The caller must ensure that a>=b
mwaReadOrZero :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Word# #) Source #
Read an indexed Word in the MutableWordArray. If the index is out-of-bound, return zero.