2 % (c) The GRASP/AQUA Project, Glasgow University, 1997
4 \section{Primitive operations for packed strings}
6 Core operations for working on a chunk of bytes.
7 These operations is the core set needed by the
8 GHC internally, the code generator and the prelude
12 #include "HsVersions.h"
16 strLength, -- :: _Addr -> Int
17 copyPrefixStr, -- :: _Addr -> Int -> _ByteArray Int
18 copySubStr, -- :: _Addr -> Int -> Int -> _ByteArray Int
19 copySubStrFO, -- :: ForeignObj -> Int -> Int -> _ByteArray Int
20 copySubStrBA, -- :: _ByteArray Int -> Int -> Int -> _ByteArray Int
21 --packString2, -- :: Addr -> Int -> _ByteArray Int
22 stringToByteArray, -- :: String -> _ByteArray Int
23 byteArrayToString, -- :: _ByteArray Int -> String
25 eqStrPrefix, -- :: Addr# -> ByteArray# -> Int# -> Bool
26 eqCharStrPrefix, -- :: Addr# -> Addr# -> Int# -> Bool
27 eqStrPrefixBA, -- :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
28 eqCharStrPrefixBA, -- :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
29 eqStrPrefixFO, -- :: ForeignObj# -> ByteArray# -> Int# -> Int# -> Bool
31 addrOffset#, -- :: Addr# -> Int# -> Addr#
32 indexCharOffFO# -- :: ForeignObj# -> Int# -> Char#
35 #if __GLASGOW_HASKELL__ <= 201
45 #if __GLASGOW_HASKELL__ == 202
46 import PrelBase ( Char(..) )
52 Return the length of a @\\NUL@ terminated character string:
55 strLength :: _Addr -> Int
58 _ccall_ strlen a `thenPrimIO` \ len@(I# _) ->
64 Copying a char string prefix into a byte array,
65 {\em assuming} the prefix does not contain any
69 copyPrefixStr :: _Addr -> Int -> _ByteArray Int
70 copyPrefixStr (A# a) len@(I# length#) =
72 {- allocate an array that will hold the string
73 (not forgetting the NUL at the end)
75 (new_ps_array (length# +# 1#)) `thenPrimIO` \ ch_array ->
76 _ccall_ memcpy ch_array (A# a) len `thenPrimIO` \ () ->
77 write_ps_array ch_array length# (chr# 0#) `seqPrimIO`
78 -- fill in packed string from "addr"
79 --fill_in ch_array 0# `seqPrimIO`
81 freeze_ps_array ch_array)
83 fill_in :: _MutableByteArray s Int -> Int# -> _ST s ()
87 = write_ps_array arr_in# idx (chr# 0#) `seqStrictlyST`
90 = case (indexCharOffAddr# a idx) of { ch ->
91 write_ps_array arr_in# idx ch `seqStrictlyST`
92 fill_in arr_in# (idx +# 1#) }
96 Copying out a substring, assume a 0-indexed string:
97 (and positive lengths, thank you).
100 copySubStr :: _Addr -> Int -> Int -> _ByteArray Int
101 copySubStr a start length =
102 unsafePerformPrimIO (
103 _casm_ `` %r= (char *)((char *)%0 + (int)%1); '' a start `thenPrimIO` \ a_start ->
104 returnPrimIO (copyPrefixStr a_start length))
107 Copying a sub-string out of a ForeignObj
110 copySubStrFO :: _ForeignObj -> Int -> Int -> _ByteArray Int
111 copySubStrFO (_ForeignObj fo) (I# start#) len@(I# length#) =
112 unsafePerformPrimIO (
113 {- allocate an array that will hold the string
114 (not forgetting the NUL at the end)
116 new_ps_array (length# +# 1#) `thenStrictlyST` \ ch_array ->
117 -- fill in packed string from "addr"
118 fill_in ch_array 0# `seqStrictlyST`
120 freeze_ps_array ch_array)
122 fill_in :: _MutableByteArray s Int -> Int# -> _ST s ()
126 = write_ps_array arr_in# idx (chr# 0#) `seqStrictlyST`
129 = case (indexCharOffFO# fo (idx +# start#)) of { ch ->
130 write_ps_array arr_in# idx ch `seqStrictlyST`
131 fill_in arr_in# (idx +# 1#) }
133 {- ToDo: add FO primitives.. -}
134 indexCharOffFO# :: ForeignObj# -> Int# -> Char#
135 indexCharOffFO# fo# i# =
136 case unsafePerformPrimIO (_casm_ ``%r=(char)*((char *)%0 + (int)%1); '' (_ForeignObj fo#) (I# i#)) of
139 addrOffset# :: Addr# -> Int# -> Addr#
141 case unsafePerformPrimIO (_casm_ ``%r=(char *)((char *)%0 + (int)%1); '' (A# a#) (I# i#)) of
144 copySubStrBA :: _ByteArray Int -> Int -> Int -> _ByteArray Int
145 copySubStrBA (_ByteArray _ barr#) (I# start#) len@(I# length#) =
146 unsafePerformPrimIO (
147 {- allocate an array that will hold the string
148 (not forgetting the NUL at the end)
150 new_ps_array (length# +# 1#) `thenStrictlyST` \ ch_array ->
151 -- fill in packed string from "addr"
152 fill_in ch_array 0# `seqStrictlyST`
154 freeze_ps_array ch_array)
156 fill_in :: _MutableByteArray s Int -> Int# -> _ST s ()
160 = write_ps_array arr_in# idx (chr# 0#) `seqStrictlyST`
163 = case (indexCharArray# barr# (start# +# idx)) of { ch ->
164 write_ps_array arr_in# idx ch `seqStrictlyST`
165 fill_in arr_in# (idx +# 1#) }
169 (Very :-) ``Specialised'' versions of some CharArray things...
172 new_ps_array :: Int# -> _ST s (_MutableByteArray s Int)
173 write_ps_array :: _MutableByteArray s Int -> Int# -> Char# -> _ST s ()
174 freeze_ps_array :: _MutableByteArray s Int -> _ST s (_ByteArray Int)
178 case (newCharArray# size s) of { StateAndMutableByteArray# s2# barr# ->
179 (_MutableByteArray (0, max 0 (I# (size -# 1#))) barr#, S# s2#)})
181 write_ps_array (_MutableByteArray _ barr#) n ch =
183 case writeCharArray# barr# n ch s# of { s2# ->
186 -- same as unsafeFreezeByteArray
187 freeze_ps_array (_MutableByteArray ixs arr#) =
189 case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
190 (_ByteArray ixs frozen#, S# s2#) })
193 Compare two equal-length strings for equality:
196 eqStrPrefix :: Addr# -> ByteArray# -> Int# -> Bool
197 eqStrPrefix a# barr# len# =
198 unsafePerformPrimIO (
199 _ccall_ strncmp (A# a#) (_ByteArray bottom barr#) (I# len#) `thenPrimIO` \ (I# x#) ->
200 returnPrimIO (x# ==# 0#))
203 bottom = error "eqStrPrefix"
205 eqCharStrPrefix :: Addr# -> Addr# -> Int# -> Bool
206 eqCharStrPrefix a1# a2# len# =
207 unsafePerformPrimIO (
208 _ccall_ strncmp (A# a1#) (A# a2#) (I# len#) `thenPrimIO` \ (I# x#) ->
209 returnPrimIO (x# ==# 0#))
212 bottom = error "eqStrPrefix"
214 eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
215 eqStrPrefixBA b1# b2# start# len# =
216 unsafePerformPrimIO (
217 _casm_ ``%r=(int)strncmp((char *)%0+(int)%1,%2,%3); ''
218 (_ByteArray bottom b2#)
220 (_ByteArray bottom b1#)
221 (I# len#) `thenPrimIO` \ (I# x#) ->
222 returnPrimIO (x# ==# 0#))
225 bottom = error "eqStrPrefixBA"
227 eqCharStrPrefixBA :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
228 eqCharStrPrefixBA a# b2# start# len# =
229 unsafePerformPrimIO (
230 _casm_ ``%r=(int)strncmp((char *)%0+(int)%1,%2,%3); ''
231 (_ByteArray bottom b2#)
234 (I# len#) `thenPrimIO` \ (I# x#) ->
235 returnPrimIO (x# ==# 0#))
238 bottom = error "eqCharStrPrefixBA"
240 eqStrPrefixFO :: ForeignObj# -> ByteArray# -> Int# -> Int# -> Bool
241 eqStrPrefixFO fo# barr# start# len# =
242 unsafePerformPrimIO (
243 _casm_ ``%r=(int)strncmp((char *)%0+(int)%1,%2,%3); ''
246 (_ByteArray bottom barr#)
247 (I# len#) `thenPrimIO` \ (I# x#) ->
248 returnPrimIO (x# ==# 0#))
251 bottom = error "eqStrPrefixFO"
255 byteArrayToString :: _ByteArray Int -> String
256 byteArrayToString (_ByteArray (I# start#,I# end#) barr#) =
261 | otherwise = C# ch : unpack (nh# +# 1#)
263 ch = indexCharArray# barr# nh#
269 stringToByteArray :: String -> (_ByteArray Int)
270 stringToByteArray str = _runST (packStringST str)
272 packStringST :: [Char] -> _ST s (_ByteArray Int)
274 let len = length str in
277 packNCharsST :: Int -> [Char] -> _ST s (_ByteArray Int)
278 packNCharsST len@(I# length#) str =
280 allocate an array that will hold the string
281 (not forgetting the NUL byte at the end)
283 new_ps_array (length# +# 1#) `thenStrictlyST` \ ch_array ->
284 -- fill in packed string from "str"
285 fill_in ch_array 0# str `seqStrictlyST`
287 freeze_ps_array ch_array `thenStrictlyST` \ (_ByteArray _ frozen#) ->
288 returnStrictlyST (_ByteArray (0,len) frozen#)
290 fill_in :: _MutableByteArray s Int -> Int# -> [Char] -> _ST s ()
291 fill_in arr_in# idx [] =
292 write_ps_array arr_in# idx (chr# 0#) `seqStrictlyST`
295 fill_in arr_in# idx (C# c : cs) =
296 write_ps_array arr_in# idx c `seqStrictlyST`
297 fill_in arr_in# (idx +# 1#) cs