StringBuffer,
P, thenP, thenP_, returnP, mapP, failP, failMsgP,
- getSrcLocP, getSrcFile,
+ getSrcLocP, setSrcLocP, getSrcFile,
layoutOn, layoutOff, pushContext, popContext
) where
import StringBuffer
import GlaExts
import Ctype
-import Char ( ord )
+import Char ( chr, ord )
import PrelRead ( readRational__ ) -- Glasgow non-std
\end{code}
| ITthen
| ITtype
| ITwhere
- | ITscc
+ | ITscc -- ToDo: remove (we use {-# SCC "..." #-} now)
| ITforall -- GHC extension keywords
| ITforeign
| ITccallconv
| ITinterface -- interface keywords
- | ITexpr
| IT__export
| ITdepends
| IT__forall
| ITrules_prag
| ITdeprecated_prag
| ITline_prag
+ | ITscc_prag
| ITclose_prag
| ITdotdot -- reserved symbols
( "LINE", ITline_prag ),
( "RULES", ITrules_prag ),
( "RULEZ", ITrules_prag ), -- american spelling :-)
+ ( "SCC", ITscc_prag ),
( "DEPRECATED", ITdeprecated_prag )
]
( "then", ITthen ),
( "type", ITtype ),
( "where", ITwhere ),
- ( "_scc_", ITscc )
+ ( "_scc_", ITscc ) -- ToDo: remove
]
isSpecial :: Token -> Bool
-- interface keywords
("__interface", ITinterface),
- ("__expr", ITexpr),
("__export", IT__export),
("__depends", ITdepends),
("__forall", IT__forall),
-- special GHC extension: we grok cpp-style #line pragmas
'#'# | lexemeIndex buf ==# bol -> -- the '#' must be in column 0
- line_prag next_line (stepOn buf) s'
+ case expandWhile# is_space (stepOn buf) of { buf1 ->
+ if is_digit (currentChar# buf1)
+ then line_prag next_line buf1 s'
+ else is_a_token
+ }
where
next_line buf = lexer cont (stepOnUntilChar# buf '\n'#)
'#'# -> case lookAhead# buf 3# of
'#'# ->
let (lexeme, buf')
- = doDiscard False (stepOnBy# (stepOverLexeme buf) 4#) in
+ = doDiscard 0# (stepOnBy# (stepOverLexeme buf) 4#) in
cont (ITpragma lexeme) buf'
_ -> lex_prag cont (setCurrentPos# buf 3#)
_ -> cont ITocurly (incLexeme buf)
lex_string cont glaexts s buf
= case currentChar# buf of
'"'#{-"-} ->
- let buf' = incLexeme buf; s' = mkFastStringInt (reverse s) in
- case currentChar# buf' of
+ let buf' = incLexeme buf
+ s' = mkFastStringNarrow (map chr (reverse s))
+ in case currentChar# buf' of
'#'# | flag glaexts -> if all (<= 0xFF) s
then cont (ITprimstring s') (incLexeme buf')
- else lexError "primitive string literal must contain only characters <= '\xFF'" buf'
+ else lexError "primitive string literal must contain only characters <= \'\\xFF\'" buf'
_ -> cont (ITstring s') buf'
-- ignore \& in a string, deal with string gaps
[] -> charError buf'
after_charnum cont i buf
- = if i >= 0 && i <= 0x7FFFFFFF
+ = if i >= 0 && i <= 0x10FFFF
then cont (fromInteger i) buf
else charError buf
\end{code}
-----------------------------------------------------------------------------
-doDiscard rips along really fast, looking for a '#-}',
+doDiscard rips along really fast, looking for a '##-}',
indicating the end of the pragma we're skipping
\begin{code}
doDiscard inStr buf =
case currentChar# buf of
- '#'# | not inStr ->
+ '#'# | inStr ==# 0# ->
case lookAhead# buf 1# of { '#'# ->
case lookAhead# buf 2# of { '-'# ->
case lookAhead# buf 3# of { '}'# ->
_ -> doDiscard inStr (incLexeme buf) };
_ -> doDiscard inStr (incLexeme buf) };
_ -> doDiscard inStr (incLexeme buf) }
+
'"'# ->
let
odd_slashes buf flg i# =
case lookAhead# buf i# of
'\\'# -> odd_slashes buf (not flg) (i# -# 1#)
_ -> flg
+
+ not_inStr = if inStr ==# 0# then 1# else 0#
in
case lookAhead# buf (negateInt# 1#) of --backwards, actually
'\\'# -> -- escaping something..
- if odd_slashes buf True (negateInt# 2#) then
- -- odd number of slashes, " is escaped.
- doDiscard inStr (incLexeme buf)
- else
- -- even number of slashes, \ is escaped.
- doDiscard (not inStr) (incLexeme buf)
- _ -> case inStr of -- forced to avoid build-up
- True -> doDiscard False (incLexeme buf)
- False -> doDiscard True (incLexeme buf)
+ if odd_slashes buf True (negateInt# 2#)
+ then -- odd number of slashes, " is escaped.
+ doDiscard inStr (incLexeme buf)
+ else -- even number of slashes, \ is escaped.
+ doDiscard not_inStr (incLexeme buf)
+ _ -> doDiscard not_inStr (incLexeme buf)
+
+ '\''# | inStr ==# 0# ->
+ case lookAhead# buf 1# of { '"'# ->
+ case lookAhead# buf 2# of { '\''# ->
+ doDiscard inStr (setCurrentPos# buf 3#);
+ _ -> doDiscard inStr (incLexeme buf) };
+ _ -> doDiscard inStr (incLexeme buf) }
+
_ -> doDiscard inStr (incLexeme buf)
\end{code}
getSrcLocP :: P SrcLoc
getSrcLocP buf s@(PState{ loc = loc }) = POk s loc
+-- use a temporary SrcLoc for the duration of the argument
+setSrcLocP :: SrcLoc -> P a -> P a
+setSrcLocP new_loc p buf s =
+ case p buf s{ loc=new_loc } of
+ POk _ a -> POk s a
+ PFailed e -> PFailed e
+
getSrcFile :: P FAST_STRING
getSrcFile buf s@(PState{ loc = loc }) = POk s (srcLocFile loc)
-getContext :: P [LayoutContext]
-getContext buf s@(PState{ context = ctx }) = POk s ctx
-
pushContext :: LayoutContext -> P ()
pushContext ctxt buf s@(PState{ context = ctx }) = POk s{context = ctxt:ctx} ()