ghc/lib/std/PrelPack.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: PrelPack.lhs,v 1.16 2001/01/11 17:25:57 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1997-2000
   5 %
   6
   7 \section[PrelPack]{Packing/unpacking bytes}
   8
   9 This module provides a small set of low-level functions for packing
  10 and unpacking a chunk of bytes. Used by code emitted by the compiler
  11 plus the prelude libraries.
  12
  13 The programmer level view of packed strings is provided by a GHC
  14 system library PackedString.
  15
  16 \begin{code}
  17 {-# OPTIONS -fno-implicit-prelude #-}
  18
  19 module PrelPack
  20        (
  21         -- (**) - emitted by compiler.
  22
  23         packCString#,      -- :: [Char] -> ByteArray#  **
  24         packString,        -- :: [Char] -> ByteArray Int
  25         packStringST,      -- :: [Char] -> ST s (ByteArray Int)
  26         packNBytesST,      -- :: Int -> [Char] -> ST s (ByteArray Int)
  27
  28         unpackCString,     -- :: Ptr a -> [Char]
  29         unpackCStringST,   -- :: Ptr a -> ST s [Char]
  30         unpackNBytes,      -- :: Ptr a -> Int -> [Char]
  31         unpackNBytesST,    -- :: Ptr a -> Int -> ST s [Char]
  32         unpackNBytesAccST, -- :: Ptr a -> Int -> [Char] -> ST s [Char]
  33         unpackNBytesAccST#,-- :: Ptr a -> Int -> [Char] -> ST s [Char]
  34         unpackCString#,    -- :: Addr# -> [Char]         **
  35         unpackNBytes#,     -- :: Addr# -> Int# -> [Char] **
  36         unpackNBytesST#,   -- :: Addr# -> Int# -> ST s [Char]
  37
  38         unpackCStringBA,   -- :: ByteArray Int -> [Char]
  39         unpackNBytesBA,    -- :: ByteArray Int -> Int  -> [Char]
  40         unpackCStringBA#,  -- :: ByteArray#    -> Int# -> [Char]
  41         unpackNBytesBA#,   -- :: ByteArray#    -> Int# -> [Char]
  42
  43
  44         unpackFoldrCString#,  -- **
  45         unpackAppendCString#,  -- **
  46
  47         new_ps_array,           -- Int# -> ST s (MutableByteArray s Int)
  48         write_ps_array,         -- MutableByteArray s Int -> Int# -> Char# -> ST s ()
  49         freeze_ps_array         -- MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
  50
  51        )
  52         where
  53
  54 import PrelBase
  55 import {-# SOURCE #-} PrelErr ( error )
  56 import PrelList ( length )
  57 import PrelST
  58 import PrelNum
  59 import PrelByteArr
  60 import PrelPtr
  61
  62 \end{code}
  63
  64 %*********************************************************
  65 %*                                                      *
  66 \subsection{Unpacking Ptrs}
  67 %*                                                      *
  68 %*********************************************************
  69
  70 Primitives for converting Addrs pointing to external
  71 sequence of bytes into a list of @Char@s:
  72
  73 \begin{code}
  74 unpackCString :: Ptr a -> [Char]
  75 unpackCString a@(Ptr addr)
  76   | a == nullPtr  = []
  77   | otherwise      = unpackCString# addr
  78
  79 unpackNBytes :: Ptr a -> Int -> [Char]
  80 unpackNBytes (Ptr addr) (I# l) = unpackNBytes# addr l
  81
  82 unpackCStringST  :: Ptr a{- ptr. to NUL terminated string-} -> ST s [Char]
  83 unpackCStringST a@(Ptr addr)
  84   | a == nullPtr  = return []
  85   | otherwise      = unpack 0#
  86   where
  87     unpack nh
  88       | ch `eqChar#` '\0'# = return []
  89       | otherwise          = do
  90                 ls <- unpack (nh +# 1#)
  91                 return ((C# ch ) : ls)
  92       where
  93         ch = indexCharOffAddr# addr nh
  94
  95 unpackNBytesST :: Ptr a -> Int -> ST s [Char]
  96 unpackNBytesST (Ptr addr) (I# l) = unpackNBytesAccST# addr l []
  97
  98 unpackNBytesAccST :: Ptr a -> Int -> [Char] -> ST s [Char]
  99 unpackNBytesAccST (Ptr addr) (I# l) rest = unpackNBytesAccST# addr l rest
 100
 101 unpackNBytesST# :: Addr# -> Int# -> ST s [Char]
 102 unpackNBytesST# addr# l#   = unpackNBytesAccST# addr# l# []
 103
 104 unpackNBytesAccST# :: Addr# -> Int# -> [Char] -> ST s [Char]
 105 unpackNBytesAccST# _addr 0#   rest = return rest
 106 unpackNBytesAccST#  addr len# rest = unpack rest (len# -# 1#)
 107   where
 108     unpack acc i#
 109       | i# <# 0#  = return acc
 110       | otherwise  =
 111          case indexCharOffAddr# addr i# of
 112           ch -> unpack (C# ch : acc) (i# -# 1#)
 113
 114 \end{code}
 115
 116 %********************************************************
 117 %*                                                      *
 118 \subsection{Unpacking ByteArrays}
 119 %*                                                      *
 120 %********************************************************
 121
 122 Converting byte arrays into list of chars:
 123
 124 \begin{code}
 125 unpackCStringBA :: ByteArray Int -> [Char]
 126 unpackCStringBA (ByteArray l@(I# l#) u@(I# u#) bytes)
 127  | l > u     = []
 128  | otherwise = unpackCStringBA# bytes (u# -# l# +# 1#)
 129
 130 {-
 131  unpack until NUL or end of BA is reached, whatever comes first.
 132 -}
 133 unpackCStringBA# :: ByteArray# -> Int# -> [Char]
 134 unpackCStringBA# bytes len
 135  = unpack 0#
 136  where
 137     unpack nh
 138       | nh >=# len         ||
 139         ch `eqChar#` '\0'#    = []
 140       | otherwise             = C# ch : unpack (nh +# 1#)
 141       where
 142         ch = indexCharArray# bytes nh
 143
 144 unpackNBytesBA :: ByteArray Int -> Int -> [Char]
 145 unpackNBytesBA (ByteArray l u bytes) i
 146  = unpackNBytesBA# bytes len#
 147    where
 148     len# = case max 0 (min i len) of I# v# -> v#
 149     len | l > u     = 0
 150         | otherwise = u-l+1
 151
 152 unpackNBytesBA# :: ByteArray# -> Int# -> [Char]
 153 unpackNBytesBA# _bytes 0#   = []
 154 unpackNBytesBA#  bytes len# = unpack [] (len# -# 1#)
 155    where
 156     unpack acc i#
 157      | i# <# 0#  = acc
 158      | otherwise =
 159           case indexCharArray# bytes i# of
 160             ch -> unpack (C# ch : acc) (i# -# 1#)
 161
 162 \end{code}
 163
 164
 165 %********************************************************
 166 %*                                                      *
 167 \subsection{Packing Strings}
 168 %*                                                      *
 169 %********************************************************
 170
 171 Converting a list of chars into a packed @ByteArray@ representation.
 172
 173 \begin{code}
 174 packCString#         :: [Char]          -> ByteArray#
 175 packCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes }
 176
 177 packString :: [Char] -> ByteArray Int
 178 packString str = runST (packStringST str)
 179
 180 packStringST :: [Char] -> ST s (ByteArray Int)
 181 packStringST str =
 182   let len = length str  in
 183   packNBytesST len str
 184
 185 packNBytesST :: Int -> [Char] -> ST s (ByteArray Int)
 186 packNBytesST (I# length#) str =
 187   {-
 188    allocate an array that will hold the string
 189    (not forgetting the NUL byte at the end)
 190   -}
 191  new_ps_array (length# +# 1#) >>= \ ch_array ->
 192    -- fill in packed string from "str"
 193  fill_in ch_array 0# str   >>
 194    -- freeze the puppy:
 195  freeze_ps_array ch_array length#
 196  where
 197   fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s ()
 198   fill_in arr_in# idx [] =
 199    write_ps_array arr_in# idx (chr# 0#) >>
 200    return ()
 201
 202   fill_in arr_in# idx (C# c : cs) =
 203    write_ps_array arr_in# idx c  >>
 204    fill_in arr_in# (idx +# 1#) cs
 205
 206 \end{code}
 207
 208 (Very :-) ``Specialised'' versions of some CharArray things...
 209
 210 \begin{code}
 211 new_ps_array    :: Int# -> ST s (MutableByteArray s Int)
 212 write_ps_array  :: MutableByteArray s Int -> Int# -> Char# -> ST s ()
 213 freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
 214
 215 new_ps_array size = ST $ \ s ->
 216     case (newByteArray# size s)   of { (# s2#, barr# #) ->
 217     (# s2#, MutableByteArray bot bot barr# #) }
 218   where
 219     bot = error "new_ps_array"
 220
 221 write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# ->
 222     case writeCharArray# barr# n ch s#  of { s2#   ->
 223     (# s2#, () #) }
 224
 225 -- same as unsafeFreezeByteArray
 226 freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# ->
 227     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
 228     (# s2#, ByteArray 0 (I# len#) frozen# #) }
 229 \end{code}
 230
 231