{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE BangPatterns #-}
module Data.ByteString.Short.Internal where
import Prelude hiding
( length )
import qualified Data.Word16 as W16
import GHC.Exts
import GHC.Word
import GHC.ST
( ST (ST) )
import qualified Data.List as List
#if !MIN_VERSION_base(4,13,0)
import Foreign.C.String hiding (newCWString)
import Foreign.C.Types
import Foreign.Storable
import Foreign.Marshal.Alloc
#endif
import Foreign.Marshal.Array (withArray0, peekArray0, newArray0, withArrayLen, peekArray)
import "bytestring" Data.ByteString.Short.Internal
import Control.Exception ( throwIO )
import Control.Monad.ST
create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
create Int
len forall s. MBA s -> ST s ()
fill =
(forall s. ST s ShortByteString) -> ShortByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ShortByteString) -> ShortByteString)
-> (forall s. ST s ShortByteString) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ do
MBA s
mba <- Int -> ST s (MBA s)
forall s. Int -> ST s (MBA s)
newByteArray Int
len
MBA s -> ST s ()
forall s. MBA s -> ST s ()
fill MBA s
mba
BA# ByteArray#
ba# <- MBA s -> ST s BA
forall s. MBA s -> ST s BA
unsafeFreezeByteArray MBA s
mba
ShortByteString -> ST s ShortByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteArray# -> ShortByteString
SBS ByteArray#
ba#)
{-# INLINE create #-}
asBA :: ShortByteString -> BA
asBA :: ShortByteString -> BA
asBA (SBS ByteArray#
ba#) = ByteArray# -> BA
BA# ByteArray#
ba#
data BA = BA# ByteArray#
data MBA s = MBA# (MutableByteArray# s)
newPinnedByteArray :: Int -> ST s (MBA s)
newPinnedByteArray :: Int -> ST s (MBA s)
newPinnedByteArray (I# Int#
len#) =
STRep s (MBA s) -> ST s (MBA s)
forall s a. STRep s a -> ST s a
ST (STRep s (MBA s) -> ST s (MBA s))
-> STRep s (MBA s) -> ST s (MBA s)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# Int#
len# State# s
s of
(# State# s
s', MutableByteArray# s
mba# #) -> (# State# s
s', MutableByteArray# s -> MBA s
forall s. MutableByteArray# s -> MBA s
MBA# MutableByteArray# s
mba# #)
newByteArray :: Int -> ST s (MBA s)
newByteArray :: Int -> ST s (MBA s)
newByteArray (I# Int#
len#) =
STRep s (MBA s) -> ST s (MBA s)
forall s a. STRep s a -> ST s a
ST (STRep s (MBA s) -> ST s (MBA s))
-> STRep s (MBA s) -> ST s (MBA s)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
len# State# s
s of
(# State# s
s', MutableByteArray# s
mba# #) -> (# State# s
s', MutableByteArray# s -> MBA s
forall s. MutableByteArray# s -> MBA s
MBA# MutableByteArray# s
mba# #)
copyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s ()
copyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s ()
copyByteArray (BA# ByteArray#
src#) (I# Int#
src_off#) (MBA# MutableByteArray# s
dst#) (I# Int#
dst_off#) (I# Int#
len#) =
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
s -> case ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
src# Int#
src_off# MutableByteArray# s
dst# Int#
dst_off# Int#
len# State# s
s of
State# s
s' -> (# State# s
s', () #)
unsafeFreezeByteArray :: MBA s -> ST s BA
unsafeFreezeByteArray :: MBA s -> ST s BA
unsafeFreezeByteArray (MBA# MutableByteArray# s
mba#) =
STRep s BA -> ST s BA
forall s a. STRep s a -> ST s a
ST (STRep s BA -> ST s BA) -> STRep s BA -> ST s BA
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba# State# s
s of
(# State# s
s', ByteArray#
ba# #) -> (# State# s
s', ByteArray# -> BA
BA# ByteArray#
ba# #)
copyAddrToByteArray :: Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld ()
copyAddrToByteArray :: Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld ()
copyAddrToByteArray (Ptr Addr#
src#) (MBA# MutableByteArray# RealWorld
dst#) (I# Int#
dst_off#) (I# Int#
len#) =
STRep RealWorld () -> ST RealWorld ()
forall s a. STRep s a -> ST s a
ST (STRep RealWorld () -> ST RealWorld ())
-> STRep RealWorld () -> ST RealWorld ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
src# MutableByteArray# RealWorld
dst# Int#
dst_off# Int#
len# State# RealWorld
s of
State# RealWorld
s' -> (# State# RealWorld
s', () #)
#if !MIN_VERSION_bytestring(0,10,9)
foreign import ccall unsafe "string.h strlen" c_strlen
:: CString -> IO CSize
packCString :: CString -> IO ShortByteString
packCString cstr = do
len <- c_strlen cstr
packCStringLen (cstr, fromIntegral len)
packCStringLen :: CStringLen -> IO ShortByteString
packCStringLen (cstr, len) | len >= 0 = createFromPtr cstr len
packCStringLen (_, len) =
moduleErrorIO "packCStringLen" ("negative length: " ++ show len)
useAsCString :: ShortByteString -> (CString -> IO a) -> IO a
useAsCString bs action =
allocaBytes (l+1) $ \buf -> do
copyToPtr bs 0 buf (fromIntegral l)
pokeByteOff buf l (0::Word8)
action buf
where l = length bs
useAsCStringLen :: ShortByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen bs action =
allocaBytes l $ \buf -> do
copyToPtr bs 0 buf (fromIntegral l)
action (buf, l)
where l = length bs
#endif
packCWString :: Ptr Word16 -> IO ShortByteString
packCWString :: Ptr Word16 -> IO ShortByteString
packCWString Ptr Word16
cwstr = do
[Word16]
cs <- Word16 -> Ptr Word16 -> IO [Word16]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 Word16
W16._nul Ptr Word16
cwstr
ShortByteString -> IO ShortByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ([Word16] -> ShortByteString
packWord16 [Word16]
cs)
packCWStringLen :: (Ptr Word16, Int) -> IO ShortByteString
packCWStringLen :: (Ptr Word16, Int) -> IO ShortByteString
packCWStringLen (Ptr Word16
cp, Int
len) = do
[Word16]
cs <- Int -> Ptr Word16 -> IO [Word16]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
len Ptr Word16
cp
ShortByteString -> IO ShortByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ([Word16] -> ShortByteString
packWord16 [Word16]
cs)
useAsCWString :: ShortByteString -> (Ptr Word16 -> IO a) -> IO a
useAsCWString :: ShortByteString -> (Ptr Word16 -> IO a) -> IO a
useAsCWString = Word16 -> [Word16] -> (Ptr Word16 -> IO a) -> IO a
forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 Word16
W16._nul ([Word16] -> (Ptr Word16 -> IO a) -> IO a)
-> (ShortByteString -> [Word16])
-> ShortByteString
-> (Ptr Word16 -> IO a)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> [Word16]
unpackWord16
useAsCWStringLen :: ShortByteString -> ((Ptr Word16, Int) -> IO a) -> IO a
useAsCWStringLen :: ShortByteString -> ((Ptr Word16, Int) -> IO a) -> IO a
useAsCWStringLen ShortByteString
bs (Ptr Word16, Int) -> IO a
action = [Word16] -> (Int -> Ptr Word16 -> IO a) -> IO a
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (ShortByteString -> [Word16]
unpackWord16 ShortByteString
bs) ((Int -> Ptr Word16 -> IO a) -> IO a)
-> (Int -> Ptr Word16 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Int
len Ptr Word16
ptr -> (Ptr Word16, Int) -> IO a
action (Ptr Word16
ptr, Int
len)
newCWString :: ShortByteString -> IO (Ptr Word16)
newCWString :: ShortByteString -> IO (Ptr Word16)
newCWString = Word16 -> [Word16] -> IO (Ptr Word16)
forall a. Storable a => a -> [a] -> IO (Ptr a)
newArray0 Word16
W16._nul ([Word16] -> IO (Ptr Word16))
-> (ShortByteString -> [Word16])
-> ShortByteString
-> IO (Ptr Word16)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> [Word16]
unpackWord16
moduleErrorIO :: String -> String -> IO a
moduleErrorIO :: String -> String -> IO a
moduleErrorIO String
fun String
msg = IOError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO a) -> (String -> IOError) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String -> String -> String
moduleErrorMsg String
fun String
msg
{-# NOINLINE moduleErrorIO #-}
moduleErrorMsg :: String -> String -> String
moduleErrorMsg :: String -> String -> String
moduleErrorMsg String
fun String
msg = String
"Data.ByteString.Short." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
msg
packWord16 :: [Word16] -> ShortByteString
packWord16 :: [Word16] -> ShortByteString
packWord16 [Word16]
cs = Int -> [Word16] -> ShortByteString
packLenWord16 ([Word16] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Word16]
cs) [Word16]
cs
packLenWord16 :: Int -> [Word16] -> ShortByteString
packLenWord16 :: Int -> [Word16] -> ShortByteString
packLenWord16 Int
len [Word16]
ws0 =
Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
create (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) (\MBA s
mba -> MBA s -> Int -> [Word16] -> ST s ()
forall s. MBA s -> Int -> [Word16] -> ST s ()
go MBA s
mba Int
0 [Word16]
ws0)
where
go :: MBA s -> Int -> [Word16] -> ST s ()
go :: MBA s -> Int -> [Word16] -> ST s ()
go !MBA s
_ !Int
_ [] = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go !MBA s
mba !Int
i (Word16
w:[Word16]
ws) = do
MBA s -> Int -> Word16 -> ST s ()
forall s. MBA s -> Int -> Word16 -> ST s ()
writeWord16Array MBA s
mba Int
i Word16
w
MBA s -> Int -> [Word16] -> ST s ()
forall s. MBA s -> Int -> [Word16] -> ST s ()
go MBA s
mba (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) [Word16]
ws
unpackWord16 :: ShortByteString -> [Word16]
unpackWord16 :: ShortByteString -> [Word16]
unpackWord16 ShortByteString
sbs = Int -> [Word16] -> [Word16]
go Int
len []
where
len :: Int
len = ShortByteString -> Int
length ShortByteString
sbs
go :: Int -> [Word16] -> [Word16]
go !Int
i ![Word16]
acc
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = [Word16]
acc
| Bool
otherwise = let !w :: Word16
w = BA -> Int -> Word16
indexWord16Array (ShortByteString -> BA
asBA ShortByteString
sbs) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
in Int -> [Word16] -> [Word16]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (Word16
wWord16 -> [Word16] -> [Word16]
forall a. a -> [a] -> [a]
:[Word16]
acc)
packWord16Rev :: [Word16] -> ShortByteString
packWord16Rev :: [Word16] -> ShortByteString
packWord16Rev [Word16]
cs = Int -> [Word16] -> ShortByteString
packLenWord16Rev (([Word16] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Word16]
cs) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) [Word16]
cs
packLenWord16Rev :: Int -> [Word16] -> ShortByteString
packLenWord16Rev :: Int -> [Word16] -> ShortByteString
packLenWord16Rev Int
len [Word16]
ws0 =
Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
create Int
len (\MBA s
mba -> MBA s -> Int -> [Word16] -> ST s ()
forall s. MBA s -> Int -> [Word16] -> ST s ()
go MBA s
mba Int
len [Word16]
ws0)
where
go :: MBA s -> Int -> [Word16] -> ST s ()
go :: MBA s -> Int -> [Word16] -> ST s ()
go !MBA s
_ !Int
_ [] = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go !MBA s
mba !Int
i (Word16
w:[Word16]
ws) = do
MBA s -> Int -> Word16 -> ST s ()
forall s. MBA s -> Int -> Word16 -> ST s ()
writeWord16Array MBA s
mba (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Word16
w
MBA s -> Int -> [Word16] -> ST s ()
forall s. MBA s -> Int -> [Word16] -> ST s ()
go MBA s
mba (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [Word16]
ws
writeWord16Array :: MBA s
-> Int
-> Word16
-> ST s ()
writeWord16Array :: MBA s -> Int -> Word16 -> ST s ()
writeWord16Array (MBA# MutableByteArray# s
mba#) (I# Int#
i#) (W16# Word#
w#) =
case Word# -> (# Word#, Word# #)
encodeWord16LE# Word#
w# of
(# Word#
lsb#, Word#
msb# #) ->
(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
s -> case MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba# Int#
i# Word#
lsb# State# s
s of
State# s
s' -> (# State# s
s', () #)) ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(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
s -> case MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba# (Int#
i# Int# -> Int# -> Int#
+# Int#
1#) Word#
msb# State# s
s of
State# s
s' -> (# State# s
s', () #))
indexWord16Array :: BA
-> Int
-> Word16
indexWord16Array :: BA -> Int -> Word16
indexWord16Array (BA# ByteArray#
ba#) (I# Int#
i#) =
case (# ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
ba# Int#
i#, ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
ba# (Int#
i# Int# -> Int# -> Int#
+# Int#
1#) #) of
(# Word#
lsb#, Word#
msb# #) -> Word# -> Word16
W16# (((# Word#, Word# #) -> Word#
decodeWord16LE# (# Word#
lsb#, Word#
msb# #)))
#if !MIN_VERSION_base(4,16,0)
encodeWord16LE# :: Word#
-> (# Word#, Word# #)
encodeWord16LE# :: Word# -> (# Word#, Word# #)
encodeWord16LE# Word#
x# = (# (Word#
x# Word# -> Word# -> Word#
`and#` Int# -> Word#
int2Word# Int#
0xff#)
, ((Word#
x# Word# -> Word# -> Word#
`and#` Int# -> Word#
int2Word# Int#
0xff00#) Word# -> Int# -> Word#
`shiftRL#` Int#
8#) #)
decodeWord16LE# :: (# Word#, Word# #)
-> Word#
decodeWord16LE# :: (# Word#, Word# #) -> Word#
decodeWord16LE# (# Word#
lsb#, Word#
msb# #) = ((Word#
msb# Word# -> Int# -> Word#
`shiftL#` Int#
8#) Word# -> Word# -> Word#
`or#` Word#
lsb#)
#else
encodeWord16LE# :: Word16#
-> (# Word8#, Word8# #)
encodeWord16LE# x# = (# word16ToWord8# x#
, word16ToWord8# (x# `uncheckedShiftRLWord16#` 8#) #)
where
word16ToWord8# y = wordToWord8# (word16ToWord# y)
decodeWord16LE# :: (# Word8#, Word8# #)
-> Word16#
decodeWord16LE# (# lsb#, msb# #) = ((word8ToWord16# msb# `uncheckedShiftLWord16#` 8#) `orWord16#` word8ToWord16# lsb#)
where
word8ToWord16# y = wordToWord16# (word8ToWord# y)
#endif