module Data.Text.Array
(
Array(aBA)
, MArray(maBA)
, copyM
, copyI
, empty
, equal
#if defined(ASSERTS)
, length
#endif
, run
, run2
, toList
, unsafeFreeze
, unsafeIndex
, new
, unsafeWrite
) where
#if defined(ASSERTS)
# define CHECK_BOUNDS(_func_,_len_,_k_) \
if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else
#else
# define CHECK_BOUNDS(_func_,_len_,_k_)
#endif
#include "MachDeps.h"
#if defined(ASSERTS)
import Control.Exception (assert)
#endif
import Data.Bits ((.&.), xor)
import Data.Text.UnsafeShift (shiftL, shiftR)
import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
indexWord16Array#, indexWordArray#, newByteArray#,
readWord16Array#, readWordArray#, unsafeCoerce#,
writeWord16Array#, writeWordArray#)
import GHC.ST (ST(..), runST)
import GHC.Word (Word16(..), Word(..))
import Prelude hiding (length, read)
data Array = Array {
aBA :: ByteArray#
#if defined(ASSERTS)
, aLen :: !Int
#endif
}
data MArray s = MArray {
maBA :: MutableByteArray# s
#if defined(ASSERTS)
, maLen :: !Int
#endif
}
#if defined(ASSERTS)
class IArray a where
length :: a -> Int
instance IArray Array where
length = aLen
instance IArray (MArray s) where
length = maLen
#endif
new :: forall s. Int -> ST s (MArray s)
new n
| n < 0 || n .&. highBit /= 0 = error $ "Data.Text.Array.new: size overflow"
| otherwise = ST $ \s1# ->
case newByteArray# len# s1# of
(# s2#, marr# #) -> (# s2#, MArray marr#
#if defined(ASSERTS)
n
#endif
#)
where !(I# len#) = bytesInArray n
highBit = maxBound `xor` (maxBound `shiftR` 1)
unsafeFreeze :: MArray s -> ST s Array
unsafeFreeze MArray{..} = ST $ \s# ->
(# s#, Array (unsafeCoerce# maBA)
#if defined(ASSERTS)
maLen
#endif
#)
bytesInArray :: Int -> Int
bytesInArray n = n `shiftL` 1
unsafeIndex :: Array -> Int -> Word16
unsafeIndex Array{..} i@(I# i#) =
CHECK_BOUNDS("unsafeIndex",aLen,i)
case indexWord16Array# aBA i# of r# -> (W16# r#)
unsafeIndexWord :: Array -> Int -> Word
unsafeIndexWord Array{..} i@(I# i#) =
CHECK_BOUNDS("unsafeIndexWord",aLen`div`wordFactor,i)
case indexWordArray# aBA i# of r# -> (W# r#)
unsafeRead :: MArray s -> Int -> ST s Word16
unsafeRead MArray{..} i@(I# i#) = ST $ \s# ->
CHECK_BOUNDS("unsafeRead",maLen,i)
case readWord16Array# maBA i# s# of
(# s2#, r# #) -> (# s2#, W16# r# #)
unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()
unsafeWrite MArray{..} i@(I# i#) (W16# e#) = ST $ \s1# ->
CHECK_BOUNDS("unsafeWrite",maLen,i)
case writeWord16Array# maBA i# e# s1# of
s2# -> (# s2#, () #)
unsafeReadWord :: MArray s -> Int -> ST s Word
unsafeReadWord MArray{..} i@(I# i#) = ST $ \s# ->
CHECK_BOUNDS("unsafeRead64",maLen`div`wordFactor,i)
case readWordArray# maBA i# s# of
(# s2#, r# #) -> (# s2#, W# r# #)
unsafeWriteWord :: MArray s -> Int -> Word -> ST s ()
unsafeWriteWord MArray{..} i@(I# i#) (W# e#) = ST $ \s1# ->
CHECK_BOUNDS("unsafeWriteWord",maLen`div`wordFactor,i)
case writeWordArray# maBA i# e# s1# of
s2# -> (# s2#, () #)
toList :: Array -> Int -> Int -> [Word16]
toList ary off len = loop 0
where loop i | i < len = unsafeIndex ary (off+i) : loop (i+1)
| otherwise = []
empty :: Array
empty = runST (new 0 >>= unsafeFreeze)
run :: (forall s. ST s (MArray s)) -> Array
run k = runST (k >>= unsafeFreeze)
run2 :: (forall s. ST s (MArray s, a)) -> (Array, a)
run2 k = runST (do
(marr,b) <- k
arr <- unsafeFreeze marr
return (arr,b))
wordFactor :: Int
wordFactor = SIZEOF_HSWORD `shiftR` 1
wordAligned :: Int -> Bool
wordAligned i = i .&. (wordFactor 1) == 0
copyM :: MArray s
-> Int
-> MArray s
-> Int
-> Int
-> ST s ()
copyM dest didx src sidx count =
#if defined(ASSERTS)
assert (sidx + count <= length src) .
assert (didx + count <= length dest) $
#endif
if srem == 0 && drem == 0
then fast_loop 0
else slow_loop 0
where
(swidx,srem) = sidx `divMod` wordFactor
(dwidx,drem) = didx `divMod` wordFactor
nwds = count `div` wordFactor
fast_loop !i
| i >= nwds = slow_loop (i * wordFactor)
| otherwise = do w <- unsafeReadWord src (swidx+i)
unsafeWriteWord dest (dwidx+i) w
fast_loop (i+1)
slow_loop !i
| i >= count= return ()
| otherwise = do unsafeRead src (sidx+i) >>= unsafeWrite dest (didx+i)
slow_loop (i+1)
copyI :: MArray s
-> Int
-> Array
-> Int
-> Int
-> ST s ()
copyI dest i0 src j0 top
| wordAligned i0 && wordAligned j0 = fast (i0 `div` wordFactor) (j0 `div` wordFactor)
| otherwise = slow i0 j0
where
topwds = top `div` wordFactor
fast !i !j
| i >= topwds = slow (i * wordFactor) (j * wordFactor)
| otherwise = do unsafeWriteWord dest i (src `unsafeIndexWord` j)
fast (i+1) (j+1)
slow !i !j
| i >= top = return ()
| otherwise = do unsafeWrite dest i (src `unsafeIndex` j)
slow (i+1) (j+1)
equal :: Array
-> Int
-> Array
-> Int
-> Int
-> Bool
equal arrA offA arrB offB count
| wordAligned offA && wordAligned offB = fast 0
| otherwise = slow 0
where
countWords = count `div` wordFactor
fast !i
| i >= countWords = slow (i * wordFactor)
| a /= b = False
| otherwise = fast (i+1)
where a = unsafeIndexWord arrA (offAW+i)
b = unsafeIndexWord arrB (offBW+i)
offAW = offA `div` wordFactor
offBW = offB `div` wordFactor
slow !i
| i >= count = True
| a /= b = False
| otherwise = slow (i+1)
where a = unsafeIndex arrA (offA+i)
b = unsafeIndex arrB (offB+i)