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, plusAddr#,
16 packString, -- :: String -> (Int, BA)
17 unpackNBytesBA, -- :: BA -> Int -> [Char]
18 strLength, -- :: Ptr CChar -> Int
19 copyPrefixStr, -- :: Addr# -> Int -> BA
20 copySubStrBA, -- :: BA -> Int -> Int -> BA
21 eqStrPrefix, -- :: Addr# -> ByteArray# -> Int# -> Bool
22 eqStrPrefixBA, -- :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
25 -- This #define suppresses the "import FastString" that
26 -- HsVersions otherwise produces
27 #define COMPILING_FAST_STRING
28 #include "HsVersions.h"
31 import UNSAFE_IO ( unsafePerformIO )
36 #if __GLASGOW_HASKELL__ < 503
42 #if __GLASGOW_HASKELL__ >= 504
43 import GHC.Ptr ( Ptr(..) )
44 #elif __GLASGOW_HASKELL__ >= 500
45 import Ptr ( Ptr(..) )
48 #if __GLASGOW_HASKELL__ < 504
49 import PrelIOBase ( IO(..) )
51 import GHC.IOBase ( IO(..) )
55 Compatibility: 4.08 didn't have the Ptr type.
58 #if __GLASGOW_HASKELL__ <= 408
59 data Ptr a = Ptr Addr# deriving (Eq, Ord)
62 nullPtr = Ptr (int2Addr# 0#)
65 #if __GLASGOW_HASKELL__ <= 500
66 -- plusAddr# is a primop in GHC > 5.00
67 plusAddr# :: Addr# -> Int# -> Addr#
68 plusAddr# a# i# = int2Addr# (addr2Int# a# +# i#)
72 Wrapper types for bytearrays
75 data BA = BA ByteArray#
76 data MBA s = MBA (MutableByteArray# s)
80 packString :: String -> (Int, BA)
81 packString str = (l, arr)
83 l@(I# length#) = length str
86 ch_array <- new_ps_array length#
87 -- fill in packed string from "str"
88 fill_in ch_array 0# str
90 freeze_ps_array ch_array length#
93 fill_in :: MBA s -> Int# -> [Char] -> ST s ()
94 fill_in arr_in# idx [] =
96 fill_in arr_in# idx (C# c : cs) =
97 write_ps_array arr_in# idx c >>
98 fill_in arr_in# (idx +# 1#) cs
104 unpackNBytesBA :: BA -> Int -> [Char]
105 unpackNBytesBA (BA bytes) (I# len)
110 | otherwise = C# ch : unpack (nh +# 1#)
112 ch = indexCharArray# bytes nh
115 Copying a char string prefix into a byte array.
118 copyPrefixStr :: Addr# -> Int -> BA
119 copyPrefixStr a# len@(I# length#) = copy' length#
121 copy' length# = runST (do
122 {- allocate an array that will hold the string
124 ch_array <- new_ps_array length#
125 {- Revert back to Haskell-only solution for the moment.
126 _ccall_ memcpy ch_array (A# a) len >>= \ () ->
127 write_ps_array ch_array length# (chr# 0#) >>
129 -- fill in packed string from "addr"
132 freeze_ps_array ch_array length#
135 fill_in :: MBA s -> Int# -> ST s ()
140 = case (indexCharOffAddr# a# idx) of { ch ->
141 write_ps_array arr_in# idx ch >>
142 fill_in arr_in# (idx +# 1#) }
145 Copying out a substring, assume a 0-indexed string:
146 (and positive lengths, thank you).
150 copySubStr :: Addr# -> Int -> Int -> BA
151 copySubStr a# (I# start#) length =
152 copyPrefixStr (a# `plusAddr#` start#) length
155 copySubStrBA :: BA -> Int -> Int -> BA
156 copySubStrBA (BA barr#) (I# start#) len@(I# length#) = ba
159 -- allocate an array that will hold the string
160 ch_array <- new_ps_array length#
161 -- fill in packed string from "addr"
164 freeze_ps_array ch_array length#
167 fill_in :: MBA s -> Int# -> ST s ()
172 = case (indexCharArray# barr# (start# +# idx)) of { ch ->
173 write_ps_array arr_in# idx ch >>
174 fill_in arr_in# (idx +# 1#) }
177 (Very :-) ``Specialised'' versions of some CharArray things...
178 [Copied from PackBase; no real reason -- UGH]
181 new_ps_array :: Int# -> ST s (MBA s)
182 write_ps_array :: MBA s -> Int# -> Char# -> ST s ()
183 freeze_ps_array :: MBA s -> Int# -> ST s BA
185 #if __GLASGOW_HASKELL__ < 411
186 #define NEW_BYTE_ARRAY newCharArray#
188 #define NEW_BYTE_ARRAY newPinnedByteArray#
191 new_ps_array size = ST $ \ s ->
192 case (NEW_BYTE_ARRAY size s) of { (# s2#, barr# #) ->
193 (# s2#, MBA barr# #) }
195 write_ps_array (MBA barr#) n ch = ST $ \ s# ->
196 case writeCharArray# barr# n ch s# of { s2# ->
199 -- same as unsafeFreezeByteArray
200 freeze_ps_array (MBA arr#) len# = ST $ \ s# ->
201 case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
202 (# s2#, BA frozen# #) }
206 Compare two equal-length strings for equality:
209 eqStrPrefix :: Addr# -> ByteArray# -> Int# -> Bool
210 eqStrPrefix a# barr# len# =
212 x <- memcmp_ba a# barr# (I# len#)
216 eqCharStrPrefix :: Addr# -> Addr# -> Int# -> Bool
217 eqCharStrPrefix a1# a2# len# =
219 x <- memcmp a1# a2# (I# len#)
223 eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
224 eqStrPrefixBA b1# b2# start# len# =
226 x <- memcmp_baoff_ba b2# (I# start#) b1# (I# len#)
230 eqCharStrPrefixBA :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
231 eqCharStrPrefixBA a# b2# start# len# =
233 x <- memcmp_baoff b2# (I# start#) a# (I# len#)
239 -- Just like unsafePerformIO, but we inline it. This is safe when
240 -- there are no side effects, and improves performance.
241 {-# INLINE inlinePerformIO #-}
242 inlinePerformIO :: IO a -> a
243 inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
245 #if __GLASGOW_HASKELL__ <= 408
246 strLength (Ptr a#) = ghc_strlen a#
247 foreign import ccall unsafe "ghc_strlen"
248 ghc_strlen :: Addr# -> Int
250 foreign import ccall unsafe "ghc_strlen"
251 strLength :: Ptr () -> Int
254 foreign import ccall unsafe "ghc_memcmp"
255 memcmp :: Addr# -> Addr# -> Int -> IO Int
257 foreign import ccall unsafe "ghc_memcmp"
258 memcmp_ba :: Addr# -> ByteArray# -> Int -> IO Int
260 foreign import ccall unsafe "ghc_memcmp_off"
261 memcmp_baoff :: ByteArray# -> Int -> Addr# -> Int -> IO Int
263 foreign import ccall unsafe "ghc_memcmp_off"
264 memcmp_baoff_ba :: ByteArray# -> Int -> ByteArray# -> Int -> IO Int