ghc/lib/std/PrelPack.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1997
   3 %
   4 \section[PrelPack]{Packing/unpacking bytes}
   5
   6 This module provides a small set of low-level functions for packing
   7 and unpacking a chunk of bytes. Used by code emitted by the compiler
   8 plus the prelude libraries.
   9
  10 The programmer level view of packed strings is provided by a GHC
  11 system library PackedString.
  12
  13 \begin{code}
  14 {-# OPTIONS -fno-implicit-prelude #-}
  15
  16 module PrelPack
  17        (
  18         -- (**) - emitted by compiler.
  19
  20         packCString#,      -- :: [Char] -> ByteArray#  **
  21         packString,        -- :: [Char] -> ByteArray Int
  22         packStringST,      -- :: [Char] -> ST s (ByteArray Int)
  23         packNBytesST,      -- :: Int -> [Char] -> ST s (ByteArray Int)
  24
  25         unpackCString,     -- :: Addr -> [Char]
  26         unpackNBytes,      -- :: Addr -> Int -> [Char]
  27         unpackNBytesST,    -- :: Addr -> Int -> ST s [Char]
  28         unpackNBytesAccST, -- :: Addr -> Int -> [Char] -> ST s [Char]
  29         unpackCString#,    -- :: Addr# -> [Char]         **
  30         unpackNBytes#,     -- :: Addr# -> Int# -> [Char] **
  31         unpackNBytesST#,   -- :: Addr# -> Int# -> ST s [Char]
  32
  33         unpackCStringBA,   -- :: ByteArray Int -> [Char]
  34         unpackNBytesBA,    -- :: ByteArray Int -> Int  -> [Char]
  35         unpackCStringBA#,  -- :: ByteArray#    -> Int# -> [Char]
  36         unpackNBytesBA#,   -- :: ByteArray#    -> Int# -> [Char]
  37
  38
  39         unpackFoldrCString#,  -- **
  40         unpackAppendCString#,  -- **
  41
  42         new_ps_array,           -- Int# -> ST s (MutableByteArray s Int)
  43         write_ps_array,         -- MutableByteArray s Int -> Int# -> Char# -> ST s ()
  44         freeze_ps_array         -- MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
  45
  46        )
  47         where
  48
  49 import PrelBase
  50 import {-# SOURCE #-} PrelErr ( error )
  51 import PrelList ( length )
  52 import PrelST
  53 import PrelArr
  54 import PrelAddr
  55
  56 \end{code}
  57
  58 %*********************************************************
  59 %*                                                      *
  60 \subsection{Unpacking Addrs}
  61 %*                                                      *
  62 %*********************************************************
  63
  64 Primitives for converting Addrs pointing to external
  65 sequence of bytes into a list of @Char@s:
  66
  67 \begin{code}
  68 unpackCString  :: Addr{- ptr. to NUL terminated string-} -> [Char]
  69 unpackCString a@(A# addr) =
  70   if a == ``NULL'' then
  71      []
  72   else
  73      unpackCString# addr
  74
  75 unpackCString# :: Addr#  -> [Char]
  76 unpackCString# addr
  77   = unpack 0#
  78   where
  79     unpack nh
  80       | ch `eqChar#` '\0'# = []
  81       | otherwise          = C# ch : unpack (nh +# 1#)
  82       where
  83         ch = indexCharOffAddr# addr nh
  84
  85 unpackNBytes :: Addr -> Int -> [Char]
  86 unpackNBytes (A# addr) (I# l) = unpackNBytes# addr l
  87
  88 unpackNBytesST :: Addr -> Int -> ST s [Char]
  89 unpackNBytesST (A# addr) (I# l) = unpackNBytesAccST# addr l []
  90
  91 unpackNBytesAccST :: Addr -> Int -> [Char] -> ST s [Char]
  92 unpackNBytesAccST (A# addr) (I# l) rest = unpackNBytesAccST# addr l rest
  93
  94 unpackNBytes#      :: Addr# -> Int#   -> [Char]
  95   -- This one is called by the compiler to unpack literal strings with NULs in them; rare.
  96   -- It's strict!
  97 unpackNBytes# addr 0#   = []
  98 unpackNBytes# addr len# = unpack [] (len# -# 1#)
  99     where
 100      unpack acc i#
 101       | i# <# 0#  = acc
 102       | otherwise =
 103          case indexCharOffAddr# addr i# of
 104             ch -> unpack (C# ch : acc) (i# -# 1#)
 105
 106 unpackNBytesST# :: Addr# -> Int# -> ST s [Char]
 107 unpackNBytesST# addr# l#   = unpackNBytesAccST# addr# l# []
 108
 109 unpackNBytesAccST# :: Addr# -> Int# -> [Char] -> ST s [Char]
 110 unpackNBytesAccST# addr 0#   rest = return rest
 111 unpackNBytesAccST# addr len# rest = unpack rest (len# -# 1#)
 112   where
 113     unpack acc i#
 114       | i# <# 0#  = return acc
 115       | otherwise  =
 116          case indexCharOffAddr# addr i# of
 117           ch -> unpack (C# ch : acc) (i# -# 1#)
 118
 119 \end{code}
 120
 121 %********************************************************
 122 %*                                                      *
 123 \subsection{Unpacking ByteArrays}
 124 %*                                                      *
 125 %********************************************************
 126
 127 Converting byte arrays into list of chars:
 128
 129 \begin{code}
 130 unpackCStringBA :: ByteArray Int -> [Char]
 131 unpackCStringBA (ByteArray (l@(I# l#),u@(I# u#)) bytes)
 132  | l > u     = []
 133  | otherwise = unpackCStringBA# bytes (u# -# l# +# 1#)
 134
 135 {-
 136  unpack until NUL or end of BA is reached, whatever comes first.
 137 -}
 138 unpackCStringBA# :: ByteArray# -> Int# -> [Char]
 139 unpackCStringBA# bytes len
 140  = unpack 0#
 141  where
 142     unpack nh
 143       | nh >=# len         ||
 144         ch `eqChar#` '\0'#    = []
 145       | otherwise             = C# ch : unpack (nh +# 1#)
 146       where
 147         ch = indexCharArray# bytes nh
 148
 149 unpackNBytesBA :: ByteArray Int -> Int -> [Char]
 150 unpackNBytesBA (ByteArray (l,u) bytes) i
 151  = unpackNBytesBA# bytes len#
 152    where
 153     len# = case max 0 (min i len) of I# v# -> v#
 154     len | l > u     = 0
 155         | otherwise = u-l+1
 156
 157 unpackNBytesBA# :: ByteArray# -> Int# -> [Char]
 158 unpackNBytesBA# bytes 0#   = []
 159 unpackNBytesBA# bytes len# = unpack [] (len# -# 1#)
 160    where
 161     unpack acc i#
 162      | i# <# 0#  = acc
 163      | otherwise =
 164           case indexCharArray# bytes i# of
 165             ch -> unpack (C# ch : acc) (i# -# 1#)
 166
 167 \end{code}
 168
 169
 170 %********************************************************
 171 %*                                                      *
 172 \subsection{Packing Strings}
 173 %*                                                      *
 174 %********************************************************
 175
 176 Converting a list of chars into a packed @ByteArray@ representation.
 177
 178 \begin{code}
 179 packCString#         :: [Char]          -> ByteArray#
 180 packCString# str = case (packString str) of { ByteArray _ bytes -> bytes }
 181
 182 packString :: [Char] -> ByteArray Int
 183 packString str = runST (packStringST str)
 184
 185 packStringST :: [Char] -> ST s (ByteArray Int)
 186 packStringST str =
 187   let len = length str  in
 188   packNBytesST len str
 189
 190 packNBytesST :: Int -> [Char] -> ST s (ByteArray Int)
 191 packNBytesST len@(I# length#) str =
 192   {-
 193    allocate an array that will hold the string
 194    (not forgetting the NUL byte at the end)
 195   -}
 196  new_ps_array (length# +# 1#) >>= \ ch_array ->
 197    -- fill in packed string from "str"
 198  fill_in ch_array 0# str   >>
 199    -- freeze the puppy:
 200  freeze_ps_array ch_array length#
 201  where
 202   fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s ()
 203   fill_in arr_in# idx [] =
 204    write_ps_array arr_in# idx (chr# 0#) >>
 205    return ()
 206
 207   fill_in arr_in# idx (C# c : cs) =
 208    write_ps_array arr_in# idx c  >>
 209    fill_in arr_in# (idx +# 1#) cs
 210
 211 \end{code}
 212
 213 (Very :-) ``Specialised'' versions of some CharArray things...
 214
 215 \begin{code}
 216 new_ps_array    :: Int# -> ST s (MutableByteArray s Int)
 217 write_ps_array  :: MutableByteArray s Int -> Int# -> Char# -> ST s ()
 218 freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
 219
 220 new_ps_array size = ST $ \ s ->
 221     case (newCharArray# size s)   of { (# s2#, barr# #) ->
 222     (# s2#, MutableByteArray bot barr# #) }
 223   where
 224     bot = error "new_ps_array"
 225
 226 write_ps_array (MutableByteArray _ barr#) n ch = ST $ \ s# ->
 227     case writeCharArray# barr# n ch s#  of { s2#   ->
 228     (# s2#, () #) }
 229
 230 -- same as unsafeFreezeByteArray
 231 freeze_ps_array (MutableByteArray _ arr#) len# = ST $ \ s# ->
 232     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
 233     (# s2#, ByteArray (0,I# len#) frozen# #) }
 234 \end{code}
 235
 236
 237 %********************************************************
 238 %*                                                      *
 239 \subsection{Misc}
 240 %*                                                      *
 241 %********************************************************
 242
 243 The compiler may emit these two
 244
 245 \begin{code}
 246 unpackAppendCString# :: Addr# -> [Char] -> [Char]
 247 unpackAppendCString# addr rest
 248   = unpack 0#
 249   where
 250     unpack nh
 251       | ch `eqChar#` '\0'# = rest
 252       | otherwise          = C# ch : unpack (nh +# 1#)
 253       where
 254         ch = indexCharOffAddr# addr nh
 255
 256 unpackFoldrCString#  :: Addr# -> (Char  -> a -> a) -> a -> a
 257 unpackFoldrCString# addr f z
 258   = unpack 0#
 259   where
 260     unpack nh
 261       | ch `eqChar#` '\0'# = z
 262       | otherwise          = C# ch `f` unpack (nh +# 1#)
 263       where
 264         ch = indexCharOffAddr# addr nh
 265 \end{code}