X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=src%2Flex.icl;h=63a14e02d69a8b5e2dca8e044038eeba9375d692;hb=ca00099482644c76d6d918f536f69db32ac85058;hp=8aae65a9f28ede4115e84dbd7b9e7dc9a44401b6;hpb=f56458569930a95ddb04c0d166af574535b493d4;p=cc1516.git diff --git a/src/lex.icl b/src/lex.icl index 8aae65a..63a14e0 100644 --- 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,16 @@ 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 <* many (satisfy isSpace) <* eof + >>= \ts->pure (map (\t->(0, 0, t)) ts) lexToken :: Parser Char TokenValue lexToken = + //Comments + (list (fromString "//") >>| until top ((item '\n' >>| return Void) <|> eof) >>| lexToken) <|> + (list (fromString "/*") >>| until top (list (fromString "*/")) >>| lexToken) <|> + //Keyword tokens (lexKw "var" VarToken) <|> (lexKw "Void" VoidToken) <|> (lexKw "return" ReturnToken) <|> @@ -35,59 +35,38 @@ 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) <|> + //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 (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 == '_' +// (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)