module GHC.Num.WordArray where
import GHC.Prim
import GHC.Magic
import GHC.Types
import GHC.Num.Primitives
#include "MachDeps.h"
#include "WordSize.h"
default ()
type WordArray# = ByteArray#
type MutableWordArray# = MutableByteArray#
data WordArray = WordArray WordArray#
data MutableWordArray s = MutableWordArray (MutableWordArray# s)
wordsToBytes# :: Int# -> Int#
wordsToBytes# i = i `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#
bytesToWords# :: Int# -> Int#
bytesToWords# i = i `uncheckedIShiftRL#` WORD_SIZE_BYTES_SHIFT#
withNewWordArray#
:: Int#
-> (MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld)
-> WordArray#
withNewWordArray# sz act = case runRW# io of (# _, a #) -> a
where
io s =
case newWordArray# sz s of { (# s, mwa #) ->
case act mwa s of { s ->
unsafeFreezeByteArray# mwa s
}}
withNewWordArray2#
:: Int#
-> Int#
-> (MutableWordArray# RealWorld
-> MutableWordArray# RealWorld
-> State# RealWorld
-> State# RealWorld)
-> (# WordArray#, WordArray# #)
withNewWordArray2# sz1 sz2 act = case runRW# io of (# _, a #) -> a
where
io s =
case newWordArray# sz1 s of { (# s, mwa1 #) ->
case newWordArray# sz2 s of { (# s, mwa2 #) ->
case act mwa1 mwa2 s of { s ->
case unsafeFreezeByteArray# mwa1 s of { (# s, wa1 #) ->
case unsafeFreezeByteArray# mwa2 s of { (# s, wa2 #) ->
(# s, (# wa1, wa2 #) #)
}}}}}
newWordArray# :: Int# -> State# s -> (# State# s, MutableWordArray# s #)
newWordArray# sz s = newByteArray# (wordsToBytes# sz) s
withNewWordArrayTrimed#
:: Int#
-> (MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld)
-> WordArray#
withNewWordArrayTrimed# sz act = withNewWordArray# sz \mwa s ->
case act mwa s of
s' -> mwaTrimZeroes# mwa s'
withNewWordArray2Trimed#
:: Int#
-> Int#
-> (MutableWordArray# RealWorld
-> MutableWordArray# RealWorld
-> State# RealWorld
-> State# RealWorld)
-> (# WordArray#, WordArray# #)
withNewWordArray2Trimed# sz1 sz2 act = withNewWordArray2# sz1 sz2 \mwa1 mwa2 s ->
case act mwa1 mwa2 s of
s' -> case mwaTrimZeroes# mwa1 s' of
s'' -> mwaTrimZeroes# mwa2 s''
withNewWordArrayTrimedMaybe#
:: Int#
-> (MutableWordArray# RealWorld -> State# RealWorld -> (# State# RealWorld, Bool# #))
-> (# (# #) | WordArray# #)
withNewWordArrayTrimedMaybe# sz act = case runRW# io of (# _, a #) -> a
where
io s =
case newWordArray# sz s of
(# s, mwa #) -> case act mwa s of
(# s, 0# #) -> (# s, (# (# #) | #) #)
(# s, _ #) -> case mwaTrimZeroes# mwa s of
s -> case unsafeFreezeByteArray# mwa s of
(# s, ba #) -> (# s, (# | ba #) #)
wordArrayFromWord2# :: Word# -> Word# -> WordArray#
wordArrayFromWord2# h l =
withNewWordArray# 2# \mwa s ->
case mwaWrite# mwa 0# l s of
s -> mwaWrite# mwa 1# h s
wordArrayFromWord# :: Word# -> WordArray#
wordArrayFromWord# w =
withNewWordArray# 1# \mwa s ->
mwaWrite# mwa 0# w s
wordArraySize# :: WordArray# -> Int#
wordArraySize# ba = bytesToWords# (sizeofByteArray# ba)
mwaSize# :: MutableWordArray# s-> State# s -> (# State# s, Int# #)
mwaSize# mba s = case getSizeofMutableByteArray# mba s of
(# s2, sz #) -> (# s2, bytesToWords# sz #)
wordArrayLast# :: WordArray# -> Word#
wordArrayLast# a = indexWordArray# a (wordArraySize# a -# 1#)
mwaArrayCopy# :: MutableByteArray# s -> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
mwaArrayCopy# dst dstIdx src srcIdx n s
| isTrue# (n <=# 0#) = s
| True = copyByteArray#
src (wordsToBytes# srcIdx)
dst (wordsToBytes# dstIdx)
(wordsToBytes# n) s
mwaShrink# :: MutableByteArray# s -> Int# -> State# s -> State# s
mwaShrink# _mwa 0# s = s
mwaShrink# mwa i s =
case mwaSize# mwa s of
(# s, n #) -> shrinkMutableByteArray# mwa (wordsToBytes# (n -# i)) s
mwaSetSize# :: MutableByteArray# s -> Int# -> State# s -> State# s
mwaSetSize# mwa n s = shrinkMutableByteArray# mwa (wordsToBytes# n) s
mwaInitCopyShrink# :: MutableByteArray# s -> WordArray# -> State# s -> State# s
mwaInitCopyShrink# mwa wa s =
case mwaArrayCopy# mwa 0# wa 0# (wordArraySize# wa) s of
s -> mwaSetSize# mwa (wordArraySize# wa) s
mwaTrimZeroes# :: MutableByteArray# s -> State# s -> State# s
mwaTrimZeroes# mwa s1 =
case mwaClz mwa s1 of
(# s2, 0# #) -> s2
(# s2, c #) -> mwaShrink# mwa c s2
mwaClz :: MutableWordArray# s -> State# s -> (# State# s, Int# #)
mwaClz mwa s1 = case mwaSize# mwa s1 of
(# s2,sz #) -> mwaClzAt mwa (sz -# 1#) s2
mwaClzAt :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Int# #)
mwaClzAt mwa = go 0#
where
go c i s
| isTrue# (i <# 0#) = (# s, c #)
| True = case readWordArray# mwa i s of
(# s', 0## #) -> go (c +# 1#) (i -# 1#) s'
(# s', _ #) -> (# s', c #)
waClzAt :: WordArray# -> Int# -> Int#
waClzAt wa = go 0#
where
go c i
| isTrue# (i <# 0#)
= c
| 0## <- indexWordArray# wa i
= go (c +# 1#) (i -# 1#)
| True
= c
wordArrayCompareMSWords :: WordArray# -> WordArray# -> Ordering
wordArrayCompareMSWords wa wb
| 0# <- szA
, 0# <- szB
= EQ
| 0# <- szA
= LT
| 0# <- szB
= GT
| True
= go (szA -# 1#) (szB -# 1#)
where
szA = wordArraySize# wa
szB = wordArraySize# wb
go i j
| isTrue# (i <# 0#) = EQ
| isTrue# (j <# 0#) = EQ
| True =
let
a = indexWordArray# wa i
b = indexWordArray# wb j
in if | isTrue# (a `gtWord#` b) -> GT
| isTrue# (b `gtWord#` a) -> LT
| True -> go (i -# 1#) (j -# 1#)
mwaInitArrayPlusWord :: MutableWordArray# s -> WordArray# -> Word# -> State# s -> State#s
mwaInitArrayPlusWord mwa wa = go 0#
where
sz = wordArraySize# wa
go i carry s
| isTrue# (i ># sz) = s
| isTrue# (i ==# sz) = mwaWriteOrShrink mwa carry i s
| 0## <- carry =
case mwaArrayCopy# mwa i wa i (sz -# i) s of
s2 -> mwaShrink# mwa 1# s2
| True = let !(# l,c #) = addWordC# (indexWordArray# wa i) carry
in case mwaWrite# mwa i l s of
s2 -> go (i +# 1#) (int2Word# c) s2
mwaWriteOrShrink :: MutableWordArray# s -> Word# -> Int# -> State# s -> State# s
mwaWriteOrShrink mwa 0## _i s = mwaShrink# mwa 1# s
mwaWriteOrShrink mwa w i s = mwaWrite# mwa i w s
mwaWriteMostSignificant :: MutableWordArray# s -> Word# -> State# s -> State# s
mwaWriteMostSignificant mwa w s =
case mwaSize# mwa s of
(# s', sz #) -> mwaWriteOrShrink mwa w (sz -# 1#) s'
mwaInitArrayBinOp :: MutableWordArray# s -> WordArray# -> WordArray# -> (Word# -> Word# -> Word#) -> State# s -> State#s
mwaInitArrayBinOp mwa wa wb op s = go 0# s
where
!sz = minI# (wordArraySize# wa) (wordArraySize# wb)
go i s'
| isTrue# (i ==# sz) = s'
| True =
case indexWordArray# wa i `op` indexWordArray# wb i of
v -> case mwaWrite# mwa i v s' of
s'' -> go (i +# 1#) s''
mwaWrite# :: MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# = writeWordArray#
mwaFill# :: MutableWordArray# s -> Word# -> Word# -> Word# -> State# s -> State# s
mwaFill# _ _ _ 0## s = s
mwaFill# mwa v off n s = case mwaWrite# mwa (word2Int# off) v s of
s' -> mwaFill# mwa v (off `plusWord#` 1##) (n `minusWord#` 1##) s'
mwaAddInplaceWord# :: MutableWordArray# d -> Int# -> Word# -> State# d -> State# d
mwaAddInplaceWord# _ _ 0## s = s
mwaAddInplaceWord# mwa i y s = case readWordArray# mwa i s of
(# s1, x #) -> let !(# h,l #) = plusWord2# x y
in case mwaWrite# mwa i l s1 of
s2 -> mwaAddInplaceWord# mwa (i +# 1#) h s2
mwaSubInplaceWord#
:: MutableWordArray# d
-> Int#
-> Word#
-> State# d
-> (# State# d, Bool# #)
mwaSubInplaceWord# mwa ii iw s1 = case mwaSize# mwa s1 of
(# is, sz #) ->
let
go _ 0## s = (# s, 1# #)
go i y s
| isTrue# (i >=# sz) = (# s, 0# #)
| True = case readWordArray# mwa i s of
(# s1, x #) -> let !(# l,h #) = subWordC# x y
in case mwaWrite# mwa i l s1 of
s2 -> go (i +# 1#) (int2Word# h) s2
in go ii iw is
mwaTrimCompare :: Int# -> MutableWordArray# s -> WordArray# -> State# s -> (# State# s, Ordering #)
mwaTrimCompare k mwa wb s1
| (# s, szA #) <- mwaSize# mwa s1
, szB <- wordArraySize# wb
=
let
go i s
| isTrue# (i <# 0#) = (# s, EQ #)
| True = case readWordArray# mwa (i +# k) s of
(# s2, ai #) ->
let bi = if isTrue# (i >=# szB)
then 0##
else indexWordArray# wb i
in if | isTrue# (ai `gtWord#` bi) -> (# s2, GT #)
| isTrue# (bi `gtWord#` ai) -> (# s2, LT #)
| True -> go (i -# 1#) s2
szTrimA = szA -# k
in if | isTrue# (szTrimA <# szB) -> (# s, LT #)
| True -> go (szA -# k -# 1#) s
mwaSubInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> (# State# d, Bool# #)
mwaSubInplaceArray mwa off wb = go (wordArraySize# wb -# 1#)
where
go i s
| isTrue# (i <# 0#) = (# s, 1# #)
| True
= case mwaSubInplaceWord# mwa (off +# i) (indexWordArray# wb i) s of
(# s2, 1# #) -> go (i -# 1#) s2
(# s2, _ #) -> (# s2, 0# #)
mwaAddInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> State# d
mwaAddInplaceArray mwa off wb = go 0# 0##
where
!maxi = wordArraySize# wb
go i c s
| isTrue# (i ==# maxi) = mwaAddInplaceWord# mwa (i +# off) c s
| True
= case readWordArray# mwa (i +# off) s of
(# s, v #) -> case plusWord3# v (indexWordArray# wb i) c of
(# c', v' #) -> case writeWordArray# mwa (i +# off) v' s of
s -> go (i +# 1#) c' s
mwaSubInplaceMutableArray :: MutableWordArray# d -> Int# -> MutableWordArray# d -> State# d -> (# State# d, Bool# #)
mwaSubInplaceMutableArray mwa off mwb s0 =
case mwaSize# mwb s0 of
(# s1, szB #) -> go (szB -# 1#) s1
where
go i s
| isTrue# (i <# 0#) = (# s, 1# #)
| True
= case readWordArray# mwb i s of
(# s1, bi #) -> case mwaSubInplaceWord# mwa (off +# i) bi s1 of
(# s2, 1# #) -> go (i -# 1#) s2
(# s2, _ #) -> (# s2, 0# #)
mwaSubInplaceArrayTrim :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> State# d
mwaSubInplaceArrayTrim mwa off wb s =
case mwaSubInplaceArray mwa off wb s of
(# s', _ #) -> mwaTrimZeroes# mwa s'
mwaReadOrZero :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Word# #)
mwaReadOrZero mwa i s = case mwaSize# mwa s of
(# s2, sz #)
| isTrue# (i >=# sz) -> (# s2, 0## #)
| isTrue# (i <# 0#) -> (# s2, 0## #)
| True -> readWordArray# mwa i s2
mwaRead# :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Word# #)
mwaRead# = readWordArray#