From 6994025cfb990d23505b810b62a2414450f4037e Mon Sep 17 00:00:00 2001 From: Ivy Date: Sat, 30 Jan 2021 22:38:44 +0100 Subject: [PATCH] Minor fixes and reworking of the code --- cherry-lisp.cabal | 4 ++-- src/Enviroment.hs | 9 ++++---- src/Evaluator.hs | 2 +- src/{ExprType.hs => Expression.hs} | 10 ++++---- src/Lexer.hs | 14 +++++------ src/Parser.hs | 37 +++++++++++++++--------------- src/ParserUtils.hs | 16 ------------- src/{TokenType.hs => Token.hs} | 2 +- 8 files changed, 40 insertions(+), 54 deletions(-) rename src/{ExprType.hs => Expression.hs} (58%) delete mode 100644 src/ParserUtils.hs rename src/{TokenType.hs => Token.hs} (88%) diff --git a/cherry-lisp.cabal b/cherry-lisp.cabal index eb0a693..c757fbd 100644 --- a/cherry-lisp.cabal +++ b/cherry-lisp.cabal @@ -18,9 +18,9 @@ executable cherry main-is: Main.hs default-language: Haskell2010 - other-modules: ExprType, + other-modules: Expression, Parser, - TokenType, + Token, Lexer, Evaluator, Enviroment diff --git a/src/Enviroment.hs b/src/Enviroment.hs index 8569f9b..549ea2a 100644 --- a/src/Enviroment.hs +++ b/src/Enviroment.hs @@ -1,16 +1,16 @@ module Enviroment where import qualified Data.Map as M -import ExprType +import Expression import Data.Maybe data Enviroment = Enviroment (M.Map String Expr) (Maybe Enviroment) +-- The base enviroment, that contains the main functions and variables base :: Enviroment base = Enviroment (M.fromList [ - ("test-var", IntE 10), - ("id", LambdaE "x" $ VarE "x"), - ("first", LambdaE "x" $ LambdaE "y" $ VarE "x") + ("id", LambdaE "x" $ VarE "x"), -- Given a expression, returns the same expression + ("const", LambdaE "x" $ LambdaE "y" $ VarE "x") -- Given two expressions, returns the first expression ]) Nothing lookupVar :: Enviroment -> String -> Maybe Expr @@ -23,6 +23,7 @@ insertVar (Enviroment menv u) var expr = Enviroment (M.insert var expr menv) u emptyEnv :: Enviroment emptyEnv = Enviroment M.empty Nothing +-- Returns a copy of the first enviroment whose upper enviroment is the second extendEnv :: Enviroment -> Enviroment -> Enviroment extendEnv (Enviroment menv Nothing) upper = Enviroment menv (Just upper) extendEnv (Enviroment menv (Just upperMenv)) upper = Enviroment menv (Just $ extendEnv upperMenv upper) diff --git a/src/Evaluator.hs b/src/Evaluator.hs index e717ee3..9bd1da6 100644 --- a/src/Evaluator.hs +++ b/src/Evaluator.hs @@ -1,6 +1,6 @@ module Evaluator where -import ExprType +import Expression import Enviroment import Data.Maybe diff --git a/src/ExprType.hs b/src/Expression.hs similarity index 58% rename from src/ExprType.hs rename to src/Expression.hs index ba10cd9..161d7d8 100644 --- a/src/ExprType.hs +++ b/src/Expression.hs @@ -1,4 +1,4 @@ -module ExprType where +module Expression where data Expr = IntE Integer | VarE String @@ -8,15 +8,15 @@ data Expr = IntE Integer | QuotedE Expr | NilE --- Make set! and lambda(?) parsed as cons, detect later set! and lambda as special procedures +-- TODO: Make set! and lambda(?) parsed as cons, detect later set! and lambda as special procedures instance Show Expr where show (IntE x) = show x show (VarE x) = x - show (SetE _ _) = "#set" + show (SetE v x) = "#[set " ++ show v ++ show x ++ "]" show c@(ConsE _ _) = "(" ++ showCons c - where showCons (ConsE _ NilE) = ")" + where showCons (ConsE x NilE) = show x ++ ")" showCons (ConsE x xs) = show x ++ " " ++ showCons xs - show (LambdaE s e) = "#lambda" + show (LambdaE s e) = "#[lambda " ++ s ++ " " ++ show e ++ "]" show (QuotedE e) = show e show NilE = "nil" diff --git a/src/Lexer.hs b/src/Lexer.hs index 1eeba79..fde9d2e 100644 --- a/src/Lexer.hs +++ b/src/Lexer.hs @@ -1,18 +1,18 @@ module Lexer where -import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec hiding (anyToken) import Data.Char -import TokenType +import Token -parseTokens :: GenParser Char st [Token] -parseTokens = do +tokens :: GenParser Char st [Token] +tokens = do _ <- spaces - tokns <- many $ do t <- anyLispToken; spaces; return t + tokns <- many $ do t <- anyToken; spaces; return t _ <- eof return tokns -anyLispToken :: GenParser Char st Token -anyLispToken = leftParenT <|> rightParenT <|> apostropheT <|> backslashT <|> symbolT <|> intT +anyToken :: GenParser Char st Token +anyToken = leftParenT <|> rightParenT <|> apostropheT <|> backslashT <|> symbolT <|> intT ------------------------------------------------------------ diff --git a/src/Parser.hs b/src/Parser.hs index 849f0a9..0041bc4 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -1,32 +1,34 @@ module Parser where -import Text.Parsec +import Text.Parsec hiding (tokens) import Text.Parsec.String -import Lexer -import TokenType -import ExprType +import Lexer (tokens) +import Token +import Expression parseExpression :: String -> Either ParseError Expr parseExpression s = do - tokns <- parse parseTokens "lexical error" s - expr <- parse expressionFromTokensEOF "parsing error" tokns + tokns <- parse tokens "lexical error" s + expr <- parse anyExpressionEOF "parsing error" tokns return expr -expressionFromTokensEOF :: GenParser Token st Expr -expressionFromTokensEOF = do - expr <- expressionFromTokens +anyExpressionEOF :: GenParser Token st Expr +anyExpressionEOF = do + expr <- anyExpression _ <- eof return expr -expressionFromTokens :: GenParser Token st Expr -expressionFromTokens = do +anyExpression :: GenParser Token st Expr +anyExpression = do expr <- intE <|> quotedE <|> try setE <|> try nilE <|> try consE <|> try lambdaE <|> varE <|> listE return expr +------------------------------------------------------------ + listE :: GenParser Token st Expr listE = do _ <- parseLeftParenT - exprs <- many expressionFromTokens + exprs <- many anyExpression _ <- parseRightParenT return $ toCons exprs where toCons [] = NilE @@ -40,15 +42,15 @@ intE = do quotedE :: GenParser Token st Expr quotedE = do _ <- parseApostropheT - expr <- expressionFromTokens + expr <- anyExpression return $ QuotedE expr consE :: GenParser Token st Expr consE = do _ <- parseLeftParenT _ <- parseConsT - expr1 <- expressionFromTokens - expr2 <- expressionFromTokens + expr1 <- anyExpression + expr2 <- anyExpression _ <- parseRightParenT return $ ConsE expr1 expr2 @@ -67,7 +69,7 @@ setE = do _ <- parseLeftParenT _ <- parseSetT (SymbolT var) <- parseSymbolT - expr <- expressionFromTokens + expr <- anyExpression _ <- parseRightParenT return $ SetE var expr @@ -75,10 +77,9 @@ lambdaE :: GenParser Token st Expr lambdaE = do _ <- parseBackslashT (SymbolT arg) <- parseSymbolT - body <- expressionFromTokens + body <- anyExpression return $ LambdaE arg body - ------------------------------------------------------------ satisfyT :: (Stream s m a, Show a) => (a -> Bool) -> ParsecT s u m a diff --git a/src/ParserUtils.hs b/src/ParserUtils.hs deleted file mode 100644 index 7426fbf..0000000 --- a/src/ParserUtils.hs +++ /dev/null @@ -1,16 +0,0 @@ --- UNUSED -module ParserUtils where - -import Text.ParserCombinators.Parsec -import Data.Char - -caseInsensitiveString :: String -> GenParser Char st String -caseInsensitiveString "" = return "" -caseInsensitiveString [x] = (: []) <$> caseInsensitiveChar x -caseInsensitiveString (x:xs) = do - c <- caseInsensitiveChar x - s <- caseInsensitiveString xs - return (c:s) - -caseInsensitiveChar :: Char -> GenParser Char st Char -caseInsensitiveChar c = char (toLower c) <|> char (toUpper c) diff --git a/src/TokenType.hs b/src/Token.hs similarity index 88% rename from src/TokenType.hs rename to src/Token.hs index 959a3a1..12734df 100644 --- a/src/TokenType.hs +++ b/src/Token.hs @@ -1,4 +1,4 @@ -module TokenType where +module Token where data Token = LeftParenT | RightParenT