cherry-lisp.cabal

@@ -28,5 +28,4 @@ executable cherry
   build-depends:       base >= 4.7 && < 5,
                        containers,
                        parsec,
-                       haskeline,
-                       mtl
+                       haskeline

src/Enviroment.hs

@@ -13,17 +13,17 @@ base = Enviroment (M.fromList [
   ("const", LambdaE "x" $ LambdaE "y" $ VarE "x") -- Given two expressions, returns the first expression
   ]) Nothing
 
-lookupVar :: String -> Enviroment -> Maybe Expr
-lookupVar var (Enviroment menv upperEnv) = let mExpr = M.lookup var menv in
-  if isNothing mExpr then upperEnv >>= lookupVar var else mExpr
+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 :: String -> Expr -> Enviroment -> Enviroment
-insertVar var expr (Enviroment menv u) = Enviroment (M.insert var expr menv) u
+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
 
--- Returns a copy of the second enviroment whose upper enviroment is the first
+-- Returns a copy of the first enviroment whose upper enviroment is the second
 extendEnv :: Enviroment -> Enviroment -> Enviroment
-extendEnv upper (Enviroment menv Nothing) = Enviroment menv (Just upper)
-extendEnv upper (Enviroment menv (Just upperMenv)) = Enviroment menv (Just $ extendEnv upperMenv upper)
+extendEnv (Enviroment menv Nothing) upper = Enviroment menv (Just upper)
+extendEnv (Enviroment menv (Just upperMenv)) upper = Enviroment menv (Just $ extendEnv upperMenv upper)

src/Evaluator.hs

@@ -3,30 +3,23 @@ module Evaluator where
 import Expression
 import Enviroment
 import Data.Maybe
-import Control.Monad.State
 
 -- TODO: create a separated file for builtinProcs
 -- TODO: create a BuiltinProc or something like that in data Expr, and make + a builtin proc
 
-evalS :: Expr -> State Enviroment Expr
-evalS i@(IntE _) = return i
-evalS (VarE v) = do
-  get >>= evalS . fromJust . lookupVar v
-evalS (SetE v expr) = do
-  get >>= put . insertVar v expr
-  return NilE
-evalS (QuotedE e) = return e
-evalS (ConsE pr args) = do
-  evaluatedProc <- evalS pr
-  resExpr <- applyS evaluatedProc args
-  finalExpr <- evalS resExpr
-  return finalExpr
-evalS l@(LambdaE _ _) = return l
-evalS NilE = return NilE
+eval :: Enviroment -> Expr -> (Enviroment, Expr)
+eval env i@(IntE _)     = (env, i)
+eval env (VarE v)       = eval env $ fromJust $ lookupVar env v
+eval env (SetE v expr)  = (insertVar env v expr, NilE)
+eval env (QuotedE e)    = (env, e)
+eval env (ConsE p args) = (fEnv, fExpr)
+  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)
 
-applyS :: Expr -> Expr -> State Enviroment Expr
-applyS (LambdaE p expr) (ConsE x xs) = do
-  e <- applyS expr xs
-  get >>= put . (`extendEnv` insertVar p x emptyEnv)
-  return e
-applyS e NilE = return e
+apply :: Expr -> Expr -> (Enviroment, Expr)
+apply (LambdaE p expr) (ConsE x xs) = (extendEnv (insertVar emptyEnv p x) nEnv, nExp)
+  where (nEnv, nExp) = apply expr xs
+apply e NilE = (emptyEnv, e)

src/Main.hs

@@ -6,7 +6,6 @@ import Parser
 import Control.Monad
 import Data.Maybe
 import System.Console.Haskeline
-import Control.Monad.State
 
 main :: IO ()
 main = do
@@ -20,10 +19,10 @@ repl = do
           line <- getInputLine "cherry> "
           unless (isNothing line) $ do
             let expr = parseExpression $ fromJust line
-            let (out, nEnv) = case expr of
-                  (Left err)    -> (show err, env)
-                  (Right expr') -> let (nExp, env') = runState (evalS expr') env
-                                   in (show nExp, env')
+            let (nEnv, out) = case expr of
+                  (Left err)    -> (env, show err)
+                  (Right expr') -> let (env', nExp) = eval env expr'
+                                   in (env', show nExp)
             outputStrLn out
             repl' nEnv