2 % (c) The GRASP/AQUA Project, Glasgow University, 1997
4 \section{String buffers}
6 Buffers for scanning string input stored in external arrays.
10 {-# OPTIONS -fno-prune-tydecls #-}
11 -- Don't really understand this!
12 -- ERROR: Can't see the data constructor(s) for _ccall_/_casm_ argument;
13 -- type: ForeignObj(try compiling with -fno-prune-tydecls ..)
21 hGetStringBuffer, -- :: FilePath -> IO StringBuffer
22 freeStringBuffer, -- :: StringBuffer -> IO ()
25 currentChar, -- :: StringBuffer -> Char
26 currentChar#, -- :: StringBuffer -> Char#
27 indexSBuffer, -- :: StringBuffer -> Int -> Char
28 indexSBuffer#, -- :: StringBuffer -> Int# -> Char#
29 -- relative lookup, i.e, currentChar = lookAhead 0
30 lookAhead, -- :: StringBuffer -> Int -> Char
31 lookAhead#, -- :: StringBuffer -> Int# -> Char#
33 -- moving the end point of the current lexeme.
34 setCurrentPos#, -- :: StringBuffer -> Int# -> StringBuffer
35 incLexeme, -- :: StringBuffer -> StringBuffer
36 decLexeme, -- :: StringBuffer -> StringBuffer
38 -- move the start and end lexeme pointer on by x units.
39 stepOn, -- :: StringBuffer -> StringBuffer
40 stepOnBy#, -- :: StringBuffer -> Int# -> StringBuffer
41 stepOnTo#, -- :: StringBuffer -> Int# -> StringBuffer
42 stepOnUntil, -- :: (Char -> Bool) -> StringBuffer -> StringBuffer
43 stepOverLexeme, -- :: StringBuffer -> StringBuffer
44 scanNumLit, -- :: Int -> StringBuffer -> (Int, StringBuffer)
45 expandWhile, -- :: (Char -> Bool) -> StringBuffer -> StringBuffer
46 expandUntilMatch, -- :: StrinBuffer -> String -> StringBuffer
47 -- at or beyond end of buffer?
48 bufferExhausted, -- :: StringBuffer -> Bool
49 emptyLexeme, -- :: StringBuffer -> Bool
52 prefixMatch, -- :: StringBuffer -> String -> Bool
53 untilEndOfString#, -- :: StringBuffer -> Int#
54 untilEndOfChar#, -- :: StringBuffer -> Int#
55 untilChar#, -- :: StringBuffer -> Char# -> Int#
58 lexemeToString, -- :: StringBuffer -> String
59 lexemeToByteArray, -- :: StringBuffer -> _ByteArray Int
60 lexemeToFastString, -- :: StringBuffer -> FastString
61 lexemeToBuffer, -- :: StringBuffer -> StringBuffer
67 #include "HsVersions.h"
70 import Addr ( Addr(..) )
73 import IO ( openFile, hFileSize, hClose, IOMode(..) )
75 #if __GLASGOW_HASKELL__ < 301
76 import IOBase ( IOError(..), IOErrorType(..) )
77 import IOHandle ( readHandle, writeHandle, filePtr )
78 import PackBase ( unpackCStringBA )
80 import PrelIOBase ( IOError(..), IOErrorType(..) )
81 import PrelHandle ( readHandle, writeHandle, filePtr )
82 import PrelPack ( unpackCStringBA )
94 -- ForeignObj# -- the data
101 instance Text StringBuffer where
102 showsPrec _ s = showString ""
106 hGetStringBuffer :: FilePath -> IO StringBuffer
107 hGetStringBuffer fname =
108 -- trace ("Renamer: opening " ++ fname) $
109 openFile fname ReadMode >>= \ hndl ->
110 hFileSize hndl >>= \ len@(J# _ _ d#) ->
111 let len_i = fromInteger len in
112 -- Allocate an array for system call to store its bytes into.
113 -- ToDo: make it robust
114 -- trace (show ((len_i::Int)+1)) $
115 _casm_ `` %r=(char *)malloc(sizeof(char)*(int)%0); '' (len_i::Int) >>= \ arr@(A# a#) ->
116 if addr2Int# a# ==# 0# then
117 failWith MkIOError(hndl,UserError,("hGetStringBuffer: Could not allocate "++show len_i ++ " bytes"))
120 -- _casm_ `` %r=NULL; '' >>= \ free_p ->
121 -- makeForeignObj arr free_p >>= \ fo@(_ForeignObj fo#) ->
122 readHandle hndl >>= \ hndl_ ->
123 writeHandle hndl hndl_ >>
124 let ptr = filePtr hndl_ in
125 _ccall_ fread arr (1::Int) len_i ptr >>= \ (I# read#) ->
126 -- trace ("DEBUG: opened " ++ fname ++ show (I# read#)) $
128 if read# ==# 0# then -- EOF or other error
129 failWith MkIOError(hndl,UserError,"hGetStringBuffer: EOF reached or some other error")
131 -- Add a sentinel NUL
132 _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' arr (I# (read# -# 1#)) >>= \ () ->
133 return (StringBuffer a# read# 0# 0#)
135 freeStringBuffer :: StringBuffer -> IO ()
136 freeStringBuffer (StringBuffer a# _ _ _) =
137 _casm_ `` free((char *)%0); '' (A# a#)
139 unsafeWriteBuffer :: StringBuffer -> Int# -> Char# -> StringBuffer
140 unsafeWriteBuffer s@(StringBuffer a _ _ _) i# ch# =
142 _casm_ `` ((char *)%0)[(int)%1]=(char)%2; '' (A# a) (I# i#) (C# ch#) >>= \ () ->
151 currentChar# :: StringBuffer -> Char#
152 currentChar# (StringBuffer fo# _ _ current#) = indexCharOffAddr# fo# current#
154 currentChar :: StringBuffer -> Char
155 currentChar sb = case currentChar# sb of c -> C# c
157 indexSBuffer# :: StringBuffer -> Int# -> Char#
158 indexSBuffer# (StringBuffer fo# _ _ _) i# = indexCharOffAddr# fo# i#
160 indexSBuffer :: StringBuffer -> Int -> Char
161 indexSBuffer sb (I# i#) = case indexSBuffer# sb i# of c -> C# c
163 -- relative lookup, i.e, currentChar = lookAhead 0
164 lookAhead# :: StringBuffer -> Int# -> Char#
165 lookAhead# (StringBuffer fo# _ _ c#) i# = indexCharOffAddr# fo# (c# +# i#)
167 lookAhead :: StringBuffer -> Int -> Char
168 lookAhead sb (I# i#) = case lookAhead# sb i# of c -> C# c
172 moving the start point of the current lexeme.
175 -- moving the end point of the current lexeme.
176 setCurrentPos# :: StringBuffer -> Int# -> StringBuffer
177 setCurrentPos# (StringBuffer fo l# s# c#) i# =
178 StringBuffer fo l# s# (c# +# i#)
180 -- augmenting the current lexeme by one.
181 incLexeme :: StringBuffer -> StringBuffer
182 incLexeme (StringBuffer fo l# s# c#) = StringBuffer fo l# s# (c# +# 1#)
184 decLexeme :: StringBuffer -> StringBuffer
185 decLexeme (StringBuffer fo l# s# c#) = StringBuffer fo l# s# (c# -# 1#)
189 -- move the start and end point of the buffer on by
193 stepOn :: StringBuffer -> StringBuffer
194 stepOn (StringBuffer fo l# s# c#) = StringBuffer fo l# (s# +# 1#) (s# +# 1#) -- assume they're the same.
196 stepOnBy# :: StringBuffer -> Int# -> StringBuffer
197 stepOnBy# (StringBuffer fo# l# s# c#) i# =
199 new_s# -> StringBuffer fo# l# new_s# new_s#
202 stepOnTo# :: StringBuffer -> Int# -> StringBuffer
203 stepOnTo# (StringBuffer fo l _ _) s# = StringBuffer fo l s# s#
205 stepOnUntil :: (Char -> Bool) -> StringBuffer -> StringBuffer
206 stepOnUntil pred (StringBuffer fo l# s# c#) =
210 case indexCharOffAddr# fo c# of
211 ch# | pred (C# ch#) -> StringBuffer fo l# c# c#
212 | ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# l# l# -- EOB, return immediately.
213 | otherwise -> loop (c# +# 1#)
215 stepOverLexeme :: StringBuffer -> StringBuffer
216 stepOverLexeme (StringBuffer fo l s# c#) = StringBuffer fo l c# c#
218 expandWhile :: (Char -> Bool) -> StringBuffer -> StringBuffer
219 expandWhile pred (StringBuffer fo l# s# c#) =
223 case indexCharOffAddr# fo c# of
224 ch# | pred (C# ch#) -> loop (c# +# 1#)
225 | ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# l# l# -- EOB, return immediately.
226 | otherwise -> StringBuffer fo l# s# c#
229 scanNumLit :: Int -> StringBuffer -> (Int,StringBuffer)
230 scanNumLit (I# acc#) (StringBuffer fo l# s# c#) =
234 case indexCharOffAddr# fo c# of
235 ch# | isDigit (C# ch#) -> loop (acc# *# 10# +# (ord# ch# -# ord# '0'#)) (c# +# 1#)
236 | ch# `eqChar#` '\NUL'# && c# >=# l# -> (I# acc#, StringBuffer fo l# l# l#) -- EOB, return immediately.
237 | otherwise -> (I# acc#,StringBuffer fo l# s# c#)
240 expandUntilMatch :: StringBuffer -> String -> StringBuffer
241 expandUntilMatch (StringBuffer fo l# s# c#) str =
244 loop c# [] = StringBuffer fo l# s# c#
245 loop c# ((C# x#):xs) =
246 if indexCharOffAddr# fo c# `eqChar#` x# then
253 -- at or beyond end of buffer?
254 bufferExhausted :: StringBuffer -> Bool
255 bufferExhausted (StringBuffer fo l# _ c#) = c# >=# l#
257 emptyLexeme :: StringBuffer -> Bool
258 emptyLexeme (StringBuffer fo l# s# c#) = s# ==# c#
261 prefixMatch :: StringBuffer -> String -> Maybe StringBuffer
262 prefixMatch (StringBuffer fo l# s# c#) str =
265 loop c# [] = Just (StringBuffer fo l# s# c#)
266 loop c# ((C# x#):xs) =
267 if indexCharOffAddr# fo c# `eqChar#` x# then
272 untilEndOfString# :: StringBuffer -> StringBuffer
273 untilEndOfString# (StringBuffer fo l# s# c#) =
277 case indexCharOffAddr# fo c# of
279 case indexCharOffAddr# fo (c# -# 1#) of
281 -- looks like an escaped something or other to me,
282 -- better count the number of "\\"s that are immediately
283 -- preceeding to decide if the " is escaped.
286 case indexCharOffAddr# fo i# of
287 '\\'# -> odd_slashes (not flg) (i# -# 1#)
290 if odd_slashes True (c# -# 2#) then
291 -- odd number, " is ecaped.
293 else -- a real end of string delimiter after all.
294 StringBuffer fo l# s# c#
295 _ -> StringBuffer fo l# s# c#
297 if c# >=# l# then -- hit sentinel, this doesn't look too good..
298 StringBuffer fo l# l# l#
304 untilEndOfChar# :: StringBuffer -> StringBuffer
305 untilEndOfChar# (StringBuffer fo l# s# c#) =
309 case indexCharOffAddr# fo c# of
311 case indexCharOffAddr# fo (c# -# 1#) of
313 case indexCharOffAddr# fo (c# -# 2#) of
314 '\\'# -> -- end of char
315 StringBuffer fo l# s# c#
316 _ -> loop (c# +# 1#) -- false alarm
317 _ -> StringBuffer fo l# s# c#
319 if c# >=# l# then -- hit sentinel, this doesn't look too good..
320 StringBuffer fo l# l# l#
325 untilChar# :: StringBuffer -> Char# -> StringBuffer
326 untilChar# (StringBuffer fo l# s# c#) x# =
330 if indexCharOffAddr# fo c# `eqChar#` x# then
331 StringBuffer fo l# s# c#
336 lexemeToString :: StringBuffer -> String
337 lexemeToString (StringBuffer fo _ start_pos# current#) =
338 if start_pos# ==# current# then
341 unpackCStringBA (copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#)))
343 lexemeToByteArray :: StringBuffer -> _ByteArray Int
344 lexemeToByteArray (StringBuffer fo _ start_pos# current#) =
345 if start_pos# ==# current# then
346 error "lexemeToByteArray"
348 copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#))
350 lexemeToFastString :: StringBuffer -> FastString
351 lexemeToFastString (StringBuffer fo l# start_pos# current#) =
352 if start_pos# ==# current# then
353 mkFastCharString2 (A# fo) (I# 0#)
355 mkFastSubString (A# fo) (I# start_pos#) (I# (current# -# start_pos#))
358 Create a StringBuffer from the current lexeme, and add a sentinel
359 at the end. Know What You're Doing before taking this function
362 lexemeToBuffer :: StringBuffer -> StringBuffer
363 lexemeToBuffer (StringBuffer fo l# start_pos# current#) =
364 if start_pos# ==# current# then
365 StringBuffer fo 0# start_pos# current# -- an error, really.
367 unsafeWriteBuffer (StringBuffer fo (current# -# start_pos#) start_pos# start_pos#)