hoi

[cc1516.git] / src / lex.icl

diff --git a/src/lex.icl b/src/lex.icl
index 8aae65a..a6f31ab 100644 (file)
--- a/src/lex.icl
+++ b/src/lex.icl
@@ -1,10 +1,8 @@
 implementation module lex
 
 import Control.Monad, Control.Applicative
-import Data.Either, Data.Maybe, Data.Map, Data.Func
-import StdString
-import StdTuple
-from StdFunc import const, o
+import Data.Either, Data.Func
+from StdFunc import o
 import StdBool
 import StdList
 import StdChar
@@ -16,14 +14,12 @@ lexer r = case runParser lexProgram r of
        (Right p, _) = Right p
        (Left e, _) = Left $ toString e
 
-trans1 :: Char a -> Parser Char a
-trans1 t r = item t >>| pure r
-
 lexProgram :: Parser Char [Token]
-lexProgram = lexToken >>= \t->pure [(0, 0, t)]
+lexProgram = some lexToken >>= \ts->pure (map (\t->(0, 0, t)) ts)
 
 lexToken :: Parser Char TokenValue
 lexToken = 
+       //Keyword tokens
        (lexKw "var" VarToken) <|>
        (lexKw "Void" VoidToken) <|>
        (lexKw "return" ReturnToken) <|>
@@ -35,59 +31,37 @@ lexToken =
        (lexKw "Int" IntTypeToken) <|>
        (lexKw "Bool" BoolTypeToken) <|>
        (lexKw "Char" CharTypeToken) <|>
-       //Escape chars
+       //Escape chars tokens
        (liftM CharToken $ item '\'' *> item '\\' *> lexEscape <* item '\'') <|>
-       //Normal chars
+       //Normal chars tokens
        (liftM CharToken $ item '\'' *> satisfy ((<>) '\'') <* item '\'') <|>
-       (lexOp "::" DoubleColonToken) <|>
-       (lexOp "!=" NotEqualToken) <|>
-       (lexOp "<=" LesserEqToken) <|>
-       (lexOp ">=" GreaterEqToken) <|>
-       (lexOp "==" EqualsToken) <|>
-       (lexOp "&&" AmpersandsToken) <|>
-       (lexOp "||" PipesToken) <|>
-       (lexOp "[]" EmptyListToken) <|>
-       (lexOp "->" ArrowToken) <|>
-       (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) <|>
-       //Numbers
+       //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) <|>
-       //Identifiersr
+       //Ident tokens
        (liftM IdentToken $ some $ satisfy isIdentChar) <|>
-       (satisfy isSpace >>| lexToken)
-
-lexEscape = (
-       lexOp "a" (toChar 7) <|>
-       lexOp "b" '\b' <|>
-       lexOp "f" '\f' <|>
-       lexOp "n" '\n' <|>
-       lexOp "r" '\t' <|>
-       lexOp "v" '\v' <|>
-       lexOp "'" '\''
-       ) <?> ("Unknown escape", 0)
-
-lexKw :: String a -> Parser Char a
-lexKw kw tv = list (fromString kw) <* check (not o isIdentChar) >>| pure tv
-
-lexOp :: String a -> Parser Char a
-lexOp s tv = list (fromString s) >>| pure tv
-
-isIdentChar :: Char -> Bool
-isIdentChar c = isAlphanum c || c == '_'
+       (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)