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
(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 <* eof >>= \ts->pure (map (\t->(0, 0, t)) ts)
lexToken :: Parser Char TokenValue
lexToken =
+ //Keyword tokens
(lexKw "var" VarToken) <|>
(lexKw "Void" VoidToken) <|>
(lexKw "return" ReturnToken) <|>
(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)