[project @ 2001-06-28 14:15:04 by simonmar]
[packages/old-time.git] / GHC / Pack.lhs
1 % ------------------------------------------------------------------------------
2 % $Id: Pack.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $
3 %
4 % (c) The University of Glasgow, 1997-2000
5 %
6
7 \section[GHC.Pack]{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 GHC.Pack
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 GHC.Base
55 import {-# SOURCE #-} GHC.Err ( error )
56 import GHC.List ( length )
57 import GHC.ST
58 import GHC.Num
59 import GHC.ByteArr
60 import Foreign.Ptr
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