projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2001-05-08 11:55:24 by simonmar]
[ghc-hetmet.git]
/
ghc
/
compiler
/
parser
/
Lex.lhs
diff --git
a/ghc/compiler/parser/Lex.lhs
b/ghc/compiler/parser/Lex.lhs
index
8fdd6ad
..
1d02739
100644
(file)
--- a/
ghc/compiler/parser/Lex.lhs
+++ b/
ghc/compiler/parser/Lex.lhs
@@
-16,7
+16,7
@@
An example that provokes the error is
--------------------------------------------------------
\begin{code}
--------------------------------------------------------
\begin{code}
-
+{-# OPTIONS -#include "hs_ctype.h" #-}
module Lex (
ifaceParseErr, srcParseErr,
module Lex (
ifaceParseErr, srcParseErr,
@@
-27,7
+27,7
@@
module Lex (
StringBuffer,
P, thenP, thenP_, returnP, mapP, failP, failMsgP,
StringBuffer,
P, thenP, thenP_, returnP, mapP, failP, failMsgP,
- getSrcLocP, getSrcFile,
+ getSrcLocP, setSrcLocP, getSrcFile,
layoutOn, layoutOff, pushContext, popContext
) where
layoutOn, layoutOff, pushContext, popContext
) where
@@
-52,7
+52,7
@@
import FastString
import StringBuffer
import GlaExts
import Ctype
import StringBuffer
import GlaExts
import Ctype
-import Char ( ord )
+import Char ( chr, ord )
import PrelRead ( readRational__ ) -- Glasgow non-std
\end{code}
import PrelRead ( readRational__ ) -- Glasgow non-std
\end{code}
@@
-397,8
+397,7
@@
lexer cont buf s@(PState{
})
-- first, start a new lexeme and lose all the whitespace
})
-- first, start a new lexeme and lose all the whitespace
- = _scc_ "Lexer"
- tab line bol atbol (stepOverLexeme buf)
+ = tab line bol atbol (stepOverLexeme buf)
where
line = srcLocLine loc
where
line = srcLocLine loc
@@
-668,11
+667,12
@@
lex_prag cont buf
lex_string cont glaexts s buf
= case currentChar# buf of
'"'#{-"-} ->
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')
'#'# | 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
_ -> cont (ITstring s') buf'
-- ignore \& in a string, deal with string gaps
@@
-701,7
+701,7
@@
lex_char :: (Int# -> Int -> P a) -> Int# -> P a
lex_char cont glaexts buf
= case currentChar# buf of
'\\'# -> lex_escape (cont glaexts) (incLexeme buf)
lex_char cont glaexts buf
= case currentChar# buf of
'\\'# -> lex_escape (cont glaexts) (incLexeme buf)
- c | is_any c -> cont glaexts (I# (ord# c)) (incLexeme buf)
+ c | is_string c -> cont glaexts (I# (ord# c)) (incLexeme buf)
other -> charError buf
char_end cont glaexts c buf
other -> charError buf
char_end cont glaexts c buf
@@
-741,10
+741,7
@@
lex_escape cont buf
(c,buf2):_ -> cont (ord c) buf2
[] -> charError buf'
(c,buf2):_ -> cont (ord c) buf2
[] -> charError buf'
-after_charnum cont i buf
- = if i >= 0 && i <= 0x7FFFFFFF
- then cont (fromInteger i) buf
- else charError buf
+after_charnum cont i buf = cont (fromInteger i) buf
readNum cont buf is_digit base conv = read buf 0
where read buf i
readNum cont buf is_digit base conv = read buf 0
where read buf i
@@
-919,7
+916,7
@@
lex_id cont glaexts buf =
let lexeme = lexemeToFastString buf' in
let lexeme = lexemeToFastString buf' in
- case _scc_ "Lex.haskellKeyword" lookupUFM haskellKeywordsFM lexeme of {
+ case _scc_ "haskellKeyword" lookupUFM haskellKeywordsFM lexeme of {
Just kwd_token -> --trace ("hkeywd: "++_UNPK_(lexeme)) $
cont kwd_token buf';
Nothing ->
Just kwd_token -> --trace ("hkeywd: "++_UNPK_(lexeme)) $
cont kwd_token buf';
Nothing ->
@@
-1020,7
+1017,7
@@
lex_id3 cont glaexts mod buf just_a_conid
new_buf = mergeLexemes buf buf'
is_a_qvarid = cont (mk_qvar_token mod lexeme) new_buf
in
new_buf = mergeLexemes buf buf'
is_a_qvarid = cont (mk_qvar_token mod lexeme) new_buf
in
- case _scc_ "Lex.haskellKeyword" lookupUFM haskellKeywordsFM lexeme of {
+ case _scc_ "haskellKeyword" lookupUFM haskellKeywordsFM lexeme of {
Nothing -> is_a_qvarid ;
Just kwd_token | isSpecial kwd_token -- special ids (as, qualified, hiding) shouldn't be
Nothing -> is_a_qvarid ;
Just kwd_token | isSpecial kwd_token -- special ids (as, qualified, hiding) shouldn't be
@@
-1179,6
+1176,13
@@
lexError str buf s@PState{ loc = loc }
getSrcLocP :: P SrcLoc
getSrcLocP buf s@(PState{ loc = loc }) = POk s loc
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)
getSrcFile :: P FAST_STRING
getSrcFile buf s@(PState{ loc = loc }) = POk s (srcLocFile loc)