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 -fcompiling-prelude -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         unpackCStringST,   -- :: Addr -> ST s [Char]
  27         unpackNBytes,      -- :: Addr -> Int -> [Char]
  28         unpackNBytesST,    -- :: Addr -> Int -> ST s [Char]
  29         unpackNBytesAccST, -- :: Addr -> Int -> [Char] -> ST s [Char]
  30         unpackCString#,    -- :: Addr# -> [Char]         **
  31         unpackNBytes#,     -- :: Addr# -> Int# -> [Char] **
  32         unpackNBytesST#,   -- :: Addr# -> Int# -> ST s [Char]
  33
  34         unpackCStringBA,   -- :: ByteArray Int -> [Char]
  35         unpackNBytesBA,    -- :: ByteArray Int -> Int  -> [Char]
  36         unpackCStringBA#,  -- :: ByteArray#    -> Int# -> [Char]
  37         unpackNBytesBA#,   -- :: ByteArray#    -> Int# -> [Char]
  38
  39
  40         unpackFoldrCString#,  -- **
  41         unpackAppendCString#,  -- **
  42
  43         new_ps_array,           -- Int# -> ST s (MutableByteArray s Int)
  44         write_ps_array,         -- MutableByteArray s Int -> Int# -> Char# -> ST s ()
  45         freeze_ps_array         -- MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
  46
  47        )
  48         where
  49
  50 import PrelBase
  51 import {-# SOURCE #-} PrelErr ( error )
  52 import PrelList ( length )
  53 import PrelST
  54 import PrelNum
  55 import PrelArr
  56 import PrelByteArr
  57 import PrelAddr
  58
  59 \end{code}
  60
  61 %*********************************************************
  62 %*                                                      *
  63 \subsection{Unpacking Addrs}
  64 %*                                                      *
  65 %*********************************************************
  66
  67 Primitives for converting Addrs pointing to external
  68 sequence of bytes into a list of @Char@s:
  69
  70 \begin{code}
  71 unpackCString :: Addr -> [Char]
  72 unpackCString a@(A# addr)
  73   | a == nullAddr  = []
  74   | otherwise      = unpackCString# addr
  75
  76 unpackNBytes :: Addr -> Int -> [Char]
  77 unpackNBytes (A# addr) (I# l) = unpackNBytes# addr l
  78
  79 unpackCStringST  :: Addr{- ptr. to NUL terminated string-} -> ST s [Char]
  80 unpackCStringST a@(A# addr)
  81   | a == nullAddr  = return []
  82   | otherwise      = unpack 0#
  83   where
  84     unpack nh
  85       | ch `eqChar#` '\0'# = return []
  86       | otherwise          = do
  87                 ls <- unpack (nh +# 1#)
  88                 return ((C# ch ) : ls)
  89       where
  90         ch = indexCharOffAddr# addr nh
  91
  92 unpackNBytesST :: Addr -> Int -> ST s [Char]
  93 unpackNBytesST (A# addr) (I# l) = unpackNBytesAccST# addr l []
  94
  95 unpackNBytesAccST :: Addr -> Int -> [Char] -> ST s [Char]
  96 unpackNBytesAccST (A# addr) (I# l) rest = unpackNBytesAccST# addr l rest
  97
  98 unpackNBytesST# :: Addr# -> Int# -> ST s [Char]
  99 unpackNBytesST# addr# l#   = unpackNBytesAccST# addr# l# []
 100
 101 unpackNBytesAccST# :: Addr# -> Int# -> [Char] -> ST s [Char]
 102 unpackNBytesAccST# _addr 0#   rest = return rest
 103 unpackNBytesAccST#  addr len# rest = unpack rest (len# -# 1#)
 104   where
 105     unpack acc i#
 106       | i# <# 0#  = return acc
 107       | otherwise  =
 108          case indexCharOffAddr# addr i# of
 109           ch -> unpack (C# ch : acc) (i# -# 1#)
 110
 111 \end{code}
 112
 113 %********************************************************
 114 %*                                                      *
 115 \subsection{Unpacking ByteArrays}
 116 %*                                                      *
 117 %********************************************************
 118
 119 Converting byte arrays into list of chars:
 120
 121 \begin{code}
 122 unpackCStringBA :: ByteArray Int -> [Char]
 123 unpackCStringBA (ByteArray l@(I# l#) u@(I# u#) bytes)
 124  | l > u     = []
 125  | otherwise = unpackCStringBA# bytes (u# -# l# +# 1#)
 126
 127 {-
 128  unpack until NUL or end of BA is reached, whatever comes first.
 129 -}
 130 unpackCStringBA# :: ByteArray# -> Int# -> [Char]
 131 unpackCStringBA# bytes len
 132  = unpack 0#
 133  where
 134     unpack nh
 135       | nh >=# len         ||
 136         ch `eqChar#` '\0'#    = []
 137       | otherwise             = C# ch : unpack (nh +# 1#)
 138       where
 139         ch = indexCharArray# bytes nh
 140
 141 unpackNBytesBA :: ByteArray Int -> Int -> [Char]
 142 unpackNBytesBA (ByteArray l u bytes) i
 143  = unpackNBytesBA# bytes len#
 144    where
 145     len# = case max 0 (min i len) of I# v# -> v#
 146     len | l > u     = 0
 147         | otherwise = u-l+1
 148
 149 unpackNBytesBA# :: ByteArray# -> Int# -> [Char]
 150 unpackNBytesBA# _bytes 0#   = []
 151 unpackNBytesBA#  bytes len# = unpack [] (len# -# 1#)
 152    where
 153     unpack acc i#
 154      | i# <# 0#  = acc
 155      | otherwise =
 156           case indexCharArray# bytes i# of
 157             ch -> unpack (C# ch : acc) (i# -# 1#)
 158
 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 (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 { (# s2#, barr# #) ->
 214     (# s2#, MutableByteArray bot 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     (# s2#, () #) }
 221
 222 -- same as unsafeFreezeByteArray
 223 freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# ->
 224     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
 225     (# s2#, ByteArray 0 (I# len#) frozen# #) }
 226 \end{code}
 227
 228