> module Lexer (
>       Token(..),
>       TokenId(..),
>       lexer ) where


> import ParseMonad        


> 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 = 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 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 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_Expect      -- %expect
>       | TokSpecId_Error       -- %error
>       | TokSpecId_Attributetype -- %attributetype
>       | TokSpecId_Attribute   -- %attribute
>       | TokCodeQuote          -- stuff inside { .. }
>       | TokColon              -- :
>       | TokSemiColon          -- ;
>       | TokDoubleColon        -- ::
>       | TokDoublePercent      -- %%
>       | TokBar                -- |
>       | TokNum                -- Integer
>       | TokParenL             -- (
>       | TokParenR             -- )
>       | TokComma              -- ,
>       deriving (TokenId -> TokenId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenId -> TokenId -> Bool
$c/= :: TokenId -> TokenId -> Bool
== :: TokenId -> TokenId -> Bool
$c== :: TokenId -> TokenId -> Bool
Eq,Eq 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
min :: TokenId -> TokenId -> TokenId
$cmin :: TokenId -> TokenId -> TokenId
max :: TokenId -> TokenId -> TokenId
$cmax :: TokenId -> TokenId -> TokenId
>= :: TokenId -> TokenId -> Bool
$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
compare :: TokenId -> TokenId -> Ordering
$ccompare :: TokenId -> TokenId -> Ordering
Ord


#ifdef DEBUG


>       	,Show


#endif


>		)






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


> returnToken :: (t -> P a) -> t -> String -> Int -> ParseResult a
> returnToken :: forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken t -> P a
cont t
tok = forall a. P a -> String -> Int -> ParseResult a
runP (t -> P a
cont t
tok)


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


>  	Char
'|' 	-> forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokBar)
>  	Char
'\''	-> forall a. (Token -> P a) -> String -> Int -> ParseResult a
lexChar Token -> P a
cont
>  	Char
'"'{-"-}-> forall a. (Token -> P a) -> String -> Int -> ParseResult a
lexString Token -> P a
cont
>  	Char
'{' 	-> forall a. (Token -> P a) -> String -> Int -> ParseResult a
lexCode Token -> P a
cont


>       Char
'('     -> forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokParenL)
>       Char
')'     -> forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokParenR)
>       Char
','     -> forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokComma)


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








> lexPercent :: (Token -> P a) -> [Char] -> Int -> ParseResult a
> lexPercent :: forall a. (Token -> P a) -> String -> Int -> ParseResult a
lexPercent Token -> P a
cont String
s = case String
s of
> 	Char
'%':String
rest -> forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P 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 -> 
>		forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_TokenType) String
rest
> 	Char
't':Char
'o':Char
'k':Char
'e':Char
'n':String
rest ->
> 		forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Token) String
rest
> 	Char
'n':Char
'a':Char
'm':Char
'e':String
rest ->
> 		forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P 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 ->
> 		forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P 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 ->
> 		forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_ImportedIdentity) String
rest
> 	Char
'm':Char
'o':Char
'n':Char
'a':Char
'd':String
rest ->
> 		forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Monad) String
rest
> 	Char
'l':Char
'e':Char
'x':Char
'e':Char
'r':String
rest ->
> 		forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P 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 ->
>               forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Nonassoc) String
rest
>       Char
'l':Char
'e':Char
'f':Char
't':String
rest ->
>               forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Left) String
rest
>       Char
'r':Char
'i':Char
'g':Char
'h':Char
't':String
rest ->
>               forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Right) String
rest
>       Char
'p':Char
'r':Char
'e':Char
'c':String
rest ->
>               forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Prec) String
rest
>       Char
'e':Char
'x':Char
'p':Char
'e':Char
'c':Char
't':String
rest ->
>               forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Expect) String
rest
>       Char
'e':Char
'r':Char
'r':Char
'o':Char
'r':String
rest ->
>               forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P 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 ->
>               forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P 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 ->
>               forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (TokenId -> Token
TokenKW TokenId
TokSpecId_Attribute) String
rest
>	String
_ -> forall a. String -> String -> Int -> ParseResult a
lexError (String
"unrecognised directive: %" forall a. [a] -> [a] -> [a]
++ 
>				forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace) String
s) String
s


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


> lexId :: (Token -> P a) -> Char -> String -> Int -> ParseResult a
> lexId :: forall a. (Token -> P a) -> Char -> String -> Int -> ParseResult a
lexId Token -> P a
cont Char
c String
rest = 
>	forall a. String -> (String -> String -> a) -> a
readId String
rest (\ String
ident String
rest' -> forall t a. (t -> P a) -> t -> String -> Int -> ParseResult a
returnToken Token -> P a
cont (String -> TokenId -> Token
TokenInfo (Char
cforall a. a -> [a] -> [a]
:String
ident) TokenId
TokId) String
rest')


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


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


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


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


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








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








> 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 = forall a. String -> (String -> String -> a) -> a
readId String
r (String -> String -> a
fn 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 = forall a. String -> (String -> String -> a) -> a
readNum String
r (String -> String -> a
fn 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 forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'z' 
>	Bool -> Bool -> Bool
|| Char
c forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Z' 
>	Bool -> Bool -> Bool
|| Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9' 
>	Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'


> lexReadSingleChar :: String -> (String -> String -> a) -> a
> lexReadSingleChar :: forall a. String -> (String -> String -> a) -> a
lexReadSingleChar (Char
c:Char
'\'':String
r)      String -> String -> a
fn = String -> String -> a
fn (Char
cforall a. a -> [a] -> [a]
:String
"'") String
r
> lexReadSingleChar (Char
'\\':Char
c:Char
'\'':String
r) String -> String -> a
fn = String -> String -> a
fn (Char
'\\'forall a. a -> [a] -> [a]
:Char
cforall 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 = forall a. String -> (String -> String -> a) -> a
lexReadChar String
r (String -> String -> a
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'\\' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'\'')
> lexReadChar (Char
'\\':Char
c:String
r)    String -> String -> a
fn = forall a. String -> (String -> String -> a) -> a
lexReadChar String
r (String -> String -> a
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'\\' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
c)
> lexReadChar (Char
c:String
r)         String -> String -> a
fn = forall a. String -> (String -> String -> a) -> a
lexReadChar String
r (String -> String -> a
fn 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 = forall a. String -> (String -> String -> a) -> a
lexReadString String
r (String -> String -> a
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'\\' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'"')
> lexReadString (Char
'\\':Char
c:String
r)   String -> String -> a
fn = forall a. String -> (String -> String -> a) -> a
lexReadString String
r (String -> String -> a
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'\\' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
c)
> lexReadString (Char
c:String
r)        String -> String -> a
fn = forall a. String -> (String -> String -> a) -> a
lexReadString String
r (String -> String -> a
fn 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 = forall a. P a -> String -> Int -> ParseResult a
runP (P Int
lineP forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
l -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show Int
l forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
err 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 -> forall a.
Int
-> (String -> Int -> ParseResult a)
-> String
-> Int
-> ParseResult a
lexNestedComment Int
line 
>			(\String
r'' -> 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 -> forall a.
Int
-> (String -> Int -> ParseResult a)
-> String
-> Int
-> ParseResult a
lexNestedComment Int
l String -> Int -> ParseResult a
cont String
r' (Int
lineforall a. Num a => a -> a -> a
+Int
1)
>	Char
_:String
r'       -> forall a.
Int
-> (String -> Int -> ParseResult a)
-> String
-> Int
-> ParseResult a
lexNestedComment Int
l String -> Int -> ParseResult a
cont String
r'
>	String
""	   -> \Int
_ -> forall a. String -> String -> Int -> ParseResult a
lexError String
"unterminated comment" String
r Int
l