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