2 % (c) The GRASP/AQUA Project, Glasgow University, 1997
4 \section{Basic ops on packed representations}
6 Some basic operations for working on packed representations of series
7 of bytes (character strings). Used by the interface lexer input
11 #include "HsVersions.h"
15 strLength, -- :: _Addr -> Int
16 copyPrefixStr, -- :: _Addr -> Int -> _ByteArray Int
17 copySubStr, -- :: _Addr -> Int -> Int -> _ByteArray Int
18 copySubStrFO, -- :: ForeignObj -> Int -> Int -> _ByteArray Int
19 copySubStrBA, -- :: _ByteArray Int -> Int -> Int -> _ByteArray Int
21 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 205
22 stringToByteArray, -- :: String -> _ByteArray Int
23 byteArrayToString, -- :: _ByteArray Int -> String
26 eqStrPrefix, -- :: Addr# -> ByteArray# -> Int# -> Bool
27 eqCharStrPrefix, -- :: Addr# -> Addr# -> Int# -> Bool
28 eqStrPrefixBA, -- :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
29 eqCharStrPrefixBA, -- :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
30 eqStrPrefixFO, -- :: ForeignObj# -> ByteArray# -> Int# -> Int# -> Bool
32 addrOffset#, -- :: Addr# -> Int# -> Addr#
33 indexCharOffFO# -- :: ForeignObj# -> Int# -> Char#
36 #if __GLASGOW_HASKELL__ <= 201
47 # if __GLASGOW_HASKELL__ == 202
48 import PrelBase ( Char(..) )
51 # if __GLASGOW_HASKELL__ >= 206
59 Return the length of a @\\NUL@ terminated character string:
62 strLength :: _Addr -> Int
65 _ccall_ strlen a `thenPrimIO` \ len@(I# _) ->
71 Copying a char string prefix into a byte array,
72 {\em assuming} the prefix does not contain any
76 copyPrefixStr :: _Addr -> Int -> _ByteArray Int
77 copyPrefixStr (A# a) len@(I# length#) =
79 {- allocate an array that will hold the string
80 (not forgetting the NUL at the end)
82 (new_ps_array (length# +# 1#)) `thenPrimIO` \ ch_array ->
83 {- Revert back to Haskell-only solution for the moment.
84 _ccall_ memcpy ch_array (A# a) len `thenPrimIO` \ () ->
85 write_ps_array ch_array length# (chr# 0#) `seqPrimIO`
87 -- fill in packed string from "addr"
88 fill_in ch_array 0# `seqPrimIO`
90 freeze_ps_array ch_array)
92 fill_in :: _MutableByteArray s Int -> Int# -> _ST s ()
96 = write_ps_array arr_in# idx (chr# 0#) `seqStrictlyST`
99 = case (indexCharOffAddr# a idx) of { ch ->
100 write_ps_array arr_in# idx ch `seqStrictlyST`
101 fill_in arr_in# (idx +# 1#) }
105 Copying out a substring, assume a 0-indexed string:
106 (and positive lengths, thank you).
109 copySubStr :: _Addr -> Int -> Int -> _ByteArray Int
110 copySubStr a start length =
111 unsafePerformPrimIO (
112 _casm_ `` %r= (char *)((char *)%0 + (int)%1); '' a start
113 `thenPrimIO` \ a_start ->
114 returnPrimIO (copyPrefixStr a_start length))
117 Copying a sub-string out of a ForeignObj
120 copySubStrFO :: _ForeignObj -> Int -> Int -> _ByteArray Int
121 copySubStrFO (_ForeignObj fo) (I# start#) len@(I# length#) =
122 unsafePerformPrimIO (
123 {- allocate an array that will hold the string
124 (not forgetting the NUL at the end)
126 new_ps_array (length# +# 1#) `thenStrictlyST` \ ch_array ->
127 -- fill in packed string from "addr"
128 fill_in ch_array 0# `seqStrictlyST`
130 freeze_ps_array ch_array)
132 fill_in :: _MutableByteArray s Int -> Int# -> _ST s ()
136 = write_ps_array arr_in# idx (chr# 0#) `seqStrictlyST`
139 = case (indexCharOffFO# fo (idx +# start#)) of { ch ->
140 write_ps_array arr_in# idx ch `seqStrictlyST`
141 fill_in arr_in# (idx +# 1#) }
143 {- ToDo: add FO primitives.. -}
144 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <=205
145 indexCharOffFO# :: ForeignObj# -> Int# -> Char#
146 indexCharOffFO# fo# i# =
147 case unsafePerformPrimIO (_casm_ ``%r=(char)*((char *)%0 + (int)%1); '' (_ForeignObj fo#) (I# i#)) of
150 indexCharOffFO# :: ForeignObj# -> Int# -> Char#
151 indexCharOffFO# fo i = indexCharOffForeignObj# fo i
154 -- step on (char *) pointer by x units.
155 addrOffset# :: Addr# -> Int# -> Addr#
157 case unsafePerformPrimIO (_casm_ ``%r=(char *)((char *)%0 + (int)%1); '' (A# a#) (I# i#)) of
160 copySubStrBA :: _ByteArray Int -> Int -> Int -> _ByteArray Int
161 copySubStrBA (_ByteArray _ barr#) (I# start#) len@(I# length#) =
162 unsafePerformPrimIO (
163 {- allocate an array that will hold the string
164 (not forgetting the NUL at the end)
166 new_ps_array (length# +# 1#) `thenStrictlyST` \ ch_array ->
167 -- fill in packed string from "addr"
168 fill_in ch_array 0# `seqStrictlyST`
170 freeze_ps_array ch_array)
172 fill_in :: _MutableByteArray s Int -> Int# -> _ST s ()
176 = write_ps_array arr_in# idx (chr# 0#) `seqStrictlyST`
179 = case (indexCharArray# barr# (start# +# idx)) of { ch ->
180 write_ps_array arr_in# idx ch `seqStrictlyST`
181 fill_in arr_in# (idx +# 1#) }
185 (Very :-) ``Specialised'' versions of some CharArray things...
188 new_ps_array :: Int# -> _ST s (_MutableByteArray s Int)
189 write_ps_array :: _MutableByteArray s Int -> Int# -> Char# -> _ST s ()
190 freeze_ps_array :: _MutableByteArray s Int -> _ST s (_ByteArray Int)
194 case (newCharArray# size s) of { StateAndMutableByteArray# s2# barr# ->
195 (_MutableByteArray (0, max 0 (I# (size -# 1#))) barr#, S# s2#)})
197 write_ps_array (_MutableByteArray _ barr#) n ch =
199 case writeCharArray# barr# n ch s# of { s2# ->
202 -- same as unsafeFreezeByteArray
203 freeze_ps_array (_MutableByteArray ixs arr#) =
205 case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
206 (_ByteArray ixs frozen#, S# s2#) })
209 Compare two equal-length strings for equality:
212 eqStrPrefix :: Addr# -> ByteArray# -> Int# -> Bool
213 eqStrPrefix a# barr# len# =
214 unsafePerformPrimIO (
215 _ccall_ strncmp (A# a#) (_ByteArray bottom barr#) (I# len#) `thenPrimIO` \ (I# x#) ->
216 returnPrimIO (x# ==# 0#))
219 bottom = error "eqStrPrefix"
221 eqCharStrPrefix :: Addr# -> Addr# -> Int# -> Bool
222 eqCharStrPrefix a1# a2# len# =
223 unsafePerformPrimIO (
224 _ccall_ strncmp (A# a1#) (A# a2#) (I# len#) `thenPrimIO` \ (I# x#) ->
225 returnPrimIO (x# ==# 0#))
228 bottom = error "eqStrPrefix"
230 eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
231 eqStrPrefixBA b1# b2# start# len# =
232 unsafePerformPrimIO (
233 _casm_ ``%r=(int)strncmp((char *)%0+(int)%1,%2,%3); ''
234 (_ByteArray bottom b2#)
236 (_ByteArray bottom b1#)
237 (I# len#) `thenPrimIO` \ (I# x#) ->
238 returnPrimIO (x# ==# 0#))
241 bottom = error "eqStrPrefixBA"
243 eqCharStrPrefixBA :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
244 eqCharStrPrefixBA a# b2# start# len# =
245 unsafePerformPrimIO (
246 _casm_ ``%r=(int)strncmp((char *)%0+(int)%1,%2,%3); ''
247 (_ByteArray bottom b2#)
250 (I# len#) `thenPrimIO` \ (I# x#) ->
251 returnPrimIO (x# ==# 0#))
254 bottom = error "eqCharStrPrefixBA"
256 eqStrPrefixFO :: ForeignObj# -> ByteArray# -> Int# -> Int# -> Bool
257 eqStrPrefixFO fo# barr# start# len# =
258 unsafePerformPrimIO (
259 _casm_ ``%r=(int)strncmp((char *)%0+(int)%1,%2,%3); ''
262 (_ByteArray bottom barr#)
263 (I# len#) `thenPrimIO` \ (I# x#) ->
264 returnPrimIO (x# ==# 0#))
267 bottom = error "eqStrPrefixFO"
271 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 205
272 byteArrayToString :: _ByteArray Int -> String
273 byteArrayToString (_ByteArray (I# start#,I# end#) barr#) =
278 | otherwise = C# ch : unpack (nh# +# 1#)
280 ch = indexCharArray# barr# nh#
281 #elif defined(__GLASGOW_HASKELL__)
282 byteArrayToString :: _ByteArray Int -> String
283 byteArrayToString = unpackCStringBA
285 #error "byteArrayToString: cannot handle this!"
292 stringToByteArray :: String -> (_ByteArray Int)
293 #if __GLASGOW_HASKELL__ >= 206
294 stringToByteArray = packString
295 #elif defined(__GLASGOW_HASKELL__)
296 stringToByteArray str = _runST (packStringST str)
298 packStringST :: [Char] -> _ST s (_ByteArray Int)
300 let len = length str in
303 packNCharsST :: Int -> [Char] -> _ST s (_ByteArray Int)
304 packNCharsST len@(I# length#) str =
306 allocate an array that will hold the string
307 (not forgetting the NUL byte at the end)
309 new_ps_array (length# +# 1#) `thenStrictlyST` \ ch_array ->
310 -- fill in packed string from "str"
311 fill_in ch_array 0# str `seqStrictlyST`
313 freeze_ps_array ch_array `thenStrictlyST` \ (_ByteArray _ frozen#) ->
314 returnStrictlyST (_ByteArray (0,len) frozen#)
316 fill_in :: _MutableByteArray s Int -> Int# -> [Char] -> _ST s ()
317 fill_in arr_in# idx [] =
318 write_ps_array arr_in# idx (chr# 0#) `seqStrictlyST`
321 fill_in arr_in# idx (C# c : cs) =
322 write_ps_array arr_in# idx c `seqStrictlyST`
323 fill_in arr_in# (idx +# 1#) cs
325 #error "stringToByteArray: cannot handle this"