diff --git a/cherry-lisp.cabal b/cherry-lisp.cabal index 0c23f66..4a7f7c0 100644 --- a/cherry-lisp.cabal +++ b/cherry-lisp.cabal @@ -22,8 +22,7 @@ executable cherry Parser, TokenType, Lexer, - Evaluator, - ParserUtils + Evaluator build-depends: base >= 4.7 && < 5, containers, diff --git a/src/Lexer.hs b/src/Lexer.hs index cd5bc42..5a60f82 100644 --- a/src/Lexer.hs +++ b/src/Lexer.hs @@ -1,7 +1,6 @@ module Lexer where import Text.ParserCombinators.Parsec -import ParserUtils import Data.Char import TokenType @@ -13,7 +12,7 @@ parseTokens = do return tokns anyLispToken :: GenParser Char st Token -anyLispToken = leftParenT <|> rightParenT <|> try nilT <|> try setT <|> varT <|> intT +anyLispToken = leftParenT <|> rightParenT <|> symbolT <|> intT ------------------------------------------------------------ @@ -28,13 +27,7 @@ leftParenT = char '(' >> return LeftParenT rightParenT :: GenParser Char st Token rightParenT = char ')' >> return RightParenT -setT :: GenParser Char st Token -setT = caseInsensitiveString "set!" >> return SetT - -nilT :: GenParser Char st Token -nilT = caseInsensitiveString "nil" >> return NilT - -varT :: GenParser Char st Token -varT = do +symbolT :: GenParser Char st Token +symbolT = do var <- map toLower <$> many1 (letter <|> oneOf "+-*/!|@#$~%&/=<>") - return $ VarT var + return $ SymbolT var diff --git a/src/Parser.hs b/src/Parser.hs index 3970ee4..28a84fc 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -20,7 +20,7 @@ expressionFromTokensEOF = do expressionFromTokens :: GenParser Token st Expr expressionFromTokens = do - expr <- intE <|> try defineE <|> try nilE <|> varE <|> procedureE + expr <- intE <|> try setE <|> try nilE <|> varE <|> procedureE return expr intE :: GenParser Token st Expr @@ -31,14 +31,14 @@ intE = do procedureE :: GenParser Token st Expr procedureE = do _ <- parseLeftParenT - (VarT p) <- parseVarT + (SymbolT p) <- parseSymbolT args <- many expressionFromTokens _ <- parseRightParenT return $ ProcedureE p args varE :: GenParser Token st Expr varE = do - (VarT var) <- parseVarT + (SymbolT var) <- parseSymbolT return $ VarE var nilE :: GenParser Token st Expr @@ -46,11 +46,11 @@ nilE = do _ <- parseNilT return NilE -defineE :: GenParser Token st Expr -defineE = do +setE :: GenParser Token st Expr +setE = do _ <- parseLeftParenT _ <- parseSetT - (VarT var) <- parseVarT + (SymbolT var) <- parseSymbolT expr <- expressionFromTokens _ <- parseRightParenT return $ SetE var expr @@ -69,15 +69,19 @@ parseRightParenT :: GenParser Token st Token parseRightParenT = satisfyT (== RightParenT) parseSetT :: GenParser Token st Token -parseSetT = satisfyT (== SetT) +parseSetT = satisfyT isSetT + where isSetT (SymbolT "set!") = True + isSetT _ = False parseNilT :: GenParser Token st Token -parseNilT = satisfyT (== NilT) +parseNilT = satisfyT isNilT + where isNilT (SymbolT "nil") = True + isNilT _ = False -parseVarT :: GenParser Token st Token -parseVarT = satisfyT isVarT - where isVarT (VarT _) = True - isVarT _ = False +parseSymbolT :: GenParser Token st Token +parseSymbolT = satisfyT isSymbolT + where isSymbolT (SymbolT _) = True + isSymbolT _ = False parseIntT :: GenParser Token st Token parseIntT = satisfyT isIntT diff --git a/src/ParserUtils.hs b/src/ParserUtils.hs index 0eaee62..7426fbf 100644 --- a/src/ParserUtils.hs +++ b/src/ParserUtils.hs @@ -1,3 +1,4 @@ +-- UNUSED module ParserUtils where import Text.ParserCombinators.Parsec diff --git a/src/TokenType.hs b/src/TokenType.hs index 25a9a27..4df982a 100644 --- a/src/TokenType.hs +++ b/src/TokenType.hs @@ -2,8 +2,6 @@ module TokenType where data Token = LeftParenT | RightParenT - | SetT - | VarT String + | SymbolT String | IntT Integer - | NilT deriving (Show, Eq)