-----------------------------------------------------------------------------
The lexer.

(c) 1993-2001 Andy Gill, Simon Marlow
-----------------------------------------------------------------------------

> module Happy.Frontend.Lexer (
>       Token(..),
>       TokenId(..),
>       HasLexer(..) ) where

> import Happy.Frontend.ParseMonad.Class

> import Data.Char ( isSpace, isAlphaNum, isDigit, digitToInt )

> data Token
>       = TokenInfo String TokenId
>       | TokenNum  Int    TokenId
>       | TokenKW          TokenId
>       | TokenEOF

> tokenToId :: Token -> TokenId
> tokenToId :: Token -> TokenId
tokenToId (TokenInfo String
_ TokenId
i) = TokenId
i
> tokenToId (TokenNum Int
_ TokenId
i) = TokenId
i
> tokenToId (TokenKW TokenId
i) = TokenId
i
> tokenToId Token
TokenEOF = String -> TokenId
forall a. HasCallStack => String -> a
error String
"tokenToId TokenEOF"

> instance Eq Token where
>       Token
i == :: Token -> Token -> Bool
== Token
i' = Token -> TokenId
tokenToId Token
i TokenId -> TokenId -> Bool
forall a. Eq a => a -> a -> Bool
== Token -> TokenId
tokenToId Token
i'

> instance Ord Token where
>       Token
i <= :: Token -> Token -> Bool
<= Token
i' = Token -> TokenId
tokenToId Token
i TokenId -> TokenId -> Bool
forall a. Ord a => a -> a -> Bool
<= Token -> TokenId
tokenToId Token
i'

> data TokenId
>       = TokId                 -- words and symbols
>       | TokSpecId_TokenType   -- %tokentype
>       | TokSpecId_Token       -- %token
>       | TokSpecId_Name        -- %name
>       | TokSpecId_Partial     -- %partial
>       | TokSpecId_Lexer       -- %lexer
>       | TokSpecId_ImportedIdentity -- %importedidentity
>       | TokSpecId_Monad       -- %monad
>       | TokSpecId_Nonassoc    -- %nonassoc
>       | TokSpecId_Left        -- %left
>       | TokSpecId_Right       -- %right
>       | TokSpecId_Prec        -- %prec
>       | TokSpecId_Shift       -- %shift
>       | TokSpecId_Expect      -- %expect
>       | TokSpecId_Error       -- %error
>       | TokSpecId_ErrorExpected -- %error.expected
>       | TokSpecId_ErrorHandlerType -- %errorhandlertype
>       | TokSpecId_Attributetype -- %attributetype
>       | TokSpecId_Attribute   -- %attribute
>       | TokCodeQuote          -- stuff inside { .. }
>       | TokColon              -- :
>       | TokSemiColon          -- ;
>       | TokDoubleColon        -- ::
>       | TokDoublePercent      -- %%
>       | TokBar                -- |
>       | TokNum                -- Integer
>       | TokParenL             -- (
>       | TokParenR             -- )
>       | TokComma              -- ,
>       deriving (TokenId -> TokenId -> Bool
(TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> Bool) -> Eq TokenId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TokenId -> TokenId -> Bool
== :: TokenId -> TokenId -> Bool
$c/= :: TokenId -> TokenId -> Bool
/= :: TokenId -> TokenId -> Bool
Eq,Eq TokenId
Eq TokenId =>
(TokenId -> TokenId -> Ordering)
-> (TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> TokenId)
-> (TokenId -> TokenId -> TokenId)
-> Ord TokenId
TokenId -> TokenId -> Bool
TokenId -> TokenId -> Ordering
TokenId -> TokenId -> TokenId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TokenId -> TokenId -> Ordering
compare :: TokenId -> TokenId -> Ordering
$c< :: TokenId -> TokenId -> Bool
< :: TokenId -> TokenId -> Bool
$c<= :: TokenId -> TokenId -> Bool
<= :: TokenId -> TokenId -> Bool
$c> :: TokenId -> TokenId -> Bool
> :: TokenId -> TokenId -> Bool
$c>= :: TokenId -> TokenId -> Bool
>= :: TokenId -> TokenId -> Bool
$cmax :: TokenId -> TokenId -> TokenId
max :: TokenId -> TokenId -> TokenId
$cmin :: TokenId -> TokenId -> TokenId
min :: TokenId -> TokenId -> TokenId
Ord,Int -> TokenId -> ShowS
[TokenId] -> ShowS
TokenId -> String
(Int -> TokenId -> ShowS)
-> (TokenId -> String) -> ([TokenId] -> ShowS) -> Show TokenId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenId -> ShowS
showsPrec :: Int -> TokenId -> ShowS
$cshow :: TokenId -> String
show :: TokenId -> String
$cshowList :: [TokenId] -> ShowS
showList :: [TokenId] -> ShowS
Show)

ToDo: proper text instance here, for use in parser error messages.

> instance HasLexer Token where
>   lexToken :: forall r. (Token -> Pfunc r) -> Pfunc r
lexToken = (Token -> Pfunc r) -> Pfunc r
forall r. (Token -> Pfunc r) -> Pfunc r
lexer

> lexer :: (Token -> Pfunc a) -> Pfunc a
> lexer :: forall r. (Token -> Pfunc r) -> Pfunc r
lexer Token -> Pfunc a
cont = Pfunc a
lexer'
>   where lexer' :: Pfunc a
lexer' String
"" = Token -> Pfunc a
cont Token
TokenEOF String
""
>         lexer' (Char
'-':Char
'-':String
r) = Pfunc a
lexer' ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
r)
>         lexer' (Char
'{':Char
'-':String
r) = \Int
line -> Int -> Pfunc a -> Pfunc a
forall a.
Int
-> (String -> Int -> ParseResult a)
-> String
-> Int
-> ParseResult a
lexNestedComment Int
line Pfunc a
lexer' String
r Int
line
>         lexer' (Char
c:String
rest) = (Token -> Pfunc a) -> Char -> Pfunc a
forall a. (Token -> Pfunc a) -> Char -> Pfunc a
nextLex Token -> Pfunc a
cont Char
c String
rest

> nextLex :: (Token -> Pfunc a) -> Char -> String -> Int -> ParseResult a
> nextLex :: forall a. (Token -> Pfunc a) -> Char -> Pfunc a
nextLex Token -> Pfunc a
cont Char
c = case Char
c of
>       Char
'\n'    -> \String
rest Int
line -> (Token -> Pfunc a) -> Pfunc a
forall r. (Token -> Pfunc r) -> Pfunc r
lexer Token -> Pfunc a
cont String
rest (Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
>       Char
'%'     -> (Token -> Pfunc a) -> Pfunc a
forall r. (Token -> Pfunc r) -> Pfunc r
lexPercent Token -> Pfunc a
cont
>       Char
':'     -> (Token -> Pfunc a) -> Pfunc a
forall r. (Token -> Pfunc r) -> Pfunc r
lexColon Token -> Pfunc a
cont
>       Char
';'     -> Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSemiColon)

>       Char
'|'     -> Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokBar)
>       Char
'\''    -> (Token -> Pfunc a) -> Pfunc a
forall r. (Token -> Pfunc r) -> Pfunc r
lexChar Token -> Pfunc a
cont
>       Char
'"'{-"-}-> (Token -> Pfunc a) -> Pfunc a
forall r. (Token -> Pfunc r) -> Pfunc r
lexString Token -> Pfunc a
cont
>       Char
'{'     -> (Token -> Pfunc a) -> Pfunc a
forall r. (Token -> Pfunc r) -> Pfunc r
lexCode Token -> Pfunc a
cont

>       Char
'('     -> Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokParenL)
>       Char
')'     -> Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokParenR)
>       Char
','     -> Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokComma)

>       Char
_
>         | Char -> Bool
isSpace Char
c -> (Token -> Pfunc a) -> Pfunc a
forall r. (Token -> Pfunc r) -> Pfunc r
lexer Token -> Pfunc a
cont
>         |  Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z'
>            Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z' -> (Token -> Pfunc a) -> Char -> Pfunc a
forall a. (Token -> Pfunc a) -> Char -> Pfunc a
lexId Token -> Pfunc a
cont Char
c
>         | Char -> Bool
isDigit Char
c -> (Token -> Pfunc a) -> Char -> Pfunc a
forall a. (Token -> Pfunc a) -> Char -> Pfunc a
lexNum Token -> Pfunc a
cont Char
c
>       Char
_       -> String -> Pfunc a
forall a. String -> String -> Int -> ParseResult a
lexError (String
"lexical error before `" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
"'")

Percents come in two forms, in pairs, or
followed by a special identifier.

> lexPercent :: (Token -> Pfunc a) -> [Char] -> Int -> ParseResult a
> lexPercent :: forall r. (Token -> Pfunc r) -> Pfunc r
lexPercent Token -> Pfunc a
cont String
s = case String
s of
>       Char
'%':String
rest -> Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokDoublePercent) String
rest
>       Char
't':Char
'o':Char
'k':Char
'e':Char
'n':Char
't':Char
'y':Char
'p':Char
'e':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_TokenType) String
rest
>       Char
't':Char
'o':Char
'k':Char
'e':Char
'n':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Token) String
rest
>       Char
'n':Char
'a':Char
'm':Char
'e':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Name) String
rest
>       Char
'p':Char
'a':Char
'r':Char
't':Char
'i':Char
'a':Char
'l':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Partial) String
rest
>       Char
'i':Char
'm':Char
'p':Char
'o':Char
'r':Char
't':Char
'e':Char
'd':Char
'i':Char
'd':Char
'e':Char
'n':Char
't':Char
'i':Char
't':Char
'y':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_ImportedIdentity) String
rest
>       Char
'm':Char
'o':Char
'n':Char
'a':Char
'd':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Monad) String
rest
>       Char
'l':Char
'e':Char
'x':Char
'e':Char
'r':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Lexer) String
rest
>       Char
'n':Char
'o':Char
'n':Char
'a':Char
's':Char
's':Char
'o':Char
'c':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Nonassoc) String
rest
>       Char
'l':Char
'e':Char
'f':Char
't':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Left) String
rest
>       Char
'r':Char
'i':Char
'g':Char
'h':Char
't':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Right) String
rest
>       Char
'p':Char
'r':Char
'e':Char
'c':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Prec) String
rest
>       Char
's':Char
'h':Char
'i':Char
'f':Char
't':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Shift) String
rest
>       Char
'e':Char
'x':Char
'p':Char
'e':Char
'c':Char
't':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Expect) String
rest
>       Char
'e':Char
'r':Char
'r':Char
'o':Char
'r':Char
'.':Char
'e':Char
'x':Char
'p':Char
'e':Char
'c':Char
't':Char
'e':Char
'd':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_ErrorExpected) String
rest
>       Char
'e':Char
'r':Char
'r':Char
'o':Char
'r':Char
'h':Char
'a':Char
'n':Char
'd':Char
'l':Char
'e':Char
'r':Char
't':Char
'y':Char
'p':Char
'e':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_ErrorHandlerType) String
rest
>       Char
'e':Char
'r':Char
'r':Char
'o':Char
'r':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Error) String
rest
>       Char
'a':Char
't':Char
't':Char
'r':Char
'i':Char
'b':Char
'u':Char
't':Char
'e':Char
't':Char
'y':Char
'p':Char
'e':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Attributetype) String
rest
>       Char
'a':Char
't':Char
't':Char
'r':Char
'i':Char
'b':Char
'u':Char
't':Char
'e':String
rest | String -> Bool
end_of_id String
rest ->
>               Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Attribute) String
rest
>       String
_ -> String -> Pfunc a
forall a. String -> String -> Int -> ParseResult a
lexError (String
"unrecognised directive: %" String -> ShowS
forall a. [a] -> [a] -> [a]
++
>                               (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace) String
s) String
s
>    where
>       end_of_id :: String -> Bool
end_of_id (Char
c:String
_) = Bool -> Bool
not (Char -> Bool
isAlphaNum Char
c)
>       end_of_id []    = Bool
True

> lexColon :: (Token -> Pfunc a) -> [Char] -> Int -> ParseResult a
> lexColon :: forall r. (Token -> Pfunc r) -> Pfunc r
lexColon Token -> Pfunc a
cont (Char
':':String
rest) = Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokDoubleColon) String
rest
> lexColon Token -> Pfunc a
cont String
rest       = Token -> Pfunc a
cont (TokenId -> Token
TokenKW TokenId
TokColon) String
rest

> lexId :: (Token -> Pfunc a) -> Char -> String -> Int -> ParseResult a
> lexId :: forall a. (Token -> Pfunc a) -> Char -> Pfunc a
lexId Token -> Pfunc a
cont Char
c String
rest =
>       String -> (String -> Pfunc a) -> Int -> ParseResult a
forall a. String -> (String -> String -> a) -> a
readId String
rest (\ String
ident String
rest' -> Token -> Pfunc a
cont (String -> TokenId -> Token
TokenInfo (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
ident) TokenId
TokId) String
rest')

> lexChar :: (Token -> Pfunc a) -> String -> Int -> ParseResult a
> lexChar :: forall r. (Token -> Pfunc r) -> Pfunc r
lexChar Token -> Pfunc a
cont String
rest = String -> (String -> Pfunc a) -> Int -> ParseResult a
forall a. String -> (String -> String -> a) -> a
lexReadChar String
rest
>       (\ String
ident -> Token -> Pfunc a
cont (String -> TokenId -> Token
TokenInfo (String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ident String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'") TokenId
TokId))

> lexString :: (Token -> Pfunc a) -> String -> Int -> ParseResult a
> lexString :: forall r. (Token -> Pfunc r) -> Pfunc r
lexString Token -> Pfunc a
cont String
rest = String -> (String -> Pfunc a) -> Int -> ParseResult a
forall a. String -> (String -> String -> a) -> a
lexReadString String
rest
>       (\ String
ident -> Token -> Pfunc a
cont (String -> TokenId -> Token
TokenInfo (String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ident String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"") TokenId
TokId))

> lexCode :: (Token -> Pfunc a) -> String -> Int -> ParseResult a
> lexCode :: forall r. (Token -> Pfunc r) -> Pfunc r
lexCode Token -> Pfunc a
cont String
rest = String
-> Integer -> String -> (Token -> Pfunc a) -> Int -> ParseResult a
forall a b.
(Eq a, Num a) =>
String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
lexReadCode String
rest (Integer
0 :: Integer) String
"" Token -> Pfunc a
cont

> lexNum :: (Token -> Pfunc a) -> Char -> String -> Int -> ParseResult a
> lexNum :: forall a. (Token -> Pfunc a) -> Char -> Pfunc a
lexNum Token -> Pfunc a
cont Char
c String
rest =
>        String -> (String -> Pfunc a) -> Int -> ParseResult a
forall a. String -> (String -> String -> a) -> a
readNum String
rest (\ String
num String
rest' ->
>                         Token -> Pfunc a
cont (Int -> TokenId -> Token
TokenNum (String -> Int
stringToInt (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
num)) TokenId
TokNum) String
rest')
>  where stringToInt :: String -> Int
stringToInt = (Int -> Char -> Int) -> Int -> String -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
n Char
c' -> Char -> Int
digitToInt Char
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n) Int
0

> cleanupCode :: String -> String
> cleanupCode :: ShowS
cleanupCode String
s =
>    (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (ShowS
forall a. [a] -> [a]
reverse ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (ShowS
forall a. [a] -> [a]
reverse String
s)))

This has to match for @}@ that are {\em not} in strings.  The code
here is a bit tricky, but should work in most cases.

> lexReadCode :: (Eq a, Num a)
>             => String -> a -> String -> (Token -> Pfunc b) -> Int
>             -> ParseResult b
> lexReadCode :: forall a b.
(Eq a, Num a) =>
String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
lexReadCode String
s a
n String
c = case String
s of
>       Char
'\n':String
r -> \Token -> Pfunc b
cont Int
l ->  String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
forall a b.
(Eq a, Num a) =>
String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
lexReadCode String
r a
n (Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:String
c) Token -> Pfunc b
cont (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
>
>       Char
'{' :String
r -> String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
forall a b.
(Eq a, Num a) =>
String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
lexReadCode String
r (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) (Char
'{'Char -> ShowS
forall a. a -> [a] -> [a]
:String
c)
>
>       Char
'}' :String
r
>               | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0    -> \Token -> Pfunc b
cont -> Token -> Pfunc b
cont (String -> TokenId -> Token
TokenInfo (
>                               ShowS
cleanupCode (ShowS
forall a. [a] -> [a]
reverse String
c)) TokenId
TokCodeQuote) String
r
>               | Bool
otherwise -> String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
forall a b.
(Eq a, Num a) =>
String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
lexReadCode String
r (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) (Char
'}'Char -> ShowS
forall a. a -> [a] -> [a]
:String
c)
>
>       Char
'"'{-"-}:String
r -> String
-> (String -> String -> (Token -> Pfunc b) -> Int -> ParseResult b)
-> (Token -> Pfunc b)
-> Int
-> ParseResult b
forall a. String -> (String -> String -> a) -> a
lexReadString String
r (\ String
str String
r' ->
>                     String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
forall a b.
(Eq a, Num a) =>
String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
lexReadCode String
r' a
n (Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: (ShowS
forall a. [a] -> [a]
reverse String
str) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: String
c))
>
>       Char
a: Char
'\'':String
r | Char -> Bool
isAlphaNum Char
a -> String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
forall a b.
(Eq a, Num a) =>
String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
lexReadCode String
r a
n (Char
'\''Char -> ShowS
forall a. a -> [a] -> [a]
:Char
aChar -> ShowS
forall a. a -> [a] -> [a]
:String
c)
>
>       Char
'\'' :String
r -> String
-> (String -> String -> (Token -> Pfunc b) -> Int -> ParseResult b)
-> (Token -> Pfunc b)
-> Int
-> ParseResult b
forall a. String -> (String -> String -> a) -> a
lexReadSingleChar String
r (\ String
str String
r' ->
>                  String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
forall a b.
(Eq a, Num a) =>
String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
lexReadCode String
r' a
n ((ShowS
forall a. [a] -> [a]
reverse String
str) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'\'' Char -> ShowS
forall a. a -> [a] -> [a]
: String
c))
>
>       Char
ch:String
r -> String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
forall a b.
(Eq a, Num a) =>
String -> a -> String -> (Token -> Pfunc b) -> Int -> ParseResult b
lexReadCode String
r a
n (Char
chChar -> ShowS
forall a. a -> [a] -> [a]
:String
c)
>
>       [] -> \Token -> Pfunc b
_cont -> String -> Pfunc b
forall a. String -> String -> Int -> ParseResult a
lexError String
"No closing '}' in code segment" []

----------------------------------------------------------------------------
Utilities that read the rest of a token.

> readId :: String -> (String -> String -> a) -> a
> readId :: forall a. String -> (String -> String -> a) -> a
readId (Char
c:String
r) String -> String -> a
fn | Char -> Bool
isIdPart Char
c = String -> (String -> String -> a) -> a
forall a. String -> (String -> String -> a) -> a
readId String
r (String -> String -> a
fn (String -> String -> a) -> ShowS -> String -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
c)
> readId String
r     String -> String -> a
fn = String -> String -> a
fn [] String
r

> readNum :: String -> (String -> String -> a) -> a
> readNum :: forall a. String -> (String -> String -> a) -> a
readNum (Char
c:String
r) String -> String -> a
fn | Char -> Bool
isDigit Char
c = String -> (String -> String -> a) -> a
forall a. String -> (String -> String -> a) -> a
readNum String
r (String -> String -> a
fn (String -> String -> a) -> ShowS -> String -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
c)
> readNum String
r     String -> String -> a
fn = String -> String -> a
fn [] String
r

> isIdPart :: Char -> Bool
> isIdPart :: Char -> Bool
isIdPart Char
c =
>          Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z'
>       Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z'
>       Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
>       Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

> lexReadSingleChar :: String -> (String -> String -> a) -> a
> lexReadSingleChar :: forall a. String -> (String -> String -> a) -> a
lexReadSingleChar (Char
'\\':Char
c:Char
'\'':String
r) String -> String -> a
fn = String -> String -> a
fn (Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
"'") String
r
> lexReadSingleChar (Char
c:Char
'\'':String
r)      String -> String -> a
fn = String -> String -> a
fn (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
"'") String
r
> lexReadSingleChar String
r               String -> String -> a
fn = String -> String -> a
fn String
"" String
r

> lexReadChar :: String -> (String -> String -> a) -> a
> lexReadChar :: forall a. String -> (String -> String -> a) -> a
lexReadChar (Char
'\'':String
r)      String -> String -> a
fn = String -> String -> a
fn String
"" String
r
> lexReadChar (Char
'\\':Char
'\'':String
r) String -> String -> a
fn = String -> (String -> String -> a) -> a
forall a. String -> (String -> String -> a) -> a
lexReadChar String
r (String -> String -> a
fn (String -> String -> a) -> ShowS -> String -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'\\' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'\'')
> lexReadChar (Char
'\\':Char
c:String
r)    String -> String -> a
fn = String -> (String -> String -> a) -> a
forall a. String -> (String -> String -> a) -> a
lexReadChar String
r (String -> String -> a
fn (String -> String -> a) -> ShowS -> String -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'\\' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
c)
> lexReadChar (Char
c:String
r)         String -> String -> a
fn = String -> (String -> String -> a) -> a
forall a. String -> (String -> String -> a) -> a
lexReadChar String
r (String -> String -> a
fn (String -> String -> a) -> ShowS -> String -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
c)
> lexReadChar []            String -> String -> a
fn = String -> String -> a
fn String
"" []

> lexReadString :: String -> (String -> String -> a) -> a
> lexReadString :: forall a. String -> (String -> String -> a) -> a
lexReadString (Char
'"'{-"-}:String
r) String -> String -> a
fn = String -> String -> a
fn String
"" String
r
> lexReadString (Char
'\\':Char
'"':String
r) String -> String -> a
fn = String -> (String -> String -> a) -> a
forall a. String -> (String -> String -> a) -> a
lexReadString String
r (String -> String -> a
fn (String -> String -> a) -> ShowS -> String -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'\\' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'"')
> lexReadString (Char
'\\':Char
c:String
r)   String -> String -> a
fn = String -> (String -> String -> a) -> a
forall a. String -> (String -> String -> a) -> a
lexReadString String
r (String -> String -> a
fn (String -> String -> a) -> ShowS -> String -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'\\' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
c)
> lexReadString (Char
c:String
r)        String -> String -> a
fn = String -> (String -> String -> a) -> a
forall a. String -> (String -> String -> a) -> a
lexReadString String
r (String -> String -> a
fn (String -> String -> a) -> ShowS -> String -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
c)
> lexReadString []           String -> String -> a
fn = String -> String -> a
fn String
"" []

> lexError :: String -> String -> Int -> ParseResult a
> lexError :: forall a. String -> String -> Int -> ParseResult a
lexError String
err = \String
_ Int
l -> String -> ParseResult a
forall a b. a -> Either a b
Left (Int -> String
forall a. Show a => a -> String
show Int
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")

> lexNestedComment :: Int -> ([Char] -> Int -> ParseResult a) -> [Char] -> Int
>                  -> ParseResult a
> lexNestedComment :: forall a.
Int
-> (String -> Int -> ParseResult a)
-> String
-> Int
-> ParseResult a
lexNestedComment Int
l String -> Int -> ParseResult a
cont String
r =
>   case String
r of
>       Char
'-':Char
'}':String
r' -> String -> Int -> ParseResult a
cont String
r'
>       Char
'{':Char
'-':String
r' -> \Int
line -> Int
-> (String -> Int -> ParseResult a)
-> String
-> Int
-> ParseResult a
forall a.
Int
-> (String -> Int -> ParseResult a)
-> String
-> Int
-> ParseResult a
lexNestedComment Int
line
>                       (\String
r'' -> Int
-> (String -> Int -> ParseResult a)
-> String
-> Int
-> ParseResult a
forall a.
Int
-> (String -> Int -> ParseResult a)
-> String
-> Int
-> ParseResult a
lexNestedComment Int
l String -> Int -> ParseResult a
cont String
r'') String
r' Int
line
>       Char
'\n':String
r'    -> \Int
line -> Int
-> (String -> Int -> ParseResult a)
-> String
-> Int
-> ParseResult a
forall a.
Int
-> (String -> Int -> ParseResult a)
-> String
-> Int
-> ParseResult a
lexNestedComment Int
l String -> Int -> ParseResult a
cont String
r' (Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
>       Char
_:String
r'       -> Int
-> (String -> Int -> ParseResult a)
-> String
-> Int
-> ParseResult a
forall a.
Int
-> (String -> Int -> ParseResult a)
-> String
-> Int
-> ParseResult a
lexNestedComment Int
l String -> Int -> ParseResult a
cont String
r'
>       String
""         -> \Int
_ -> String -> String -> Int -> ParseResult a
forall a. String -> String -> Int -> ParseResult a
lexError String
"unterminated comment" String
r Int
l