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