Minor fixes and reworking of the code

This commit is contained in:
Ivy 2021-01-30 22:38:44 +01:00
parent 4807eb0cbe
commit 6994025cfb
8 changed files with 40 additions and 54 deletions

View File

@ -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

View File

@ -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)

View File

@ -1,6 +1,6 @@
module Evaluator where
import ExprType
import Expression
import Enviroment
import Data.Maybe

View File

@ -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"

View File

@ -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
------------------------------------------------------------

View File

@ -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

View File

@ -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)

View File

@ -1,4 +1,4 @@
module TokenType where
module Token where
data Token = LeftParenT
| RightParenT