ghc/lib/ghc/PackBase.lhs

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