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