X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=src%2Flex.icl;h=63a14e02d69a8b5e2dca8e044038eeba9375d692;hb=ca00099482644c76d6d918f536f69db32ac85058;hp=b6e56d54b143a7417379f1918fbc2e295a55c2b9;hpb=b4636110ab65f233ed40d4390b62c7799df3c949;p=cc1516.git diff --git a/src/lex.icl b/src/lex.icl index b6e56d5..63a14e0 100644 --- a/src/lex.icl +++ b/src/lex.icl @@ -1,127 +1,72 @@ implementation module lex -import Control.Monad -import Data.Either, Data.Maybe, Data.Map, Data.Func -import StdString -import StdTuple +import Control.Monad, Control.Applicative +import Data.Either, Data.Func +from StdFunc import o import StdBool import StdList import StdChar -SingleCharTokens :: Map Char TokenValue -SingleCharTokens = fromList [ - ('(', BraceOpenToken), (')', BraceCloseToken), ('{', CBraceOpenToken), - ('}', CBraceCloseToken), ('[', SquareOpenToken), (']', SquareCloseToken), - (',', CommaToken), (':', ColonToken), (';', SColonToken), - ('.', DotToken), ('+', PlusToken), ('*', StarToken), ('/', SlashToken), - ('%', PercentToken), ('=', AssignmentToken), ('<', LesserToken), - ('>', BiggerToken), ('!', ExclamationToken)] - -EscapeMap :: Map Char Char -EscapeMap = fromList [('a', toChar 7), ('b', '\b'), ('f', '\f'), ('n', '\n'), - ('r', '\r'), ('t', '\t'), ('v', '\v')] +import yard lexer :: [Char] -> LexerOutput -lexer x = lexer` x 1 - where - lexer` :: [Char] Int -> LexerOutput - lexer` [] i = Right [] - lexer` x i = case lex x i of - (Right t, rest, i) = lexer` rest i >>= \ts.Right [t:ts] - (Left e, _, _) = Left e - -ret:: TokenValue [Char] Int -> (Either String Token, [Char], Int) -ret tv rest i = (Right (i, tv), rest, i) +lexer r = case runParser lexProgram r of + (Right p, _) = Right p + (Left e, _) = Left $ toString e -err :: String Int -> (Either String Token, [Char], Int) -err s i = (Left ("Line " +++ toString i +++ ": " +++ s), [], i) +lexProgram :: Parser Char [Token] +lexProgram = some lexToken <* many (satisfy isSpace) <* eof + >>= \ts->pure (map (\t->(0, 0, t)) ts) -lex :: [Char] -> (Int -> (Either String Token, [Char], Int)) -lex [] = ret EndOfFileToken [] -lex ['/':'/':xs] = lex (dropWhile ((<>) '\n') xs) -lex ['/':'*':xs] = \i.let (c, r) = span ((<>) ('*','/')) $ zip2 [' ':xs] xs in - lex (tl $ map snd $ tl $ r) (i + length [x\\(x, _)<-c | x == '\n']) -lex ['v':'a':'r':xs] = ret VarToken xs -lex ['V':'o':'i':'d':xs] = ret VoidToken xs -lex ['r':'e':'t':'u':'r':'n':xs] = ret ReturnToken xs -lex ['i':'f':xs] = ret IfToken xs -lex ['e':'l':'s':'e':xs] = ret ElseToken xs -lex ['w':'h':'i':'l':'e':xs] = ret WhileToken xs -lex ['T':'r':'u':'e':xs] = ret TrueToken xs -lex ['F':'a':'l':'s':'e':xs] = ret FalseToken xs -lex ['I':'n':'t':xs] = ret IntTypeToken xs -lex ['C':'h':'a':'r':xs] = ret CharTypeToken xs -lex ['B':'o':'o':'l':xs] = ret BoolTypeToken xs -lex [':':':':xs] = ret DoubleColonToken xs -lex ['!':'=':xs] = ret NotEqualToken xs -lex ['<':'=':xs] = ret LesserEqToken xs -lex ['>':'=':xs] = ret GreaterEqToken xs -lex ['=':'=':xs] = ret EqualsToken xs -lex ['&':'&':xs] = ret AmpersandsToken xs -lex ['|':'|':xs] = ret PipesToken xs -lex ['[':']':xs] = ret EmptyListToken xs -lex ['-':'>':xs] = ret ArrowToken xs -lex ['\'':x:'\'':xs] = ret (CharToken x) xs -lex ['\'':'\\':x:'\'':xs] = case get x EscapeMap of - Just t = ret (CharToken t) xs - _ = err ("Unknown escape: \\" +++ toString x) -lex ['-':t=:[x:xs]] -| isDigit x = let (n, r) = span isDigit t in - ret (NumberToken (toInt $ toString ['-':n])) r -| otherwise = ret DashToken t -lex t=:[x:xs] = case get x SingleCharTokens of - (Just tok) = ret tok xs - Nothing - | x == '\n' = \i.lex xs (i+1) - | isSpace x = lex xs - | isDigit x = let (v, r) = span isDigit t in - ret (NumberToken (toInt $ toString v)) r - | isAlpha x = let (v, r) = span isIdent t in ret (IdentToken v) r - with isIdent c = isAlphanum c || c == '_' - | otherwise = err ("Unexpected character: " +++ toString x) - - -(===) :: TokenValue Token -> Bool -(===) (IdentToken _) (_, IdentToken _) = True -(===) (NumberToken _) (_, NumberToken _) = True -(===) (CharToken _) (_, CharToken _) = True -(===) (VarToken) (_, VarToken) = True -(===) (ReturnToken) (_, ReturnToken) = True -(===) (IfToken) (_, IfToken) = True -(===) (ElseToken) (_, ElseToken) = True -(===) (WhileToken) (_, WhileToken) = True -(===) (TrueToken) (_, TrueToken) = True -(===) (FalseToken) (_, FalseToken) = True -(===) (VoidToken) (_, VoidToken) = True -(===) (IntTypeToken) (_, IntTypeToken) = True -(===) (CharTypeToken) (_, CharTypeToken) = True -(===) (BoolTypeToken) (_, BoolTypeToken) = True -(===) (DoubleColonToken) (_, DoubleColonToken) = True -(===) (NotEqualToken) (_, NotEqualToken) = True -(===) (LesserEqToken) (_, LesserEqToken) = True -(===) (GreaterEqToken) (_, GreaterEqToken) = True -(===) (EqualsToken) (_, EqualsToken) = True -(===) (AmpersandsToken) (_, AmpersandsToken) = True -(===) (PipesToken) (_, PipesToken) = True -(===) (ArrowToken) (_, ArrowToken) = True -(===) (EmptyListToken) (_, EmptyListToken) = True -(===) (BraceOpenToken) (_, BraceOpenToken) = True -(===) (BraceCloseToken) (_, BraceCloseToken) = True -(===) (CBraceOpenToken) (_, CBraceOpenToken) = True -(===) (CBraceCloseToken) (_, CBraceCloseToken) = True -(===) (SquareOpenToken) (_, SquareOpenToken) = True -(===) (SquareCloseToken) (_, SquareCloseToken) = True -(===) (CommaToken) (_, CommaToken) = True -(===) (ColonToken) (_, ColonToken) = True -(===) (SColonToken) (_, SColonToken) = True -(===) (DotToken) (_, DotToken) = True -(===) (PlusToken) (_, PlusToken) = True -(===) (DashToken) (_, DashToken) = True -(===) (StarToken) (_, StarToken) = True -(===) (SlashToken) (_, SlashToken) = True -(===) (PercentToken) (_, PercentToken) = True -(===) (AssignmentToken) (_, AssignmentToken) = True -(===) (LesserToken) (_, LesserToken) = True -(===) (BiggerToken) (_, BiggerToken) = True -(===) (ExclamationToken) (_, ExclamationToken) = True -(===) _ _ = False +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) <|> + (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 '\'') <|> + //Normal chars tokens + (liftM 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 (NumberToken o toInt o toString) $ some $ satisfy isDigit) <|> + //Ident tokens + (liftM IdentToken $ some $ satisfy isIdentChar) <|> + (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)