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