2 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
4 \section{String buffers}
6 Buffers for scanning string input stored in external arrays.
9 {-# OPTIONS -fno-prune-tydecls #-}
15 hGetStringBuffer, -- :: FilePath -> IO StringBuffer
18 currentChar, -- :: StringBuffer -> Char
19 currentChar#, -- :: StringBuffer -> Char#
20 indexSBuffer, -- :: StringBuffer -> Int -> Char
21 indexSBuffer#, -- :: StringBuffer -> Int# -> Char#
22 -- relative lookup, i.e, currentChar = lookAhead 0
23 lookAhead, -- :: StringBuffer -> Int -> Char
24 lookAhead#, -- :: StringBuffer -> Int# -> Char#
26 -- moving the end point of the current lexeme.
27 setCurrentPos#, -- :: StringBuffer -> Int# -> StringBuffer
28 incLexeme, -- :: StringBuffer -> StringBuffer
29 decLexeme, -- :: StringBuffer -> StringBuffer
31 -- move the start and end lexeme pointer on by x units.
32 stepOn, -- :: StringBuffer -> StringBuffer
33 stepOnBy#, -- :: StringBuffer -> Int# -> StringBuffer
34 stepOnTo#, -- :: StringBuffer -> Int# -> StringBuffer
35 stepOnUntil, -- :: (Char -> Bool) -> StringBuffer -> StringBuffer
36 stepOverLexeme, -- :: StringBuffer -> StringBuffer
37 scanNumLit, -- :: Int -> StringBuffer -> (Int, StringBuffer)
38 expandWhile, -- :: (Char -> Bool) -> StringBuffer -> StringBuffer
39 expandWhile#, -- :: (Char# -> Bool) -> StringBuffer -> StringBuffer
40 expandUntilMatch, -- :: StrinBuffer -> String -> StringBuffer
41 -- at or beyond end of buffer?
42 bufferExhausted, -- :: StringBuffer -> Bool
43 emptyLexeme, -- :: StringBuffer -> Bool
46 prefixMatch, -- :: StringBuffer -> String -> Bool
47 untilEndOfString#, -- :: StringBuffer -> Int#
48 untilEndOfChar#, -- :: StringBuffer -> Int#
49 untilChar#, -- :: StringBuffer -> Char# -> Int#
52 lexemeToString, -- :: StringBuffer -> String
53 lexemeToByteArray, -- :: StringBuffer -> _ByteArray Int
54 lexemeToFastString, -- :: StringBuffer -> FastString
55 lexemeToBuffer, -- :: StringBuffer -> StringBuffer
61 #include "HsVersions.h"
64 import Addr ( Addr(..) )
68 #if __GLASGOW_HASKELL__ >= 303
69 import IO ( slurpFile )
71 import IO ( openFile, hFileSize, hClose, IOMode(..) )
74 #if __GLASGOW_HASKELL__ < 301
75 import IOBase ( IOError(..), IOErrorType(..) )
76 import IOHandle ( readHandle, writeHandle, filePtr )
77 import PackBase ( unpackCStringBA )
79 # if __GLASGOW_HASKELL__ <= 302
80 import PrelIOBase ( IOError(..), IOErrorType(..) )
81 import PrelHandle ( readHandle, writeHandle, filePtr )
83 import PrelPack ( unpackCStringBA )
101 instance Text StringBuffer where
102 showsPrec _ s = showString ""
106 hGetStringBuffer :: FilePath -> IO StringBuffer
107 hGetStringBuffer fname =
108 #if __GLASGOW_HASKELL__ >= 303
109 slurpFile fname >>= \ (a , read) ->
113 _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' a (I# (read# -# 1#)) >>= \ () ->
114 return (StringBuffer a# read# 0# 0#)
116 openFile fname ReadMode >>= \ hndl ->
117 hFileSize hndl >>= \ len@(J# _ _ d#) ->
118 let len_i = fromInteger len in
119 -- Allocate an array for system call to store its bytes into.
120 -- ToDo: make it robust
121 -- trace (show ((len_i::Int)+1)) $
122 _casm_ `` %r=(char *)malloc(sizeof(char)*(int)%0); '' (len_i::Int) >>= \ arr@(A# a#) ->
123 if addr2Int# a# ==# 0# then
124 fail (userError ("hGetStringBuffer: Could not allocate "++show len_i ++ " bytes"))
126 readHandle hndl >>= \ hndl_ ->
127 writeHandle hndl hndl_ >>
128 let ptr = filePtr hndl_ in
129 #if __GLASGOW_HASKELL__ <= 302
130 _ccall_ fread arr (1::Int) len_i (ptr::ForeignObj) >>= \ (I# read#) ->
132 _ccall_ fread arr (1::Int) len_i (ptr::Addr) >>= \ (I# read#) ->
135 if read# ==# 0# then -- EOF or some other error
136 fail (userError ("hGetStringBuffer: failed to slurp in interface file "++fname))
138 -- Add a sentinel NUL
139 _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' arr (I# (read# -# 1#)) >>= \ () ->
140 return (StringBuffer a# read# 0# 0#)
144 unsafeWriteBuffer :: StringBuffer -> Int# -> Char# -> StringBuffer
145 unsafeWriteBuffer s@(StringBuffer a _ _ _) i# ch# =
147 _casm_ `` ((char *)%0)[(int)%1]=(char)%2; '' (A# a) (I# i#) (C# ch#) >>= \ () ->
155 currentChar :: StringBuffer -> Char
156 currentChar sb = case currentChar# sb of c -> C# c
158 lookAhead :: StringBuffer -> Int -> Char
159 lookAhead sb (I# i#) = case lookAhead# sb i# of c -> C# c
161 indexSBuffer :: StringBuffer -> Int -> Char
162 indexSBuffer sb (I# i#) = case indexSBuffer# sb i# of c -> C# c
164 currentChar# :: StringBuffer -> Char#
165 indexSBuffer# :: StringBuffer -> Int# -> Char#
166 lookAhead# :: StringBuffer -> Int# -> Char#
167 currentChar# (StringBuffer fo# _ _ current#) = indexCharOffAddr# fo# current#
168 indexSBuffer# (StringBuffer fo# _ _ _) i# = indexCharOffAddr# fo# i#
170 -- relative lookup, i.e, currentChar = lookAhead 0
171 lookAhead# (StringBuffer fo# _ _ c#) i# = indexCharOffAddr# fo# (c# +# i#)
175 moving the start point of the current lexeme.
178 -- moving the end point of the current lexeme.
179 setCurrentPos# :: StringBuffer -> Int# -> StringBuffer
180 setCurrentPos# (StringBuffer fo l# s# c#) i# =
181 StringBuffer fo l# s# (c# +# i#)
183 -- augmenting the current lexeme by one.
184 incLexeme :: StringBuffer -> StringBuffer
185 incLexeme (StringBuffer fo l# s# c#) = StringBuffer fo l# s# (c# +# 1#)
187 decLexeme :: StringBuffer -> StringBuffer
188 decLexeme (StringBuffer fo l# s# c#) = StringBuffer fo l# s# (c# -# 1#)
192 -- move the start and end point of the buffer on by
196 stepOn :: StringBuffer -> StringBuffer
197 stepOn (StringBuffer fo l# s# c#) = StringBuffer fo l# (s# +# 1#) (s# +# 1#) -- assume they're the same.
199 stepOnBy# :: StringBuffer -> Int# -> StringBuffer
200 stepOnBy# (StringBuffer fo# l# s# c#) i# =
202 new_s# -> StringBuffer fo# l# new_s# new_s#
205 stepOnTo# :: StringBuffer -> Int# -> StringBuffer
206 stepOnTo# (StringBuffer fo l _ _) s# = StringBuffer fo l s# s#
208 stepOnUntil :: (Char -> Bool) -> StringBuffer -> StringBuffer
210 stepOnUntil pred (StringBuffer fo l# s# c#) =
214 case indexCharOffAddr# fo c# of
215 ch# | pred (C# ch#) -> StringBuffer fo l# c# c#
216 | ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# l# l# -- EOB, return immediately.
217 | otherwise -> loop (c# +# 1#)
219 stepOverLexeme :: StringBuffer -> StringBuffer
220 stepOverLexeme (StringBuffer fo l s# c#) = StringBuffer fo l c# c#
222 expandWhile :: (Char -> Bool) -> StringBuffer -> StringBuffer
223 expandWhile pred (StringBuffer fo l# s# c#) =
227 case indexCharOffAddr# fo c# of
228 ch# | pred (C# ch#) -> loop (c# +# 1#)
229 | ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# l# l# -- EOB, return immediately.
230 | otherwise -> StringBuffer fo l# s# c#
232 expandWhile# :: (Char# -> Bool) -> StringBuffer -> StringBuffer
233 expandWhile# pred (StringBuffer fo l# s# c#) =
237 case indexCharOffAddr# fo c# of
238 ch# | pred ch# -> loop (c# +# 1#)
239 | ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# s# c# -- EOB, return immediately.
240 | otherwise -> StringBuffer fo l# s# c#
242 scanNumLit :: Int -> StringBuffer -> (Int,StringBuffer)
243 scanNumLit (I# acc#) (StringBuffer fo l# s# c#) =
247 case indexCharOffAddr# fo c# of
248 ch# | isDigit (C# ch#) -> loop (acc# *# 10# +# (ord# ch# -# ord# '0'#)) (c# +# 1#)
249 | ch# `eqChar#` '\NUL'# && c# >=# l# -> (I# acc#, StringBuffer fo l# s# c#) -- EOB, return immediately.
250 | otherwise -> (I# acc#,StringBuffer fo l# s# c#)
253 expandUntilMatch :: StringBuffer -> String -> StringBuffer
254 expandUntilMatch (StringBuffer fo l# s# c#) str =
257 loop c# [] = StringBuffer fo l# s# c#
259 | indexCharOffAddr# fo c# `eqChar#` x#
262 = loop (c# +# 1#) str
267 -- at or beyond end of buffer?
268 bufferExhausted :: StringBuffer -> Bool
269 bufferExhausted (StringBuffer fo l# _ c#) = c# >=# l#
271 emptyLexeme :: StringBuffer -> Bool
272 emptyLexeme (StringBuffer fo l# s# c#) = s# ==# c#
275 prefixMatch :: StringBuffer -> String -> Maybe StringBuffer
276 prefixMatch (StringBuffer fo l# s# c#) str =
279 loop c# [] = Just (StringBuffer fo l# s# c#)
281 | indexCharOffAddr# fo c# `eqChar#` x#
286 untilEndOfString# :: StringBuffer -> StringBuffer
287 untilEndOfString# (StringBuffer fo l# s# c#) =
290 getch# i# = indexCharOffAddr# fo i#
295 case getch# (c# -# 1#) of
297 -- looks like an escaped something or other to me,
298 -- better count the number of "\\"s that are immediately
299 -- preceeding to decide if the " is escaped.
303 '\\'# -> odd_slashes (not flg) (i# -# 1#)
306 if odd_slashes True (c# -# 2#) then
307 -- odd number, " is ecaped.
309 else -- a real end of string delimiter after all.
310 StringBuffer fo l# s# c#
311 _ -> StringBuffer fo l# s# c#
313 if c# >=# l# then -- hit sentinel, this doesn't look too good..
314 StringBuffer fo l# l# l#
320 untilEndOfChar# :: StringBuffer -> StringBuffer
321 untilEndOfChar# (StringBuffer fo l# s# c#) =
324 getch# i# = indexCharOffAddr# fo i#
329 case getch# (c# -# 1#) of
331 case getch# (c# -# 2#) of
332 '\\'# -> -- end of char
333 StringBuffer fo l# s# c#
334 _ -> loop (c# +# 1#) -- false alarm
335 _ -> StringBuffer fo l# s# c#
337 if c# >=# l# then -- hit sentinel, this doesn't look too good..
338 StringBuffer fo l# l# l#
343 untilChar# :: StringBuffer -> Char# -> StringBuffer
344 untilChar# (StringBuffer fo l# s# c#) x# =
348 | indexCharOffAddr# fo c# `eqChar#` x#
349 = StringBuffer fo l# s# c#
354 lexemeToString :: StringBuffer -> String
355 lexemeToString (StringBuffer fo _ start_pos# current#) =
356 if start_pos# ==# current# then
359 unpackCStringBA (copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#)))
361 lexemeToByteArray :: StringBuffer -> _ByteArray Int
362 lexemeToByteArray (StringBuffer fo _ start_pos# current#) =
363 if start_pos# ==# current# then
364 error "lexemeToByteArray"
366 copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#))
368 lexemeToFastString :: StringBuffer -> FastString
369 lexemeToFastString (StringBuffer fo l# start_pos# current#) =
370 if start_pos# ==# current# then
371 mkFastCharString2 (A# fo) (I# 0#)
373 mkFastSubString (A# fo) (I# start_pos#) (I# (current# -# start_pos#))
376 Create a StringBuffer from the current lexeme, and add a sentinel
377 at the end. Know What You're Doing before taking this function
380 lexemeToBuffer :: StringBuffer -> StringBuffer
381 lexemeToBuffer (StringBuffer fo l# start_pos# current#) =
382 if start_pos# ==# current# then
383 StringBuffer fo 0# start_pos# current# -- an error, really.
385 unsafeWriteBuffer (StringBuffer fo (current# -# start_pos#) start_pos# start_pos#)