Rename 'doDiscard' to 'lexPragma', and make it EOF-resistant.
As was, it would run off the end of a StringBuffer (and SIGSEGV,
most likely) if a pragma wasn't properly closed.
where
line = srcLocLine loc
where
line = srcLocLine loc
- tab y bol atbol buf = -- trace ("tab: " ++ show (I# y) ++ " : " ++ show (currentChar buf)) $
+ tab y bol atbol buf = --trace ("tab: " ++ show (I# y) ++ " : " ++ show (currentChar buf)) $
case currentChar# buf of
'\NUL'# ->
case currentChar# buf of
'\NUL'# ->
lexToken :: (Token -> P a) -> Int# -> P a
lexToken cont glaexts buf =
lexToken :: (Token -> P a) -> Int# -> P a
lexToken cont glaexts buf =
case currentChar# buf of
-- special symbols ----------------------------------------------------
case currentChar# buf of
-- special symbols ----------------------------------------------------
'-'# -> case lookAhead# buf 2# of
'#'# -> case lookAhead# buf 3# of
'#'# ->
'-'# -> case lookAhead# buf 2# of
'#'# -> case lookAhead# buf 3# of
'#'# ->
- let (lexeme, buf')
- = doDiscard 0# (stepOnBy# (stepOverLexeme buf) 4#) in
- cont (ITpragma lexeme) buf'
+ lexPragma
+ cont
+ (\ cont lexeme buf' -> cont (ITpragma lexeme) buf')
+ 0#
+ (stepOnBy# (stepOverLexeme buf) 4#)
_ -> lex_prag cont (setCurrentPos# buf 3#)
_ -> cont ITocurly (incLexeme buf)
_ -> (layoutOff `thenP_` cont ITocurly) (incLexeme buf)
_ -> lex_prag cont (setCurrentPos# buf 3#)
_ -> cont ITocurly (incLexeme buf)
_ -> (layoutOff `thenP_` cont ITocurly) (incLexeme buf)
\end{code}
-----------------------------------------------------------------------------
\end{code}
-----------------------------------------------------------------------------
-doDiscard rips along really fast, looking for a '##-}',
+'lexPragma' rips along really fast, looking for a '##-}',
indicating the end of the pragma we're skipping
\begin{code}
indicating the end of the pragma we're skipping
\begin{code}
+lexPragma cont contf inStr buf =
case currentChar# buf of
'#'# | inStr ==# 0# ->
case lookAhead# buf 1# of { '#'# ->
case lookAhead# buf 2# of { '-'# ->
case lookAhead# buf 3# of { '}'# ->
case currentChar# buf of
'#'# | inStr ==# 0# ->
case lookAhead# buf 1# of { '#'# ->
case lookAhead# buf 2# of { '-'# ->
case lookAhead# buf 3# of { '}'# ->
- (lexemeToBuffer buf, stepOverLexeme (setCurrentPos# buf 4#));
- _ -> doDiscard inStr (incLexeme buf) };
- _ -> doDiscard inStr (incLexeme buf) };
- _ -> doDiscard inStr (incLexeme buf) }
+ contf cont (lexemeToBuffer buf)
+ (stepOverLexeme (setCurrentPos# buf 4#));
+ _ -> lexPragma cont contf inStr (incLexeme buf) };
+ _ -> lexPragma cont contf inStr (incLexeme buf) };
+ _ -> lexPragma cont contf inStr (incLexeme buf) }
'\\'# -> -- escaping something..
if odd_slashes buf True (negateInt# 2#)
then -- odd number of slashes, " is escaped.
'\\'# -> -- escaping something..
if odd_slashes buf True (negateInt# 2#)
then -- odd number of slashes, " is escaped.
- doDiscard inStr (incLexeme buf)
+ lexPragma cont contf inStr (incLexeme buf)
else -- even number of slashes, \ is escaped.
else -- even number of slashes, \ is escaped.
- doDiscard not_inStr (incLexeme buf)
- _ -> doDiscard not_inStr (incLexeme buf)
+ lexPragma cont contf not_inStr (incLexeme buf)
+ _ -> lexPragma cont contf not_inStr (incLexeme buf)
'\''# | inStr ==# 0# ->
case lookAhead# buf 1# of { '"'# ->
case lookAhead# buf 2# of { '\''# ->
'\''# | 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) }
+ lexPragma cont contf inStr (setCurrentPos# buf 3#);
+ _ -> lexPragma cont contf inStr (incLexeme buf) };
+ _ -> lexPragma cont contf inStr (incLexeme buf) }
- _ -> doDiscard inStr (incLexeme buf)
+ -- a sign that the input is ill-formed, since pragmas are
+ -- assumed to always be properly closed (in .hi files).
+ '\NUL'# -> trace "lexPragma: unexpected end-of-file" $
+ cont (ITunknown "\NUL") buf
+
+ _ -> lexPragma cont contf inStr (incLexeme buf)