GHC/Pack.lhs

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