{-# LANGUAGE Unsafe #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
{-# OPTIONS_HADDOCK not-home #-}
module GHC.Pack
(
packCString#,
unpackCString,
unpackCString#,
unpackNBytes#,
unpackFoldrCString#,
unpackAppendCString#,
)
where
import GHC.Base
import GHC.List ( length )
import GHC.ST
import GHC.Ptr
data ByteArray ix = ByteArray ix ix ByteArray#
data MutableByteArray s ix = MutableByteArray ix ix (MutableByteArray# s)
unpackCString :: Ptr a -> [Char]
unpackCString :: Ptr a -> [Char]
unpackCString a :: Ptr a
a@(Ptr addr :: Addr#
addr)
| Ptr a
a Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr = []
| Bool
otherwise = Addr# -> [Char]
unpackCString# Addr#
addr
packCString# :: [Char] -> ByteArray#
packCString# :: [Char] -> ByteArray#
packCString# str :: [Char]
str = case ([Char] -> ByteArray Int
packString [Char]
str) of { ByteArray _ _ bytes :: ByteArray#
bytes -> ByteArray#
bytes }
packString :: [Char] -> ByteArray Int
packString :: [Char] -> ByteArray Int
packString str :: [Char]
str = (forall s. ST s (ByteArray Int)) -> ByteArray Int
forall a. (forall s. ST s a) -> a
runST ([Char] -> ST s (ByteArray Int)
forall s. [Char] -> ST s (ByteArray Int)
packStringST [Char]
str)
packStringST :: [Char] -> ST s (ByteArray Int)
packStringST :: [Char] -> ST s (ByteArray Int)
packStringST str :: [Char]
str =
let len :: Int
len = [Char] -> Int
forall a. [a] -> Int
length [Char]
str in
Int -> [Char] -> ST s (ByteArray Int)
forall s. Int -> [Char] -> ST s (ByteArray Int)
packNBytesST Int
len [Char]
str
packNBytesST :: Int -> [Char] -> ST s (ByteArray Int)
packNBytesST :: Int -> [Char] -> ST s (ByteArray Int)
packNBytesST (I# length# :: Int#
length#) str :: [Char]
str =
Int# -> ST s (MutableByteArray s Int)
forall s. Int# -> ST s (MutableByteArray s Int)
new_ps_array (Int#
length# Int# -> Int# -> Int#
+# 1#) ST s (MutableByteArray s Int)
-> (MutableByteArray s Int -> ST s (ByteArray Int))
-> ST s (ByteArray Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ch_array :: MutableByteArray s Int
ch_array ->
MutableByteArray s Int -> Int# -> [Char] -> ST s ()
forall s. MutableByteArray s Int -> Int# -> [Char] -> ST s ()
fill_in MutableByteArray s Int
ch_array 0# [Char]
str ST s () -> ST s (ByteArray Int) -> ST s (ByteArray Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
forall s. MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
freeze_ps_array MutableByteArray s Int
ch_array Int#
length#
where
fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s ()
fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s ()
fill_in arr_in# :: MutableByteArray s Int
arr_in# idx :: Int#
idx [] =
MutableByteArray s Int -> Int# -> Char# -> ST s ()
forall s. MutableByteArray s Int -> Int# -> Char# -> ST s ()
write_ps_array MutableByteArray s Int
arr_in# Int#
idx (Int# -> Char#
chr# 0#) ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
() -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
fill_in arr_in# :: MutableByteArray s Int
arr_in# idx :: Int#
idx (C# c :: Char#
c : cs :: [Char]
cs) =
MutableByteArray s Int -> Int# -> Char# -> ST s ()
forall s. MutableByteArray s Int -> Int# -> Char# -> ST s ()
write_ps_array MutableByteArray s Int
arr_in# Int#
idx Char#
c ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
MutableByteArray s Int -> Int# -> [Char] -> ST s ()
forall s. MutableByteArray s Int -> Int# -> [Char] -> ST s ()
fill_in MutableByteArray s Int
arr_in# (Int#
idx Int# -> Int# -> Int#
+# 1#) [Char]
cs
new_ps_array :: Int# -> ST s (MutableByteArray s Int)
write_ps_array :: MutableByteArray s Int -> Int# -> Char# -> ST s ()
freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
new_ps_array :: Int# -> ST s (MutableByteArray s Int)
new_ps_array size :: Int#
size = STRep s (MutableByteArray s Int) -> ST s (MutableByteArray s Int)
forall s a. STRep s a -> ST s a
ST (STRep s (MutableByteArray s Int) -> ST s (MutableByteArray s Int))
-> STRep s (MutableByteArray s Int)
-> ST s (MutableByteArray s Int)
forall a b. (a -> b) -> a -> b
$ \ s :: State# s
s ->
case (Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
size State# s
s) of { (# s2# :: State# s
s2#, barr# :: MutableByteArray# s
barr# #) ->
(# State# s
s2#, Int -> Int -> MutableByteArray# s -> MutableByteArray s Int
forall s ix.
ix -> ix -> MutableByteArray# s -> MutableByteArray s ix
MutableByteArray Int
forall a. a
bot Int
forall a. a
bot MutableByteArray# s
barr# #) }
where
bot :: a
bot = [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace "new_ps_array"
write_ps_array :: MutableByteArray s Int -> Int# -> Char# -> ST s ()
write_ps_array (MutableByteArray _ _ barr# :: MutableByteArray# s
barr#) n :: Int#
n ch :: Char#
ch = 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
$ \ s# :: State# s
s# ->
case MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
writeCharArray# MutableByteArray# s
barr# Int#
n Char#
ch State# s
s# of { s2# :: State# s
s2# ->
(# State# s
s2#, () #) }
freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
freeze_ps_array (MutableByteArray _ _ arr# :: MutableByteArray# s
arr#) len# :: Int#
len# = STRep s (ByteArray Int) -> ST s (ByteArray Int)
forall s a. STRep s a -> ST s a
ST (STRep s (ByteArray Int) -> ST s (ByteArray Int))
-> STRep s (ByteArray Int) -> ST s (ByteArray Int)
forall a b. (a -> b) -> a -> b
$ \ s# :: State# s
s# ->
case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
arr# State# s
s# of { (# s2# :: State# s
s2#, frozen# :: ByteArray#
frozen# #) ->
(# State# s
s2#, Int -> Int -> ByteArray# -> ByteArray Int
forall ix. ix -> ix -> ByteArray# -> ByteArray ix
ByteArray 0 (Int# -> Int
I# Int#
len#) ByteArray#
frozen# #) }