GHC/Pack.lhs

   1 \begin{code}
   2 {-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
   3 {-# OPTIONS_HADDOCK hide #-}
   4
   5 -----------------------------------------------------------------------------
   6 -- |
   7 -- Module      :  GHC.Pack
   8 -- Copyright   :  (c) The University of Glasgow 1997-2002
   9 -- License     :  see libraries/base/LICENSE
  10 --
  11 -- Maintainer  :  cvs-ghc@haskell.org
  12 -- Stability   :  internal
  13 -- Portability :  non-portable (GHC Extensions)
  14 --
  15 -- This module provides a small set of low-level functions for packing
  16 -- and unpacking a chunk of bytes. Used by code emitted by the compiler
  17 -- plus the prelude libraries.
  18 --
  19 -- The programmer level view of packed strings is provided by a GHC
  20 -- system library PackedString.
  21 --
  22 -----------------------------------------------------------------------------
  23
  24 -- #hide
  25 module GHC.Pack
  26        (
  27         -- (**) - emitted by compiler.
  28
  29         packCString#,      -- :: [Char] -> ByteArray#    (**)
  30         unpackCString,
  31         unpackCString#,    -- :: Addr# -> [Char]         (**)
  32         unpackNBytes#,     -- :: Addr# -> Int# -> [Char] (**)
  33         unpackFoldrCString#,  -- (**)
  34         unpackAppendCString#,  -- (**)
  35        )
  36         where
  37
  38 import GHC.Base
  39 import GHC.List ( length )
  40 import GHC.ST
  41 import GHC.Ptr
  42
  43 data ByteArray ix              = ByteArray        ix ix ByteArray#
  44 data MutableByteArray s ix     = MutableByteArray ix ix (MutableByteArray# s)
  45
  46 unpackCString :: Ptr a -> [Char]
  47 unpackCString a@(Ptr addr)
  48   | a == nullPtr  = []
  49   | otherwise      = unpackCString# addr
  50
  51 packCString#         :: [Char]          -> ByteArray#
  52 packCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes }
  53
  54 packString :: [Char] -> ByteArray Int
  55 packString str = runST (packStringST str)
  56
  57 packStringST :: [Char] -> ST s (ByteArray Int)
  58 packStringST str =
  59   let len = length str  in
  60   packNBytesST len str
  61
  62 packNBytesST :: Int -> [Char] -> ST s (ByteArray Int)
  63 packNBytesST (I# length#) str =
  64   {-
  65    allocate an array that will hold the string
  66    (not forgetting the NUL byte at the end)
  67   -}
  68  new_ps_array (length# +# 1#) >>= \ ch_array ->
  69    -- fill in packed string from "str"
  70  fill_in ch_array 0# str   >>
  71    -- freeze the puppy:
  72  freeze_ps_array ch_array length#
  73  where
  74   fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s ()
  75   fill_in arr_in# idx [] =
  76    write_ps_array arr_in# idx (chr# 0#) >>
  77    return ()
  78
  79   fill_in arr_in# idx (C# c : cs) =
  80    write_ps_array arr_in# idx c  >>
  81    fill_in arr_in# (idx +# 1#) cs
  82
  83 -- (Very :-) ``Specialised'' versions of some CharArray things...
  84
  85 new_ps_array    :: Int# -> ST s (MutableByteArray s Int)
  86 write_ps_array  :: MutableByteArray s Int -> Int# -> Char# -> ST s ()
  87 freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
  88
  89 new_ps_array size = ST $ \ s ->
  90     case (newByteArray# size s)   of { (# s2#, barr# #) ->
  91     (# s2#, MutableByteArray bot bot barr# #) }
  92   where
  93     bot = error "new_ps_array"
  94
  95 write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# ->
  96     case writeCharArray# barr# n ch s#  of { s2#   ->
  97     (# s2#, () #) }
  98
  99 -- same as unsafeFreezeByteArray
 100 freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# ->
 101     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
 102     (# s2#, ByteArray 0 (I# len#) frozen# #) }
 103 \end{code}