From: Mart Lubbers Date: Tue, 1 Mar 2016 15:38:56 +0000 (+0100) Subject: lexer done X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=3952a068daa6e70d73f7ae9b3b68548289bbef99;p=cc1516.git lexer done --- diff --git a/src/lex.icl b/src/lex.icl index 4cf915c..1828e37 100644 --- a/src/lex.icl +++ b/src/lex.icl @@ -1,7 +1,7 @@ implementation module lex import Control.Monad, Control.Applicative -import Data.Either, Data.Func +import Data.Either, Data.Func, Data.Maybe, Data.Functor from StdFunc import o import StdBool import StdList @@ -15,59 +15,61 @@ lexer r = case runParser lexProgram r of (Left e, _) = Left $ toString e lexProgram :: Parser Char [Token] -lexProgram = some lexToken <* many (satisfy isSpace) <* eof - >>= \ts->pure $ (map (\t->(0, 0, t)) ts) ++ [(0, 0, EndOfFileToken)] +lexProgram = some lexToken <* eof + >>= \ts->pure $ (map (\t->(0, 0, t)) (catMaybes ts)) -lexToken :: Parser Char TokenValue +lexToken :: Parser Char (Maybe TokenValue) lexToken = //Comments - (list (fromString "//") >>| lexUntilNL >>| lexToken) <|> - (list (fromString "/*") >>| lexUntilCommentClose >>| lexToken) <|> + (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) <|> + 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 '\'') <|> + liftM (Just o CharToken) + (list (fromString "'\\") *> lexEscape <* item '\'') <|> //Normal chars tokens - (liftM CharToken $ item '\'' *> satisfy ((<>) '\'') <* item '\'') <|> + 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) <|> + 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) <|> + 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 (NumberToken o toInt o toString) $ some $ satisfy isDigit) <|> + liftM (Just o NumberToken o toInt o toString) (some $ satisfy isDigit) <|> //Ident tokens - (liftM (IdentToken o toString) $ some $ satisfy isIdentChar) <|> - (satisfy isSpace >>| lexToken) + 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 "*/") + lexUntilCommentClose = top until (list (fromString "*/")) 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 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) + lexOp "'" '\'') ("Unknown escape", 0)) diff --git a/src/parse.icl b/src/parse.icl index ec89565..fed0760 100644 --- a/src/parse.icl +++ b/src/parse.icl @@ -20,12 +20,12 @@ import lex parser :: LexerOutput -> ParserOutput parser (Left e) = Left $ toString $ LexError e parser (Right r) = case runParser parseProgram r of - (Right p, _) = Right p + (Right p, []) = Right p + (Right p, x) = Left "Unparsed tokens: "//TODO (Left e, _) = Left $ toString e parseProgram :: Parser Token AST parseProgram = liftM2 AST (many parseVarDecl) (some parseFunDecl) - <* satTok EndOfFileToken parseFunDecl :: Parser Token FunDecl parseFunDecl = liftM5 FunDecl