{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash, Rank2Types,
RecordWildCards, UnboxedTuples, UnliftedFFITypes #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Data.Text.Array
(
Array(Array, aBA)
, MArray(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
#if __GLASGOW_HASKELL__ >= 702
import Control.Monad.ST.Unsafe (unsafeIOToST)
#else
import Control.Monad.ST (unsafeIOToST)
#endif
import Data.Bits ((.&.), xor)
import Data.Text.Internal.Unsafe (inlinePerformIO)
import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
#if __GLASGOW_HASKELL__ >= 703
import Foreign.C.Types (CInt(CInt), CSize(CSize))
#else
import Foreign.C.Types (CInt, CSize)
#endif
import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
indexWord16Array#, newByteArray#,
unsafeFreezeByteArray#, writeWord16Array#)
import GHC.ST (ST(..), runST)
import GHC.Word (Word16(..))
import Prelude hiding (length, read)
data Array = Array {
Array -> ByteArray#
aBA :: ByteArray#
#if defined(ASSERTS)
, aLen :: {-# UNPACK #-} !Int
#endif
}
data MArray s = MArray {
MArray s -> MutableByteArray# s
maBA :: MutableByteArray# s
#if defined(ASSERTS)
, maLen :: {-# UNPACK #-} !Int
#endif
}
#if defined(ASSERTS)
class IArray a where
length :: a -> Int
instance IArray Array where
length = aLen
{-# INLINE length #-}
instance IArray (MArray s) where
length = maLen
{-# INLINE length #-}
#endif
new :: forall s. Int -> ST s (MArray s)
new :: Int -> ST s (MArray s)
new Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
highBit Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = ST s (MArray s)
forall a. a
array_size_error
| Bool
otherwise = STRep s (MArray s) -> ST s (MArray s)
forall s a. STRep s a -> ST s a
ST (STRep s (MArray s) -> ST s (MArray s))
-> STRep s (MArray s) -> ST s (MArray s)
forall a b. (a -> b) -> a -> b
$ \State# s
s1# ->
case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
len# State# s
s1# of
(# State# s
s2#, MutableByteArray# s
marr# #) -> (# State# s
s2#, MutableByteArray# s -> MArray s
forall s. MutableByteArray# s -> MArray s
MArray MutableByteArray# s
marr#
#if defined(ASSERTS)
n
#endif
#)
where !(I# Int#
len#) = Int -> Int
bytesInArray Int
n
highBit :: Int
highBit = Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` (Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
1)
{-# INLINE new #-}
array_size_error :: a
array_size_error :: a
array_size_error = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Text.Array.new: size overflow"
unsafeFreeze :: MArray s -> ST s Array
unsafeFreeze :: MArray s -> ST s Array
unsafeFreeze MArray{MutableByteArray# s
maBA :: MutableByteArray# s
maBA :: forall s. MArray s -> MutableByteArray# s
..} = STRep s Array -> ST s Array
forall s a. STRep s a -> ST s a
ST (STRep s Array -> ST s Array) -> STRep s Array -> ST s Array
forall a b. (a -> b) -> a -> b
$ \State# s
s1# ->
case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
maBA State# s
s1# of
(# State# s
s2#, ByteArray#
ba# #) -> (# State# s
s2#, ByteArray# -> Array
Array ByteArray#
ba#
#if defined(ASSERTS)
maLen
#endif
#)
{-# INLINE unsafeFreeze #-}
bytesInArray :: Int -> Int
bytesInArray :: Int -> Int
bytesInArray Int
n = Int
n Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
`shiftL` Int
1
{-# INLINE bytesInArray #-}
unsafeIndex :: Array -> Int -> Word16
unsafeIndex :: Array -> Int -> Word16
unsafeIndex Array{ByteArray#
aBA :: ByteArray#
aBA :: Array -> ByteArray#
..} i :: Int
i@(I# Int#
i#) =
CHECK_BOUNDS("unsafeIndex",aLen,i)
case ByteArray# -> Int# -> Word#
indexWord16Array# ByteArray#
aBA Int#
i# of Word#
r# -> (Word# -> Word16
W16# Word#
r#)
{-# INLINE unsafeIndex #-}
unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()
unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()
unsafeWrite MArray{MutableByteArray# s
maBA :: MutableByteArray# s
maBA :: forall s. MArray s -> MutableByteArray# s
..} i :: Int
i@(I# Int#
i#) (W16# Word#
e#) = STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (STRep s () -> ST s ()) -> STRep s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ \State# s
s1# ->
CHECK_BOUNDS("unsafeWrite",maLen,i)
case MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord16Array# MutableByteArray# s
maBA Int#
i# Word#
e# State# s
s1# of
State# s
s2# -> (# State# s
s2#, () #)
{-# INLINE unsafeWrite #-}
toList :: Array -> Int -> Int -> [Word16]
toList :: Array -> Int -> Int -> [Word16]
toList Array
ary Int
off Int
len = Int -> [Word16]
loop Int
0
where loop :: Int -> [Word16]
loop Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = Array -> Int -> Word16
unsafeIndex Array
ary (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) Word16 -> [Word16] -> [Word16]
forall a. a -> [a] -> [a]
: Int -> [Word16]
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
| Bool
otherwise = []
empty :: Array
empty :: Array
empty = (forall s. ST s Array) -> Array
forall a. (forall s. ST s a) -> a
runST (Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
new Int
0 ST s (MArray s) -> (MArray s -> ST s Array) -> ST s Array
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MArray s -> ST s Array
forall s. MArray s -> ST s Array
unsafeFreeze)
run :: (forall s. ST s (MArray s)) -> Array
run :: (forall s. ST s (MArray s)) -> Array
run forall s. ST s (MArray s)
k = (forall s. ST s Array) -> Array
forall a. (forall s. ST s a) -> a
runST (ST s (MArray s)
forall s. ST s (MArray s)
k ST s (MArray s) -> (MArray s -> ST s Array) -> ST s Array
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MArray s -> ST s Array
forall s. MArray s -> ST s Array
unsafeFreeze)
run2 :: (forall s. ST s (MArray s, a)) -> (Array, a)
run2 :: (forall s. ST s (MArray s, a)) -> (Array, a)
run2 forall s. ST s (MArray s, a)
k = (forall s. ST s (Array, a)) -> (Array, a)
forall a. (forall s. ST s a) -> a
runST (do
(MArray s
marr,a
b) <- ST s (MArray s, a)
forall s. ST s (MArray s, a)
k
Array
arr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
unsafeFreeze MArray s
marr
(Array, a) -> ST s (Array, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array
arr,a
b))
{-# INLINE run2 #-}
copyM :: MArray s
-> Int
-> MArray s
-> Int
-> Int
-> ST s ()
copyM :: MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
copyM MArray s
dest Int
didx MArray s
src Int
sidx Int
count
| Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise =
#if defined(ASSERTS)
assert (sidx + count <= length src) .
assert (didx + count <= length dest) .
#endif
IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST (IO () -> ST s ()) -> IO () -> ST s ()
forall a b. (a -> b) -> a -> b
$ MutableByteArray# s
-> CSize -> MutableByteArray# s -> CSize -> CSize -> IO ()
forall s.
MutableByteArray# s
-> CSize -> MutableByteArray# s -> CSize -> CSize -> IO ()
memcpyM (MArray s -> MutableByteArray# s
forall s. MArray s -> MutableByteArray# s
maBA MArray s
dest) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
didx)
(MArray s -> MutableByteArray# s
forall s. MArray s -> MutableByteArray# s
maBA MArray s
src) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sidx)
(Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count)
{-# INLINE copyM #-}
copyI :: MArray s
-> Int
-> Array
-> Int
-> Int
-> ST s ()
copyI :: MArray s -> Int -> Array -> Int -> Int -> ST s ()
copyI MArray s
dest Int
i0 Array
src Int
j0 Int
top
| Int
i0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
top = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST (IO () -> ST s ()) -> IO () -> ST s ()
forall a b. (a -> b) -> a -> b
$
MutableByteArray# s
-> CSize -> ByteArray# -> CSize -> CSize -> IO ()
forall s.
MutableByteArray# s
-> CSize -> ByteArray# -> CSize -> CSize -> IO ()
memcpyI (MArray s -> MutableByteArray# s
forall s. MArray s -> MutableByteArray# s
maBA MArray s
dest) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i0)
(Array -> ByteArray#
aBA Array
src) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j0)
(Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
topInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i0))
{-# INLINE copyI #-}
equal :: Array
-> Int
-> Array
-> Int
-> Int
-> Bool
equal :: Array -> Int -> Array -> Int -> Int -> Bool
equal Array
arrA Int
offA Array
arrB Int
offB Int
count = IO Bool -> Bool
forall a. IO a -> a
inlinePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
CInt
i <- ByteArray# -> CSize -> ByteArray# -> CSize -> CSize -> IO CInt
memcmp (Array -> ByteArray#
aBA Array
arrA) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offA)
(Array -> ByteArray#
aBA Array
arrB) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offB) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count)
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$! CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
{-# INLINE equal #-}
foreign import ccall unsafe "_hs_text_memcpy" memcpyI
:: MutableByteArray# s -> CSize -> ByteArray# -> CSize -> CSize -> IO ()
foreign import ccall unsafe "_hs_text_memcmp" memcmp
:: ByteArray# -> CSize -> ByteArray# -> CSize -> CSize -> IO CInt
foreign import ccall unsafe "_hs_text_memcpy" memcpyM
:: MutableByteArray# s -> CSize -> MutableByteArray# s -> CSize -> CSize
-> IO ()