hoig

[cc1516.git] / src / lex.icl

diff --git a/src/lex.icl b/src/lex.icl
index bedb75f..a797b1c 100644 (file)
--- 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,63 @@ 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)
+lexProgram = catMaybes <$> some lexToken <* eof
+       >>= \ts->pure $ (map (\t->(0, 0, t)) ts)
 
-lexToken :: Parser Char TokenValue
+//Of hier een record van maken
+//lexToken :: Parser Char (Maybe (Int, Int, Int, 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 $ some $ satisfy isIdentChar) <|>
-       (satisfy isSpace >>| lexToken)
+       liftM (Just o IdentToken o toString) (some $ satisfy isIdentChar) <|>
+       (satisfy isSpace >>| pure Nothing)
        where
-               lexUntilNL = top until ((item '\n' >>| return Void) <|> eof)
-               lexUntilCommentClose = top until list (fromString "*/")
+               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 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 "'" '\'') <?> LexError "Unknown escape")