implementation module lex

import Control.Monad, Control.Applicative
import Data.Either, Data.Func
from StdFunc import o
import StdBool
import StdList
import StdChar

import yard

lexer :: [Char] -> LexerOutput
lexer r = case runParser lexProgram r of
	(Right p, _) = Right p
	(Left e, _) = Left $ toString e

lexProgram :: Parser Char [Token]
lexProgram = some lexToken <* eof >>= \ts->pure (map (\t->(0, 0, t)) ts)

lexToken :: Parser Char TokenValue
lexToken = 
	//Keyword tokens
	(lexKw "var" VarToken) <|>
	(lexKw "Void" VoidToken) <|>
	(lexKw "return" ReturnToken) <|>
	(lexKw "if" IfToken) <|>
	(lexKw "else" ElseToken) <|>
	(lexKw "while" WhileToken) <|>
	(lexKw "True" TrueToken) <|>
	(lexKw "False" FalseToken) <|>
	(lexKw "Int" IntTypeToken) <|>
	(lexKw "Bool" BoolTypeToken) <|>
	(lexKw "Char" CharTypeToken) <|>
	//Escape chars tokens
	(liftM CharToken $ item '\'' *> item '\\' *> lexEscape <* item '\'') <|>
	//Normal chars tokens
	(liftM CharToken $ item '\'' *> satisfy ((<>) '\'') <* item '\'') <|>
	//Two char ops tokens
	(lexOp "::" DoubleColonToken) <|> (lexOp "!=" NotEqualToken) <|>
	(lexOp "<=" LesserEqToken) <|> (lexOp ">=" GreaterEqToken) <|>
	(lexOp "==" EqualsToken) <|> (lexOp "&&" AmpersandsToken) <|>
	(lexOp "||" PipesToken) <|> (lexOp "[]" EmptyListToken) <|>
	(lexOp "->" ArrowToken) <|> (lexOp "(" BraceOpenToken) <|>
	//One char ops tokens
	(lexOp ")" BraceCloseToken) <|> (lexOp "{" CBraceOpenToken) <|>
	(lexOp "}" CBraceCloseToken) <|> (lexOp "[" SquareOpenToken) <|>
	(lexOp "]" SquareCloseToken) <|> (lexOp "," CommaToken) <|>
	(lexOp ":" ColonToken) <|> (lexOp ";" SColonToken) <|>
	(lexOp "." DotToken) <|> (lexOp "+" PlusToken) <|>
	(lexOp "*" StarToken) <|> (lexOp "/" SlashToken) <|>
	(lexOp "%" PercentToken) <|> (lexOp "=" AssignmentToken) <|>
	(lexOp "<" LesserToken) <|> (lexOp ">" BiggerToken) <|>
	(lexOp "!" ExclamationToken) <|> (lexOp "-" DashToken) <|>
	//Number tokens
	(liftM (NumberToken o toInt o toString) $ some $ satisfy isDigit) <|>
	//Ident tokens
	(liftM IdentToken $ some $ satisfy isIdentChar) <|>
	(satisfy isSpace >>| lexToken) //<|>
//	(eof >>| pure EndOfFileToken) 
	where
		isIdentChar c = isAlphanum c || c == '_'
		lexOp s tv = list (fromString s) >>| pure tv
		lexKw kw tv = lexOp kw tv <* check (not o isIdentChar) >>| pure tv
		lexEscape = (
			lexOp "a" (toChar 7) <|> lexOp "b" '\b' <|> lexOp "f" '\f' <|>
			lexOp "n" '\n' <|> lexOp "r" '\t' <|> lexOp "v" '\v' <|>
			lexOp "'" '\'') <?> ("Unknown escape", 0)