\begin{code}
{-# OPTIONS_GHC -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Pack
-- Copyright   :  (c) The University of Glasgow 1997-2002
-- License     :  see libraries/base/LICENSE
-- 
-- Maintainer  :  [email protected]
-- 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.
--
-----------------------------------------------------------------------------

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

	packCString#,      -- :: [Char] -> ByteArray#    (**)
	unpackCString,
	unpackCString#,    -- :: Addr# -> [Char]	 (**)
	unpackNBytes#,     -- :: Addr# -> Int# -> [Char] (**)
	unpackFoldrCString#,  -- (**)
	unpackAppendCString#,  -- (**)
       ) 
	where

import GHC.Base
import GHC.Err ( error )
import GHC.List ( length )
import GHC.ST
import GHC.Num
import GHC.Ptr

data ByteArray ix      	       = ByteArray	  ix ix ByteArray#
data MutableByteArray s ix     = MutableByteArray ix ix (MutableByteArray# s)

unpackCString :: Ptr a -> [Char]
unpackCString a@(Ptr addr)
  | a == nullPtr  = []
  | otherwise	   = unpackCString# addr

packCString#	     :: [Char]          -> ByteArray#
packCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes }

packString :: [Char] -> ByteArray Int
packString str = runST (packStringST str)

packStringST :: [Char] -> ST s (ByteArray Int)
packStringST str =
  let len = length str  in
  packNBytesST len str

packNBytesST :: Int -> [Char] -> ST s (ByteArray Int)
packNBytesST (I# length#) str =
  {- 
   allocate an array that will hold the string
   (not forgetting the NUL byte at the end)
  -}
 new_ps_array (length# +# 1#) >>= \ ch_array ->
   -- fill in packed string from "str"
 fill_in ch_array 0# str   >>
   -- freeze the puppy:
 freeze_ps_array ch_array length#
 where
  fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s ()
  fill_in arr_in# idx [] =
   write_ps_array arr_in# idx (chr# 0#) >>
   return ()

  fill_in arr_in# idx (C# c : cs) =
   write_ps_array arr_in# idx c	 >>
   fill_in arr_in# (idx +# 1#) 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 size = ST $ \ s ->
    case (newByteArray# size s)	  of { (# s2#, barr# #) ->
    (# s2#, MutableByteArray bot bot barr# #) }
  where
    bot = error "new_ps_array"

write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# ->
    case writeCharArray# barr# n ch s#	of { s2#   ->
    (# s2#, () #) }

-- same as unsafeFreezeByteArray
freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# ->
    case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
    (# s2#, ByteArray 0 (I# len#) frozen# #) }
\end{code}