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