implementation module lex

import Control.Monad, Control.Applicative
import Data.Either, Data.Func, Data.Maybe, Data.Functor
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)) (catMaybes ts))

lexToken :: Parser Char (Maybe TokenValue)
lexToken = 
    //Comments
    (list (fromString "//") >>| lexUntilNL >>| pure Nothing) <|>
    (list (fromString "/*") >>| lexUntilCommentClose >>| pure Nothing) <|>
	//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 (Just o CharToken)
		(list (fromString "'\\") *> lexEscape <* item '\'') <|>
	//Normal chars tokens
	liftM (Just o 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 <|> 
	//One char ops tokens
    lexOp "(" BraceOpenToken <|>
	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 (Just o NumberToken o toInt o toString) (some $ satisfy isDigit) <|>
	//Ident tokens
	liftM (Just o IdentToken o toString) (some $ satisfy isIdentChar) <|>
	(satisfy isSpace >>| pure Nothing)
	where
		lexUntilNL = top until (eof <|> (item '\n' >>| pure Void))
		lexUntilCommentClose = top until (list (fromString "*/"))
		isIdentChar c = isAlphanum c || c == '_'
		lexOp s tv = list (fromString s) >>| pure (Just tv)
		lexKw kw tv = lexOp kw tv <* check (not o isIdentChar)
		lexEscape = fromJust <$> ((
			lexOp "a" (toChar 7) <|> lexOp "b" '\b' <|> lexOp "f" '\f' <|>
			lexOp "n" '\n' <|> lexOp "r" '\t' <|> lexOp "v" '\v' <|>
			lexOp "'" '\'') <?> ("Unknown escape", 0))