%
-% (c) The GRASP/AQUA Project, Glasgow University, 1997
+% (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
%
\section{String buffers}
Buffers for scanning string input stored in external arrays.
\begin{code}
-
{-# OPTIONS -fno-prune-tydecls #-}
--- Don't really understand this!
--- ERROR: Can't see the data constructor(s) for _ccall_/_casm_ argument;
--- type: ForeignObj(try compiling with -fno-prune-tydecls ..)
-
-
module StringBuffer
(
StringBuffer,
-- creation
hGetStringBuffer, -- :: FilePath -> IO StringBuffer
- freeStringBuffer, -- :: StringBuffer -> IO ()
-- Lookup
currentChar, -- :: StringBuffer -> Char
stepOnUntil, -- :: (Char -> Bool) -> StringBuffer -> StringBuffer
stepOverLexeme, -- :: StringBuffer -> StringBuffer
scanNumLit, -- :: Int -> StringBuffer -> (Int, StringBuffer)
- expandWhile, -- :: (Char -> Bool) -> StringBuffer -> StringBuffer
+ expandWhile, -- :: (Char -> Bool) -> StringBuffer -> StringBuffer
+ expandWhile#, -- :: (Char# -> Bool) -> StringBuffer -> StringBuffer
expandUntilMatch, -- :: StrinBuffer -> String -> StringBuffer
-- at or beyond end of buffer?
bufferExhausted, -- :: StringBuffer -> Bool
import GlaExts
import Addr ( Addr(..) )
import Foreign
-import IOBase
-import IOHandle
import ST
-import STBase
-import Char (isDigit)
-import PackBase
+
+#if __GLASGOW_HASKELL__ >= 303
+import IO ( slurpFile )
+#else
+import IO ( openFile, hFileSize, hClose, IOMode(..) )
+#endif
+
+#if __GLASGOW_HASKELL__ < 301
+import IOBase ( IOError(..), IOErrorType(..) )
+import IOHandle ( readHandle, writeHandle, filePtr )
+import PackBase ( unpackCStringBA )
+#else
+# if __GLASGOW_HASKELL__ <= 302
+import PrelIOBase ( IOError(..), IOErrorType(..) )
+import PrelHandle ( readHandle, writeHandle, filePtr )
+# endif
+import PrelPack ( unpackCStringBA )
+#endif
+
import PrimPacked
import FastString
-
+import Char (isDigit)
\end{code}
\begin{code}
data StringBuffer
= StringBuffer
Addr#
--- ForeignObj# -- the data
Int# -- length
Int# -- lexeme start
Int# -- current pos
\begin{code}
hGetStringBuffer :: FilePath -> IO StringBuffer
hGetStringBuffer fname =
--- trace ("Renamer: opening " ++ fname) $
+#if __GLASGOW_HASKELL__ >= 303
+ slurpFile fname >>= \ (a , read) ->
+ let (A# a#) = a
+ (I# read#) = read
+ in
+ _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' a (I# (read# -# 1#)) >>= \ () ->
+ return (StringBuffer a# read# 0# 0#)
+#else
openFile fname ReadMode >>= \ hndl ->
- hFileSize hndl >>= \ len@(J# _ _ d#) ->
+ hFileSize hndl >>= \ len ->
let len_i = fromInteger len in
-- Allocate an array for system call to store its bytes into.
-- ToDo: make it robust
-- trace (show ((len_i::Int)+1)) $
_casm_ `` %r=(char *)malloc(sizeof(char)*(int)%0); '' (len_i::Int) >>= \ arr@(A# a#) ->
if addr2Int# a# ==# 0# then
- failWith MkIOError(hndl,UserError,("hGetStringBuffer: Could not allocate "++show len_i ++ " bytes"))
+ fail (userError ("hGetStringBuffer: Could not allocate "++show len_i ++ " bytes"))
else
-
--- _casm_ `` %r=NULL; '' >>= \ free_p ->
--- makeForeignObj arr free_p >>= \ fo@(_ForeignObj fo#) ->
- readHandle hndl >>= \ hndl_ ->
- writeHandle hndl hndl_ >>
- let ptr = _filePtr hndl_ in
- _ccall_ fread arr (1::Int) len_i ptr >>= \ (I# read#) ->
--- trace ("DEBUG: opened " ++ fname ++ show (I# read#)) $
+ readHandle hndl >>= \ hndl_ ->
+ writeHandle hndl hndl_ >>
+ let ptr = filePtr hndl_ in
+#if __GLASGOW_HASKELL__ <= 302
+ _ccall_ fread arr (1::Int) len_i (ptr::ForeignObj) >>= \ (I# read#) ->
+#else
+ _ccall_ fread arr (1::Int) len_i (ptr::Addr) >>= \ (I# read#) ->
+#endif
hClose hndl >>
- if read# ==# 0# then -- EOF or other error
- failWith MkIOError(hndl,UserError,"hGetStringBuffer: EOF reached or some other error")
+ if read# ==# 0# then -- EOF or some other error
+ fail (userError ("hGetStringBuffer: failed to slurp in interface file "++fname))
else
-- Add a sentinel NUL
_casm_ `` ((char *)%0)[(int)%1]=(char)0; '' arr (I# (read# -# 1#)) >>= \ () ->
return (StringBuffer a# read# 0# 0#)
-freeStringBuffer :: StringBuffer -> IO ()
-freeStringBuffer (StringBuffer a# _ _ _) =
- _casm_ `` free((char *)%0); '' (A# a#)
+#endif
unsafeWriteBuffer :: StringBuffer -> Int# -> Char# -> StringBuffer
unsafeWriteBuffer s@(StringBuffer a _ _ _) i# ch# =
_casm_ `` ((char *)%0)[(int)%1]=(char)%2; '' (A# a) (I# i#) (C# ch#) >>= \ () ->
return s
)
-
\end{code}
Lookup
\begin{code}
-currentChar# :: StringBuffer -> Char#
-currentChar# (StringBuffer fo# _ _ current#) = indexCharOffAddr# fo# current#
-
currentChar :: StringBuffer -> Char
currentChar sb = case currentChar# sb of c -> C# c
-indexSBuffer# :: StringBuffer -> Int# -> Char#
-indexSBuffer# (StringBuffer fo# _ _ _) i# = indexCharOffAddr# fo# i#
+lookAhead :: StringBuffer -> Int -> Char
+lookAhead sb (I# i#) = case lookAhead# sb i# of c -> C# c
indexSBuffer :: StringBuffer -> Int -> Char
indexSBuffer sb (I# i#) = case indexSBuffer# sb i# of c -> C# c
- -- relative lookup, i.e, currentChar = lookAhead 0
+currentChar# :: StringBuffer -> Char#
+indexSBuffer# :: StringBuffer -> Int# -> Char#
lookAhead# :: StringBuffer -> Int# -> Char#
-lookAhead# (StringBuffer fo# _ _ c#) i# = indexCharOffAddr# fo# (c# +# i#)
+currentChar# (StringBuffer fo# _ _ current#) = indexCharOffAddr# fo# current#
+indexSBuffer# (StringBuffer fo# _ _ _) i# = indexCharOffAddr# fo# i#
-lookAhead :: StringBuffer -> Int -> Char
-lookAhead sb (I# i#) = case lookAhead# sb i# of c -> C# c
+ -- relative lookup, i.e, currentChar = lookAhead 0
+lookAhead# (StringBuffer fo# _ _ c#) i# = indexCharOffAddr# fo# (c# +# i#)
\end{code}
stepOnTo# (StringBuffer fo l _ _) s# = StringBuffer fo l s# s#
stepOnUntil :: (Char -> Bool) -> StringBuffer -> StringBuffer
+
stepOnUntil pred (StringBuffer fo l# s# c#) =
loop c#
where
| ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# l# l# -- EOB, return immediately.
| otherwise -> StringBuffer fo l# s# c#
+expandWhile# :: (Char# -> Bool) -> StringBuffer -> StringBuffer
+expandWhile# pred (StringBuffer fo l# s# c#) =
+ loop c#
+ where
+ loop c# =
+ case indexCharOffAddr# fo c# of
+ ch# | pred ch# -> loop (c# +# 1#)
+ | ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# s# c# -- EOB, return immediately.
+ | otherwise -> StringBuffer fo l# s# c#
scanNumLit :: Int -> StringBuffer -> (Int,StringBuffer)
scanNumLit (I# acc#) (StringBuffer fo l# s# c#) =
loop acc# c# =
case indexCharOffAddr# fo c# of
ch# | isDigit (C# ch#) -> loop (acc# *# 10# +# (ord# ch# -# ord# '0'#)) (c# +# 1#)
- | ch# `eqChar#` '\NUL'# && c# >=# l# -> (I# acc#, StringBuffer fo l# l# l#) -- EOB, return immediately.
+ | ch# `eqChar#` '\NUL'# && c# >=# l# -> (I# acc#, StringBuffer fo l# s# c#) -- EOB, return immediately.
| otherwise -> (I# acc#,StringBuffer fo l# s# c#)
loop c# str
where
loop c# [] = StringBuffer fo l# s# c#
- loop c# ((C# x#):xs) =
- if indexCharOffAddr# fo c# `eqChar#` x# then
- loop (c# +# 1#) xs
- else
- loop (c# +# 1#) str
+ loop c# ((C# x#):xs)
+ | indexCharOffAddr# fo c# `eqChar#` x#
+ = loop (c# +# 1#) xs
+ | otherwise
+ = loop (c# +# 1#) str
+
\end{code}
\begin{code}
loop c# str
where
loop c# [] = Just (StringBuffer fo l# s# c#)
- loop c# ((C# x#):xs) =
- if indexCharOffAddr# fo c# `eqChar#` x# then
- loop (c# +# 1#) xs
- else
- Nothing
+ loop c# ((C# x#):xs)
+ | indexCharOffAddr# fo c# `eqChar#` x#
+ = loop (c# +# 1#) xs
+ | otherwise
+ = Nothing
untilEndOfString# :: StringBuffer -> StringBuffer
untilEndOfString# (StringBuffer fo l# s# c#) =
loop c#
where
+ getch# i# = indexCharOffAddr# fo i#
+
loop c# =
- case indexCharOffAddr# fo c# of
+ case getch# c# of
'\"'# ->
- case indexCharOffAddr# fo (c# -# 1#) of
+ case getch# (c# -# 1#) of
'\\'# ->
-- looks like an escaped something or other to me,
-- better count the number of "\\"s that are immediately
-- preceeding to decide if the " is escaped.
let
odd_slashes flg i# =
- case indexCharOffAddr# fo i# of
+ case getch# i# of
'\\'# -> odd_slashes (not flg) (i# -# 1#)
_ -> flg
in
untilEndOfChar# (StringBuffer fo l# s# c#) =
loop c#
where
+ getch# i# = indexCharOffAddr# fo i#
+
loop c# =
- case indexCharOffAddr# fo c# of
+ case getch# c# of
'\''# ->
- case indexCharOffAddr# fo (c# -# 1#) of
+ case getch# (c# -# 1#) of
'\\'# ->
- case indexCharOffAddr# fo (c# -# 2#) of
+ case getch# (c# -# 2#) of
'\\'# -> -- end of char
StringBuffer fo l# s# c#
_ -> loop (c# +# 1#) -- false alarm
untilChar# (StringBuffer fo l# s# c#) x# =
loop c#
where
- loop c# =
- if indexCharOffAddr# fo c# `eqChar#` x# then
- StringBuffer fo l# s# c#
- else
- loop (c# +# 1#)
+ loop c#
+ | indexCharOffAddr# fo c# `eqChar#` x#
+ = StringBuffer fo l# s# c#
+ | otherwise
+ = loop (c# +# 1#)
-- conversion
lexemeToString :: StringBuffer -> String
projects / ghc-hetmet.git / blobdiff