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