Minor fixes and reworking of the code
This commit is contained in:
parent
4807eb0cbe
commit
6994025cfb
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
module Evaluator where
|
||||
|
||||
import ExprType
|
||||
import Expression
|
||||
import Enviroment
|
||||
import Data.Maybe
|
||||
|
||||
|
|
|
@ -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"
|
14
src/Lexer.hs
14
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
|
||||
|
||||
------------------------------------------------------------
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
|
@ -1,4 +1,4 @@
|
|||
module TokenType where
|
||||
module Token where
|
||||
|
||||
data Token = LeftParenT
|
||||
| RightParenT
|
Loading…
Reference in New Issue