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-18 09:18:05 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
..
336a1b3
100644
(file)
--- a/
ghc/compiler/parser/Lex.lhs
+++ b/
ghc/compiler/parser/Lex.lhs
@@
-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}
@@
-668,11
+668,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
@@
-742,7
+743,7
@@
lex_escape cont buf
[] -> charError buf'
after_charnum cont i buf
[] -> 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
then cont (fromInteger i) buf
else charError buf
@@
-1179,12
+1180,16
@@
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)
-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} ()
pushContext :: LayoutContext -> P ()
pushContext ctxt buf s@(PState{ context = ctx }) = POk s{context = ctxt:ctx} ()