1 % ------------------------------------------------------------------------------
2 % $Id: PrelPack.lhs,v 1.16 2001/01/11 17:25:57 simonmar Exp $
4 % (c) The University of Glasgow, 1997-2000
7 \section[PrelPack]{Packing/unpacking bytes}
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.
13 The programmer level view of packed strings is provided by a GHC
14 system library PackedString.
17 {-# OPTIONS -fno-implicit-prelude #-}
21 -- (**) - emitted by compiler.
23 packCString#, -- :: [Char] -> ByteArray# **
24 packString, -- :: [Char] -> ByteArray Int
25 packStringST, -- :: [Char] -> ST s (ByteArray Int)
26 packNBytesST, -- :: Int -> [Char] -> ST s (ByteArray Int)
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]
38 unpackCStringBA, -- :: ByteArray Int -> [Char]
39 unpackNBytesBA, -- :: ByteArray Int -> Int -> [Char]
40 unpackCStringBA#, -- :: ByteArray# -> Int# -> [Char]
41 unpackNBytesBA#, -- :: ByteArray# -> Int# -> [Char]
44 unpackFoldrCString#, -- **
45 unpackAppendCString#, -- **
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)
55 import {-# SOURCE #-} PrelErr ( error )
56 import PrelList ( length )
64 %*********************************************************
66 \subsection{Unpacking Ptrs}
68 %*********************************************************
70 Primitives for converting Addrs pointing to external
71 sequence of bytes into a list of @Char@s:
74 unpackCString :: Ptr a -> [Char]
75 unpackCString a@(Ptr addr)
77 | otherwise = unpackCString# addr
79 unpackNBytes :: Ptr a -> Int -> [Char]
80 unpackNBytes (Ptr addr) (I# l) = unpackNBytes# addr l
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#
88 | ch `eqChar#` '\0'# = return []
90 ls <- unpack (nh +# 1#)
91 return ((C# ch ) : ls)
93 ch = indexCharOffAddr# addr nh
95 unpackNBytesST :: Ptr a -> Int -> ST s [Char]
96 unpackNBytesST (Ptr addr) (I# l) = unpackNBytesAccST# addr l []
98 unpackNBytesAccST :: Ptr a -> Int -> [Char] -> ST s [Char]
99 unpackNBytesAccST (Ptr addr) (I# l) rest = unpackNBytesAccST# addr l rest
101 unpackNBytesST# :: Addr# -> Int# -> ST s [Char]
102 unpackNBytesST# addr# l# = unpackNBytesAccST# addr# l# []
104 unpackNBytesAccST# :: Addr# -> Int# -> [Char] -> ST s [Char]
105 unpackNBytesAccST# _addr 0# rest = return rest
106 unpackNBytesAccST# addr len# rest = unpack rest (len# -# 1#)
109 | i# <# 0# = return acc
111 case indexCharOffAddr# addr i# of
112 ch -> unpack (C# ch : acc) (i# -# 1#)
116 %********************************************************
118 \subsection{Unpacking ByteArrays}
120 %********************************************************
122 Converting byte arrays into list of chars:
125 unpackCStringBA :: ByteArray Int -> [Char]
126 unpackCStringBA (ByteArray l@(I# l#) u@(I# u#) bytes)
128 | otherwise = unpackCStringBA# bytes (u# -# l# +# 1#)
131 unpack until NUL or end of BA is reached, whatever comes first.
133 unpackCStringBA# :: ByteArray# -> Int# -> [Char]
134 unpackCStringBA# bytes len
139 ch `eqChar#` '\0'# = []
140 | otherwise = C# ch : unpack (nh +# 1#)
142 ch = indexCharArray# bytes nh
144 unpackNBytesBA :: ByteArray Int -> Int -> [Char]
145 unpackNBytesBA (ByteArray l u bytes) i
146 = unpackNBytesBA# bytes len#
148 len# = case max 0 (min i len) of I# v# -> v#
152 unpackNBytesBA# :: ByteArray# -> Int# -> [Char]
153 unpackNBytesBA# _bytes 0# = []
154 unpackNBytesBA# bytes len# = unpack [] (len# -# 1#)
159 case indexCharArray# bytes i# of
160 ch -> unpack (C# ch : acc) (i# -# 1#)
165 %********************************************************
167 \subsection{Packing Strings}
169 %********************************************************
171 Converting a list of chars into a packed @ByteArray@ representation.
174 packCString# :: [Char] -> ByteArray#
175 packCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes }
177 packString :: [Char] -> ByteArray Int
178 packString str = runST (packStringST str)
180 packStringST :: [Char] -> ST s (ByteArray Int)
182 let len = length str in
185 packNBytesST :: Int -> [Char] -> ST s (ByteArray Int)
186 packNBytesST (I# length#) str =
188 allocate an array that will hold the string
189 (not forgetting the NUL byte at the end)
191 new_ps_array (length# +# 1#) >>= \ ch_array ->
192 -- fill in packed string from "str"
193 fill_in ch_array 0# str >>
195 freeze_ps_array ch_array length#
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#) >>
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
208 (Very :-) ``Specialised'' versions of some CharArray things...
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)
215 new_ps_array size = ST $ \ s ->
216 case (newByteArray# size s) of { (# s2#, barr# #) ->
217 (# s2#, MutableByteArray bot bot barr# #) }
219 bot = error "new_ps_array"
221 write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# ->
222 case writeCharArray# barr# n ch s# of { s2# ->
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# #) }