2 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
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
13 strLength, -- :: _Addr -> Int
14 copyPrefixStr, -- :: _Addr -> Int -> ByteArray Int
15 copySubStr, -- :: _Addr -> Int -> Int -> ByteArray Int
16 copySubStrBA, -- :: ByteArray Int -> Int -> Int -> ByteArray Int
18 eqStrPrefix, -- :: Addr# -> ByteArray# -> Int# -> Bool
19 eqCharStrPrefix, -- :: Addr# -> Addr# -> Int# -> Bool
20 eqStrPrefixBA, -- :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
21 eqCharStrPrefixBA, -- :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
23 addrOffset# -- :: Addr# -> Int# -> Addr#
26 -- This #define suppresses the "import FastString" that
27 -- HsVersions otherwise produces
28 #define COMPILING_FAST_STRING
29 #include "HsVersions.h"
32 #if __GLASGOW_HASKELL__ < 411
33 import PrelAddr ( Addr(..) )
35 import Addr ( Addr(..) )
40 #if __GLASGOW_HASKELL__ < 301
41 import ArrBase ( StateAndMutableByteArray#(..),
42 StateAndByteArray#(..) )
44 #elif __GLASGOW_HASKELL__ < 400
45 import PrelArr ( StateAndMutableByteArray#(..),
46 StateAndByteArray#(..) )
54 Return the length of a @\\NUL@ terminated character string:
57 strLength :: Addr -> Int
60 _ccall_ strlen a >>= \ len@(I# _) ->
63 {-# NOINLINE strLength #-}
66 Copying a char string prefix into a byte array,
67 {\em assuming} the prefix does not contain any
71 copyPrefixStr :: Addr -> Int -> ByteArray Int
72 copyPrefixStr (A# a) len@(I# length#) =
74 {- allocate an array that will hold the string
75 (not forgetting the NUL at the end)
77 (new_ps_array (length# +# 1#)) >>= \ ch_array ->
78 {- Revert back to Haskell-only solution for the moment.
79 _ccall_ memcpy ch_array (A# a) len >>= \ () ->
80 write_ps_array ch_array length# (chr# 0#) >>
82 -- fill in packed string from "addr"
83 fill_in ch_array 0# >>
85 freeze_ps_array ch_array length# >>= \ barr ->
88 fill_in :: MutableByteArray s Int -> Int# -> ST s ()
92 = write_ps_array arr_in# idx (chr# 0#) >>
95 = case (indexCharOffAddr# a idx) of { ch ->
96 write_ps_array arr_in# idx ch >>
97 fill_in arr_in# (idx +# 1#) }
101 Copying out a substring, assume a 0-indexed string:
102 (and positive lengths, thank you).
105 copySubStr :: Addr -> Int -> Int -> ByteArray Int
106 copySubStr a start length =
108 _casm_ `` %r= (char *)((char *)%0 + (int)%1); '' a start
110 return (copyPrefixStr a_start length))
112 -- step on (char *) pointer by x units.
113 addrOffset# :: Addr# -> Int# -> Addr#
115 case unsafePerformIO (_casm_ ``%r=(char *)((char *)%0 + (int)%1); '' (A# a#) (I# i#)) of
118 copySubStrBA :: ByteArray Int -> Int -> Int -> ByteArray Int
119 #if __GLASGOW_HASKELL__ >= 405
120 copySubStrBA (ByteArray _ _ barr#) (I# start#) len@(I# length#) =
122 copySubStrBA (ByteArray _ barr#) (I# start#) len@(I# length#) =
125 {- allocate an array that will hold the string
126 (not forgetting the NUL at the end)
128 new_ps_array (length# +# 1#) >>= \ ch_array ->
129 -- fill in packed string from "addr"
130 fill_in ch_array 0# >>
132 freeze_ps_array ch_array length#)
134 fill_in :: MutableByteArray s Int -> Int# -> ST s ()
138 = write_ps_array arr_in# idx (chr# 0#) >>
141 = case (indexCharArray# barr# (start# +# idx)) of { ch ->
142 write_ps_array arr_in# idx ch >>
143 fill_in arr_in# (idx +# 1#) }
146 (Very :-) ``Specialised'' versions of some CharArray things...
147 [Copied from PackBase; no real reason -- UGH]
150 new_ps_array :: Int# -> ST s (MutableByteArray s Int)
151 write_ps_array :: MutableByteArray s Int -> Int# -> Char# -> ST s ()
152 freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
154 new_ps_array size = ST $ \ s ->
155 #if __GLASGOW_HASKELL__ < 400
156 case (newCharArray# size s) of { StateAndMutableByteArray# s2# barr# ->
157 STret s2# (MutableByteArray bot barr#) }
158 #elif __GLASGOW_HASKELL__ < 405
159 case (newCharArray# size s) of { (# s2#, barr# #) ->
160 (# s2#, MutableByteArray bot barr# #) }
161 #elif __GLASGOW_HASKELL__ < 411
162 case (newCharArray# size s) of { (# s2#, barr# #) ->
163 (# s2#, MutableByteArray bot bot barr# #) }
164 #else /* 411 and higher */
165 case (newByteArray# size s) of { (# s2#, barr# #) ->
166 (# s2#, MutableByteArray bot bot barr# #) }
169 bot = error "new_ps_array"
171 #if __GLASGOW_HASKELL__ < 400
172 write_ps_array (MutableByteArray _ barr#) n ch = ST $ \ s# ->
173 case writeCharArray# barr# n ch s# of { s2# ->
175 #elif __GLASGOW_HASKELL__ < 405
176 write_ps_array (MutableByteArray _ barr#) n ch = ST $ \ s# ->
177 case writeCharArray# barr# n ch s# of { s2# ->
180 write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# ->
181 case writeCharArray# barr# n ch s# of { s2# ->
185 -- same as unsafeFreezeByteArray
186 #if __GLASGOW_HASKELL__ < 400
187 freeze_ps_array (MutableByteArray _ arr#) len# = ST $ \ s# ->
188 case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
189 STret s2# (ByteArray (0,I# len#) frozen#) }
190 #elif __GLASGOW_HASKELL__ < 405
191 freeze_ps_array (MutableByteArray _ arr#) len# = ST $ \ s# ->
192 case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
193 (# s2#, ByteArray (0,I# len#) frozen# #) }
195 freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# ->
196 case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
197 (# s2#, ByteArray 0 (I# len#) frozen# #) }
202 Compare two equal-length strings for equality:
205 eqStrPrefix :: Addr# -> ByteArray# -> Int# -> Bool
206 eqStrPrefix a# barr# len# =
208 #if __GLASGOW_HASKELL__ < 405
209 _ccall_ strncmp (A# a#) (ByteArray bot barr#) (I# len#) >>= \ (I# x#) ->
211 _ccall_ strncmp (A# a#) (ByteArray bot bot barr#) (I# len#) >>= \ (I# x#) ->
215 #if __GLASGOW_HASKELL__ < 405
220 bot = error "eqStrPrefix"
222 eqCharStrPrefix :: Addr# -> Addr# -> Int# -> Bool
223 eqCharStrPrefix a1# a2# len# =
225 _ccall_ strncmp (A# a1#) (A# a2#) (I# len#) >>= \ (I# x#) ->
228 eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
229 eqStrPrefixBA b1# b2# start# len# =
231 _casm_ ``%r=(int)strncmp((char *)%0+(int)%1,%2,%3); ''
232 #if __GLASGOW_HASKELL__ < 405
235 (ByteArray bot bot b2#)
238 #if __GLASGOW_HASKELL__ < 405
241 (ByteArray bot bot b1#)
243 (I# len#) >>= \ (I# x#) ->
246 #if __GLASGOW_HASKELL__ < 405
251 bot = error "eqStrPrefixBA"
253 eqCharStrPrefixBA :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
254 eqCharStrPrefixBA a# b2# start# len# =
256 _casm_ ``%r=(int)strncmp((char *)%0+(int)%1,%2,%3); ''
257 #if __GLASGOW_HASKELL__ < 405
260 (ByteArray bot bot b2#)
264 (I# len#) >>= \ (I# x#) ->
267 #if __GLASGOW_HASKELL__ < 405
272 bot = error "eqCharStrPrefixBA"