2 % (c) The GRASP/AQUA Project, Glasgow University, 1997
4 \section[PrelPack]{Packing/unpacking bytes}
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.
10 The programmer level view of packed strings is provided by a GHC
11 system library PackedString.
14 {-# OPTIONS -fno-implicit-prelude #-}
18 -- (**) - emitted by compiler.
20 packCString#, -- :: [Char] -> ByteArray# **
21 packString, -- :: [Char] -> ByteArray Int
22 packStringST, -- :: [Char] -> ST s (ByteArray Int)
23 packNBytesST, -- :: Int -> [Char] -> ST s (ByteArray Int)
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]
34 unpackCStringBA, -- :: ByteArray Int -> [Char]
35 unpackNBytesBA, -- :: ByteArray Int -> Int -> [Char]
36 unpackCStringBA#, -- :: ByteArray# -> Int# -> [Char]
37 unpackNBytesBA#, -- :: ByteArray# -> Int# -> [Char]
40 unpackFoldrCString#, -- **
41 unpackAppendCString#, -- **
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)
51 import {-# SOURCE #-} PrelErr ( error )
52 import PrelList ( length )
60 %*********************************************************
62 \subsection{Unpacking Addrs}
64 %*********************************************************
66 Primitives for converting Addrs pointing to external
67 sequence of bytes into a list of @Char@s:
70 unpackCString :: Addr{- ptr. to NUL terminated string-} -> [Char]
71 unpackCString a@(A# addr)
73 | otherwise = unpackCString# addr
75 unpackCStringST :: Addr{- ptr. to NUL terminated string-} -> ST s [Char]
76 unpackCStringST a@(A# addr)
77 | a == nullAddr = return []
78 | otherwise = unpack 0#
81 | ch `eqChar#` '\0'# = return []
83 ls <- unpack (nh +# 1#)
84 return ((C# ch ) : ls)
86 ch = indexCharOffAddr# addr nh
88 unpackCString# :: Addr# -> [Char]
93 | ch `eqChar#` '\0'# = []
94 | otherwise = C# ch : unpack (nh +# 1#)
96 ch = indexCharOffAddr# addr nh
98 unpackNBytes :: Addr -> Int -> [Char]
99 unpackNBytes (A# addr) (I# l) = unpackNBytes# addr l
101 unpackNBytesST :: Addr -> Int -> ST s [Char]
102 unpackNBytesST (A# addr) (I# l) = unpackNBytesAccST# addr l []
104 unpackNBytesAccST :: Addr -> Int -> [Char] -> ST s [Char]
105 unpackNBytesAccST (A# addr) (I# l) rest = unpackNBytesAccST# addr l rest
107 unpackNBytes# :: Addr# -> Int# -> [Char]
108 -- This one is called by the compiler to unpack literal strings with NULs in them; rare.
110 unpackNBytes# _addr 0# = []
111 unpackNBytes# addr len# = unpack [] (len# -# 1#)
116 case indexCharOffAddr# addr i# of
117 ch -> unpack (C# ch : acc) (i# -# 1#)
119 unpackNBytesST# :: Addr# -> Int# -> ST s [Char]
120 unpackNBytesST# addr# l# = unpackNBytesAccST# addr# l# []
122 unpackNBytesAccST# :: Addr# -> Int# -> [Char] -> ST s [Char]
123 unpackNBytesAccST# _addr 0# rest = return rest
124 unpackNBytesAccST# addr len# rest = unpack rest (len# -# 1#)
127 | i# <# 0# = return acc
129 case indexCharOffAddr# addr i# of
130 ch -> unpack (C# ch : acc) (i# -# 1#)
134 %********************************************************
136 \subsection{Unpacking ByteArrays}
138 %********************************************************
140 Converting byte arrays into list of chars:
143 unpackCStringBA :: ByteArray Int -> [Char]
144 unpackCStringBA (ByteArray l@(I# l#) u@(I# u#) bytes)
146 | otherwise = unpackCStringBA# bytes (u# -# l# +# 1#)
149 unpack until NUL or end of BA is reached, whatever comes first.
151 unpackCStringBA# :: ByteArray# -> Int# -> [Char]
152 unpackCStringBA# bytes len
157 ch `eqChar#` '\0'# = []
158 | otherwise = C# ch : unpack (nh +# 1#)
160 ch = indexCharArray# bytes nh
162 unpackNBytesBA :: ByteArray Int -> Int -> [Char]
163 unpackNBytesBA (ByteArray l u bytes) i
164 = unpackNBytesBA# bytes len#
166 len# = case max 0 (min i len) of I# v# -> v#
170 unpackNBytesBA# :: ByteArray# -> Int# -> [Char]
171 unpackNBytesBA# _bytes 0# = []
172 unpackNBytesBA# bytes len# = unpack [] (len# -# 1#)
177 case indexCharArray# bytes i# of
178 ch -> unpack (C# ch : acc) (i# -# 1#)
183 %********************************************************
185 \subsection{Packing Strings}
187 %********************************************************
189 Converting a list of chars into a packed @ByteArray@ representation.
192 packCString# :: [Char] -> ByteArray#
193 packCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes }
195 packString :: [Char] -> ByteArray Int
196 packString str = runST (packStringST str)
198 packStringST :: [Char] -> ST s (ByteArray Int)
200 let len = length str in
203 packNBytesST :: Int -> [Char] -> ST s (ByteArray Int)
204 packNBytesST (I# length#) str =
206 allocate an array that will hold the string
207 (not forgetting the NUL byte at the end)
209 new_ps_array (length# +# 1#) >>= \ ch_array ->
210 -- fill in packed string from "str"
211 fill_in ch_array 0# str >>
213 freeze_ps_array ch_array length#
215 fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s ()
216 fill_in arr_in# idx [] =
217 write_ps_array arr_in# idx (chr# 0#) >>
220 fill_in arr_in# idx (C# c : cs) =
221 write_ps_array arr_in# idx c >>
222 fill_in arr_in# (idx +# 1#) cs
226 (Very :-) ``Specialised'' versions of some CharArray things...
229 new_ps_array :: Int# -> ST s (MutableByteArray s Int)
230 write_ps_array :: MutableByteArray s Int -> Int# -> Char# -> ST s ()
231 freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
233 new_ps_array size = ST $ \ s ->
234 case (newCharArray# size s) of { (# s2#, barr# #) ->
235 (# s2#, MutableByteArray bot bot barr# #) }
237 bot = error "new_ps_array"
239 write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# ->
240 case writeCharArray# barr# n ch s# of { s2# ->
243 -- same as unsafeFreezeByteArray
244 freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# ->
245 case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
246 (# s2#, ByteArray 0 (I# len#) frozen# #) }
250 %********************************************************
254 %********************************************************
256 The compiler may emit these two
259 unpackAppendCString# :: Addr# -> [Char] -> [Char]
260 unpackAppendCString# addr rest
264 | ch `eqChar#` '\0'# = rest
265 | otherwise = C# ch : unpack (nh +# 1#)
267 ch = indexCharOffAddr# addr nh
269 unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a
270 unpackFoldrCString# addr f z
274 | ch `eqChar#` '\0'# = z
275 | otherwise = C# ch `f` unpack (nh +# 1#)
277 ch = indexCharOffAddr# addr nh