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
11 {-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
14 Ptr(..), nullPtr, writeCharOffPtr, plusAddr#,
16 packString, -- :: String -> (Int, BA)
17 unpackNBytesBA, -- :: BA -> Int -> [Char]
18 strLength, -- :: Ptr CChar -> Int
19 copyPrefixStr, -- :: Addr# -> Int -> BA
20 copySubStr, -- :: Addr# -> Int -> Int -> BA
21 copySubStrBA, -- :: BA -> Int -> Int -> BA
22 eqStrPrefix, -- :: Addr# -> ByteArray# -> Int# -> Bool
23 eqCharStrPrefix, -- :: Addr# -> Addr# -> Int# -> Bool
24 eqStrPrefixBA, -- :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
25 eqCharStrPrefixBA, -- :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
28 -- This #define suppresses the "import FastString" that
29 -- HsVersions otherwise produces
30 #define COMPILING_FAST_STRING
31 #include "HsVersions.h"
34 import UNSAFE_IO ( unsafePerformIO )
39 #if __GLASGOW_HASKELL__ < 503
45 #if __GLASGOW_HASKELL__ >= 504
46 import GHC.Ptr ( Ptr(..) )
47 #elif __GLASGOW_HASKELL__ >= 500
48 import Ptr ( Ptr(..) )
51 #if __GLASGOW_HASKELL__ < 504
52 import PrelIOBase ( IO(..) )
54 import GHC.IOBase ( IO(..) )
58 Compatibility: 4.08 didn't have the Ptr type.
61 #if __GLASGOW_HASKELL__ <= 408
62 data Ptr a = Ptr Addr# deriving (Eq, Ord)
65 nullPtr = Ptr (int2Addr# 0#)
68 #if __GLASGOW_HASKELL__ <= 500
69 -- plusAddr# is a primop in GHC > 5.00
70 plusAddr# :: Addr# -> Int# -> Addr#
71 plusAddr# a# i# = int2Addr# (addr2Int# a# +# i#)
74 -- more compatibility: in 5.00+ we would use the Storable class for this,
75 -- but 4.08 doesn't have it.
76 writeCharOffPtr (Ptr a#) (I# i#) (C# c#) = IO $ \s# ->
77 case writeCharOffAddr# a# i# c# s# of { s# -> (# s#, () #) }
80 Wrapper types for bytearrays
83 data BA = BA ByteArray#
84 data MBA s = MBA (MutableByteArray# s)
88 packString :: String -> (Int, BA)
89 packString str = (l, arr)
91 l@(I# length#) = length str
94 ch_array <- new_ps_array length#
95 -- fill in packed string from "str"
96 fill_in ch_array 0# str
98 freeze_ps_array ch_array length#
101 fill_in :: MBA s -> Int# -> [Char] -> ST s ()
102 fill_in arr_in# idx [] =
104 fill_in arr_in# idx (C# c : cs) =
105 write_ps_array arr_in# idx c >>
106 fill_in arr_in# (idx +# 1#) cs
112 unpackNBytesBA :: BA -> Int -> [Char]
113 unpackNBytesBA (BA bytes) (I# len)
118 | otherwise = C# ch : unpack (nh +# 1#)
120 ch = indexCharArray# bytes nh
123 Copying a char string prefix into a byte array.
126 copyPrefixStr :: Addr# -> Int -> BA
127 copyPrefixStr a# len@(I# length#) = copy' length#
129 copy' length# = runST (do
130 {- allocate an array that will hold the string
132 ch_array <- new_ps_array length#
133 {- Revert back to Haskell-only solution for the moment.
134 _ccall_ memcpy ch_array (A# a) len >>= \ () ->
135 write_ps_array ch_array length# (chr# 0#) >>
137 -- fill in packed string from "addr"
140 freeze_ps_array ch_array length#
143 fill_in :: MBA s -> Int# -> ST s ()
148 = case (indexCharOffAddr# a# idx) of { ch ->
149 write_ps_array arr_in# idx ch >>
150 fill_in arr_in# (idx +# 1#) }
153 Copying out a substring, assume a 0-indexed string:
154 (and positive lengths, thank you).
157 copySubStr :: Addr# -> Int -> Int -> BA
158 copySubStr a# (I# start#) length =
159 copyPrefixStr (a# `plusAddr#` start#) length
161 copySubStrBA :: BA -> Int -> Int -> BA
162 copySubStrBA (BA barr#) (I# start#) len@(I# length#) = ba
165 -- allocate an array that will hold the string
166 ch_array <- new_ps_array length#
167 -- fill in packed string from "addr"
170 freeze_ps_array ch_array length#
173 fill_in :: MBA s -> Int# -> ST s ()
178 = case (indexCharArray# barr# (start# +# idx)) of { ch ->
179 write_ps_array arr_in# idx ch >>
180 fill_in arr_in# (idx +# 1#) }
183 (Very :-) ``Specialised'' versions of some CharArray things...
184 [Copied from PackBase; no real reason -- UGH]
187 new_ps_array :: Int# -> ST s (MBA s)
188 write_ps_array :: MBA s -> Int# -> Char# -> ST s ()
189 freeze_ps_array :: MBA s -> Int# -> ST s BA
191 #if __GLASGOW_HASKELL__ < 411
192 #define NEW_BYTE_ARRAY newCharArray#
194 #define NEW_BYTE_ARRAY newByteArray#
197 new_ps_array size = ST $ \ s ->
198 case (NEW_BYTE_ARRAY size s) of { (# s2#, barr# #) ->
199 (# s2#, MBA barr# #) }
201 write_ps_array (MBA barr#) n ch = ST $ \ s# ->
202 case writeCharArray# barr# n ch s# of { s2# ->
205 -- same as unsafeFreezeByteArray
206 freeze_ps_array (MBA arr#) len# = ST $ \ s# ->
207 case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
208 (# s2#, BA frozen# #) }
212 Compare two equal-length strings for equality:
215 eqStrPrefix :: Addr# -> ByteArray# -> Int# -> Bool
216 eqStrPrefix a# barr# len# =
218 x <- memcmp_ba a# barr# (I# len#)
222 eqCharStrPrefix :: Addr# -> Addr# -> Int# -> Bool
223 eqCharStrPrefix a1# a2# len# =
225 x <- memcmp a1# a2# (I# len#)
228 eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
229 eqStrPrefixBA b1# b2# start# len# =
231 x <- memcmp_baoff_ba b2# (I# start#) b1# (I# len#)
234 eqCharStrPrefixBA :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
235 eqCharStrPrefixBA a# b2# start# len# =
237 x <- memcmp_baoff b2# (I# start#) a# (I# len#)
242 #if __GLASGOW_HASKELL__ <= 408
243 strLength (Ptr a#) = ghc_strlen a#
244 foreign import ccall "ghc_strlen" unsafe
245 ghc_strlen :: Addr# -> Int
247 foreign import ccall "ghc_strlen" unsafe
248 strLength :: Ptr () -> Int
251 foreign import ccall "ghc_memcmp" unsafe
252 memcmp :: Addr# -> Addr# -> Int -> IO Int
254 foreign import ccall "ghc_memcmp" unsafe
255 memcmp_ba :: Addr# -> ByteArray# -> Int -> IO Int
257 foreign import ccall "ghc_memcmp_off" unsafe
258 memcmp_baoff :: ByteArray# -> Int -> Addr# -> Int -> IO Int
260 foreign import ccall "ghc_memcmp_off" unsafe
261 memcmp_baoff_ba :: ByteArray# -> Int -> ByteArray# -> Int -> IO Int