cherry-lisp.cabal

@@ -22,8 +22,7 @@ executable cherry
                        Parser,
                        TokenType,
                        Lexer,
-                       Evaluator,
+                       Evaluator
-                       Enviroment
 
   build-depends:       base >= 4.7 && < 5,
                        containers,

src/Enviroment.hs

@@ -1,28 +0,0 @@
-module Enviroment where
-
-import qualified Data.Map as M
-import ExprType
-import Data.Maybe
-
-data Enviroment = Enviroment (M.Map String Expr) (Maybe Enviroment)
-
-base :: Enviroment
-base = Enviroment (M.fromList [
-  ("test-var", IntE 10),
-  ("id", LambdaE "x" $ VarE "x"),
-  ("first", LambdaE "x" $ LambdaE "y" $ VarE "x")
-  ]) Nothing
-
-lookupVar :: Enviroment -> String -> Maybe Expr
-lookupVar (Enviroment menv upperEnv) var = let mExpr = M.lookup var menv in
-  if isNothing mExpr then upperEnv >>= (`lookupVar` var) else mExpr
-
-insertVar :: Enviroment -> String -> Expr -> Enviroment
-insertVar (Enviroment menv u) var expr = Enviroment (M.insert var expr menv) u
-
-emptyEnv :: Enviroment
-emptyEnv = Enviroment M.empty Nothing
-
-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)

src/Evaluator.hs

@@ -1,25 +1,26 @@
 module Evaluator where
 
+import qualified Data.Map as M
 import ExprType
-import Enviroment
+
-import Data.Maybe
+type Env = M.Map String Expr
 
 -- TODO: create a separated file for builtinProcs
 -- TODO: create a BuiltinProc or something like that in data Expr, and make + a builtin proc
 
-eval :: Enviroment -> Expr -> (Enviroment, Expr)
+base :: Env
-eval env i@(IntE _)     = (env, i)
+base = M.fromList [
-eval env (VarE v)       = eval env $ fromJust $ lookupVar env v
+  ("test-var", IntE 10)
-eval env (SetE v expr)  = (insertVar env v expr, NilE)
+  ]
+
+eval :: Env -> Expr -> (Env, Expr)
+eval env i@(IntE x)    = (env, i)
+eval env (VarE v)      = (M.insert v nExpr nEnv, nExpr)
+  where (nEnv, nExpr)  = eval env $ env M.! v
+eval env (SetE v expr) = (M.insert v expr env, NilE)
 eval env (QuotedE e)    = (env, e)
-eval env (ConsE p args) = (fEnv, fExpr)
+eval env c@(ConsE _ _) = (env, c)
-  where (uEnv, ap)    = eval env p
-        (aEnv, aExpr) = apply ap args
-        (fEnv, fExpr) = eval (extendEnv aEnv uEnv) aExpr
-eval env (LambdaE arg expr) = (env, LambdaE arg expr)
 eval env NilE          = (env, NilE)
 
-apply :: Expr -> Expr -> (Enviroment, Expr)
+--apply :: Proc -> Args -> Expr
-apply (LambdaE p expr) (ConsE x xs) = (extendEnv (insertVar emptyEnv p x) nEnv, nExp)
+--apply p args
-  where (nEnv, nExp) = apply expr xs
-apply e NilE = (emptyEnv, e)

src/ExprType.hs

@@ -2,12 +2,11 @@ module ExprType where
 
 data Expr = IntE Integer
           | VarE String
+          | ProcedureE String [Expr]
           | SetE String Expr
           | ConsE Expr Expr
-          | LambdaE String Expr
           | QuotedE Expr
-          | NilE
+          | NilE deriving (Show)
-          deriving (Show)
 
 -- instance Show Expr where
 --   show (IntE x) = show x

src/Lexer.hs

@@ -12,7 +12,7 @@ parseTokens = do
     return tokns
 
 anyLispToken :: GenParser Char st Token
-anyLispToken = leftParenT <|> rightParenT <|> apostropheT <|> backslashT <|> symbolT <|> intT
+anyLispToken = leftParenT <|> rightParenT <|> apostropheT <|> symbolT <|> intT
 
 ------------------------------------------------------------
 
@@ -30,10 +30,7 @@ apostropheT = char '\'' >> return ApostropheT
 rightParenT :: GenParser Char st Token
 rightParenT = char ')' >> return RightParenT
 
-backslashT :: GenParser Char st Token
-backslashT = char '\\' >> return BackslashT
-
 symbolT :: GenParser Char st Token
 symbolT = do
-    var <- map toLower <$> many1 (letter <|> oneOf "+-*/!|@#$~%&/=<>")
+    var <- map toLower <$> many1 (letter <|> oneOf "+-*/\\!|@#$~%&/=<>")
     return $ SymbolT var

src/Main.hs

@@ -1,7 +1,6 @@
 module Main where
 
 import Evaluator
-import Enviroment
 import Parser
 import Control.Monad
 import Data.Maybe

src/Parser.hs

@@ -20,18 +20,9 @@ expressionFromTokensEOF = do
 
 expressionFromTokens :: GenParser Token st Expr
 expressionFromTokens = do
-  expr <- intE <|> quotedE <|> try setE <|> try nilE <|> try consE <|> try lambdaE <|> varE <|> listE
+  expr <- intE <|> quotedE <|> try setE <|> try nilE <|> try consE <|> varE <|> procedureE
   return expr
 
-listE :: GenParser Token st Expr
-listE = do
-  _ <- parseLeftParenT
-  exprs <- many expressionFromTokens
-  _ <- parseRightParenT
-  return $ toCons exprs
-  where toCons []     = NilE
-        toCons (x:xs) = ConsE x (toCons xs)
-
 intE :: GenParser Token st Expr
 intE = do
     (IntT num) <- parseIntT
@@ -43,6 +34,14 @@ quotedE = do
   expr <- expressionFromTokens
   return $ QuotedE expr
 
+procedureE :: GenParser Token st Expr
+procedureE = do
+  _ <- parseLeftParenT
+  (SymbolT p) <- parseSymbolT
+  args <- many expressionFromTokens
+  _ <- parseRightParenT
+  return $ ProcedureE p args
+
 consE :: GenParser Token st Expr
 consE = do
   _ <- parseLeftParenT
@@ -71,14 +70,6 @@ setE = do
   _ <- parseRightParenT
   return $ SetE var expr
 
-lambdaE :: GenParser Token st Expr
-lambdaE = do
-  _ <- parseBackslashT
-  (SymbolT arg) <- parseSymbolT
-  body <- expressionFromTokens
-  return $ LambdaE arg body
-
-
 ------------------------------------------------------------
 
 satisfyT :: (Stream s m a, Show a) => (a -> Bool) -> ParsecT s u m a
@@ -86,9 +77,6 @@ satisfyT f = tokenPrim show
                        (\pos _ _ -> incSourceColumn pos 1)
                        (\t -> if f t then Just t else Nothing)
 
-parseBackslashT :: GenParser Token st Token
-parseBackslashT = satisfyT (== BackslashT)
-
 parseLeftParenT :: GenParser Token st Token
 parseLeftParenT = satisfyT (== LeftParenT)
 

src/TokenType.hs

@@ -2,7 +2,6 @@ module TokenType where
 
 data Token = LeftParenT
            | RightParenT
-           | BackslashT
            | SymbolT String
            | ApostropheT
            | IntT Integer