{-# LANGUAGE Unsafe #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Pack
-- Copyright   :  (c) The University of Glasgow 1997-2002
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  cvs-ghc@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- This module provides a small set of low-level functions for packing
-- and unpacking a chunk of bytes. Used by code emitted by the compiler
-- plus the prelude libraries.
--
-- The programmer level view of packed strings is provided by a GHC
-- system library PackedString.
--
-----------------------------------------------------------------------------

module GHC.Pack
       (
        -- (**) - emitted by compiler.

        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)
  | 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# [Char]
str = case ([Char] -> ByteArray Int
packString [Char]
str) of { ByteArray Int
_ Int
_ ByteArray#
bytes -> ByteArray#
bytes }

packString :: [Char] -> ByteArray Int
packString :: [Char] -> ByteArray Int
packString [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 [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# Int#
length#) [Char]
str =
  {-
   allocate an array that will hold the string
   (not forgetting the NUL byte at the end)
  -}
 Int# -> ST s (MutableByteArray s Int)
forall s. Int# -> ST s (MutableByteArray s Int)
new_ps_array (Int#
length# Int# -> 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
>>= \ MutableByteArray s Int
ch_array ->
   -- fill in packed string from "str"
 MutableByteArray s Int -> Int# -> [Char] -> ST s ()
forall s. MutableByteArray s Int -> Int# -> [Char] -> ST s ()
fill_in MutableByteArray s Int
ch_array Int#
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
>>
   -- freeze the puppy:
 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 MutableByteArray s Int
arr_in# 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# Int#
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 MutableByteArray s Int
arr_in# Int#
idx (C# Char#
c : [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#
+# Int#
1#) [Char]
cs

-- (Very :-) ``Specialised'' versions of some CharArray things...

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 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
$ \ 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 { (# State# s
s2#, 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 [Char]
"new_ps_array"

write_ps_array :: MutableByteArray s Int -> Int# -> Char# -> ST s ()
write_ps_array (MutableByteArray Int
_ Int
_ MutableByteArray# s
barr#) Int#
n 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
$ \ 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 { State# s
s2#   ->
    (# State# s
s2#, () #) }

-- same as unsafeFreezeByteArray
freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
freeze_ps_array (MutableByteArray Int
_ Int
_ MutableByteArray# s
arr#) 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
$ \ 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 { (# State# s
s2#, ByteArray#
frozen# #) ->
    (# State# s
s2#, Int -> Int -> ByteArray# -> ByteArray Int
forall ix. ix -> ix -> ByteArray# -> ByteArray ix
ByteArray Int
0 (Int# -> Int
I# Int#
len#) ByteArray#
frozen# #) }