ghc/lib/std/PrelPack.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: PrelPack.lhs,v 1.15 2000/12/12 12:19:58 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1997-2000
   5 %
   6
   7 \section[PrelPack]{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 PrelPack
  20        (
  21         -- (**) - emitted by compiler.
  22
  23         packCString#,      -- :: [Char] -> ByteArray#  **
  24         packString,        -- :: [Char] -> ByteArray Int
  25         packStringST,      -- :: [Char] -> ST s (ByteArray Int)
  26         packNBytesST,      -- :: Int -> [Char] -> ST s (ByteArray Int)
  27
  28         unpackCString,     -- :: Addr -> [Char]
  29         unpackCStringST,   -- :: Addr -> ST s [Char]
  30         unpackNBytes,      -- :: Addr -> Int -> [Char]
  31         unpackNBytesST,    -- :: Addr -> Int -> ST s [Char]
  32         unpackNBytesAccST, -- :: Addr -> Int -> [Char] -> ST s [Char]
  33         unpackCString#,    -- :: Addr# -> [Char]         **
  34         unpackNBytes#,     -- :: Addr# -> Int# -> [Char] **
  35         unpackNBytesST#,   -- :: Addr# -> Int# -> ST s [Char]
  36
  37         unpackCStringBA,   -- :: ByteArray Int -> [Char]
  38         unpackNBytesBA,    -- :: ByteArray Int -> Int  -> [Char]
  39         unpackCStringBA#,  -- :: ByteArray#    -> Int# -> [Char]
  40         unpackNBytesBA#,   -- :: ByteArray#    -> Int# -> [Char]
  41
  42
  43         unpackFoldrCString#,  -- **
  44         unpackAppendCString#,  -- **
  45
  46         new_ps_array,           -- Int# -> ST s (MutableByteArray s Int)
  47         write_ps_array,         -- MutableByteArray s Int -> Int# -> Char# -> ST s ()
  48         freeze_ps_array         -- MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
  49
  50        )
  51         where
  52
  53 import PrelBase
  54 import {-# SOURCE #-} PrelErr ( error )
  55 import PrelList ( length )
  56 import PrelST
  57 import PrelNum
  58 import PrelByteArr
  59 import PrelAddr
  60
  61 \end{code}
  62
  63 %*********************************************************
  64 %*                                                      *
  65 \subsection{Unpacking Addrs}
  66 %*                                                      *
  67 %*********************************************************
  68
  69 Primitives for converting Addrs pointing to external
  70 sequence of bytes into a list of @Char@s:
  71
  72 \begin{code}
  73 unpackCString :: Addr -> [Char]
  74 unpackCString a@(A# addr)
  75   | a == nullAddr  = []
  76   | otherwise      = unpackCString# addr
  77
  78 unpackNBytes :: Addr -> Int -> [Char]
  79 unpackNBytes (A# addr) (I# l) = unpackNBytes# addr l
  80
  81 unpackCStringST  :: Addr{- ptr. to NUL terminated string-} -> ST s [Char]
  82 unpackCStringST a@(A# addr)
  83   | a == nullAddr  = return []
  84   | otherwise      = unpack 0#
  85   where
  86     unpack nh
  87       | ch `eqChar#` '\0'# = return []
  88       | otherwise          = do
  89                 ls <- unpack (nh +# 1#)
  90                 return ((C# ch ) : ls)
  91       where
  92         ch = indexCharOffAddr# addr nh
  93
  94 unpackNBytesST :: Addr -> Int -> ST s [Char]
  95 unpackNBytesST (A# addr) (I# l) = unpackNBytesAccST# addr l []
  96
  97 unpackNBytesAccST :: Addr -> Int -> [Char] -> ST s [Char]
  98 unpackNBytesAccST (A# addr) (I# l) rest = unpackNBytesAccST# addr l rest
  99
 100 unpackNBytesST# :: Addr# -> Int# -> ST s [Char]
 101 unpackNBytesST# addr# l#   = unpackNBytesAccST# addr# l# []
 102
 103 unpackNBytesAccST# :: Addr# -> Int# -> [Char] -> ST s [Char]
 104 unpackNBytesAccST# _addr 0#   rest = return rest
 105 unpackNBytesAccST#  addr len# rest = unpack rest (len# -# 1#)
 106   where
 107     unpack acc i#
 108       | i# <# 0#  = return acc
 109       | otherwise  =
 110          case indexCharOffAddr# addr i# of
 111           ch -> unpack (C# ch : acc) (i# -# 1#)
 112
 113 \end{code}
 114
 115 %********************************************************
 116 %*                                                      *
 117 \subsection{Unpacking ByteArrays}
 118 %*                                                      *
 119 %********************************************************
 120
 121 Converting byte arrays into list of chars:
 122
 123 \begin{code}
 124 unpackCStringBA :: ByteArray Int -> [Char]
 125 unpackCStringBA (ByteArray l@(I# l#) u@(I# u#) bytes)
 126  | l > u     = []
 127  | otherwise = unpackCStringBA# bytes (u# -# l# +# 1#)
 128
 129 {-
 130  unpack until NUL or end of BA is reached, whatever comes first.
 131 -}
 132 unpackCStringBA# :: ByteArray# -> Int# -> [Char]
 133 unpackCStringBA# bytes len
 134  = unpack 0#
 135  where
 136     unpack nh
 137       | nh >=# len         ||
 138         ch `eqChar#` '\0'#    = []
 139       | otherwise             = C# ch : unpack (nh +# 1#)
 140       where
 141         ch = indexCharArray# bytes nh
 142
 143 unpackNBytesBA :: ByteArray Int -> Int -> [Char]
 144 unpackNBytesBA (ByteArray l u bytes) i
 145  = unpackNBytesBA# bytes len#
 146    where
 147     len# = case max 0 (min i len) of I# v# -> v#
 148     len | l > u     = 0
 149         | otherwise = u-l+1
 150
 151 unpackNBytesBA# :: ByteArray# -> Int# -> [Char]
 152 unpackNBytesBA# _bytes 0#   = []
 153 unpackNBytesBA#  bytes len# = unpack [] (len# -# 1#)
 154    where
 155     unpack acc i#
 156      | i# <# 0#  = acc
 157      | otherwise =
 158           case indexCharArray# bytes i# of
 159             ch -> unpack (C# ch : acc) (i# -# 1#)
 160
 161 \end{code}
 162
 163
 164 %********************************************************
 165 %*                                                      *
 166 \subsection{Packing Strings}
 167 %*                                                      *
 168 %********************************************************
 169
 170 Converting a list of chars into a packed @ByteArray@ representation.
 171
 172 \begin{code}
 173 packCString#         :: [Char]          -> ByteArray#
 174 packCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes }
 175
 176 packString :: [Char] -> ByteArray Int
 177 packString str = runST (packStringST str)
 178
 179 packStringST :: [Char] -> ST s (ByteArray Int)
 180 packStringST str =
 181   let len = length str  in
 182   packNBytesST len str
 183
 184 packNBytesST :: Int -> [Char] -> ST s (ByteArray Int)
 185 packNBytesST (I# length#) str =
 186   {-
 187    allocate an array that will hold the string
 188    (not forgetting the NUL byte at the end)
 189   -}
 190  new_ps_array (length# +# 1#) >>= \ ch_array ->
 191    -- fill in packed string from "str"
 192  fill_in ch_array 0# str   >>
 193    -- freeze the puppy:
 194  freeze_ps_array ch_array length#
 195  where
 196   fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s ()
 197   fill_in arr_in# idx [] =
 198    write_ps_array arr_in# idx (chr# 0#) >>
 199    return ()
 200
 201   fill_in arr_in# idx (C# c : cs) =
 202    write_ps_array arr_in# idx c  >>
 203    fill_in arr_in# (idx +# 1#) cs
 204
 205 \end{code}
 206
 207 (Very :-) ``Specialised'' versions of some CharArray things...
 208
 209 \begin{code}
 210 new_ps_array    :: Int# -> ST s (MutableByteArray s Int)
 211 write_ps_array  :: MutableByteArray s Int -> Int# -> Char# -> ST s ()
 212 freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
 213
 214 new_ps_array size = ST $ \ s ->
 215     case (newByteArray# size s)   of { (# s2#, barr# #) ->
 216     (# s2#, MutableByteArray bot bot barr# #) }
 217   where
 218     bot = error "new_ps_array"
 219
 220 write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# ->
 221     case writeCharArray# barr# n ch s#  of { s2#   ->
 222     (# s2#, () #) }
 223
 224 -- same as unsafeFreezeByteArray
 225 freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# ->
 226     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
 227     (# s2#, ByteArray 0 (I# len#) frozen# #) }
 228 \end{code}
 229
 230