Merge branch 'main' of ssh://git.fai.su:1500/Suguivy/cherry-lisp

cherry-lisp.cabal

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

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 :: 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
+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
 
-insertVar :: Enviroment -> String -> Expr -> Enviroment
-insertVar (Enviroment menv u) var expr = Enviroment (M.insert var expr menv) u
+insertVar :: String -> Expr -> Enviroment -> Enviroment
+insertVar var expr (Enviroment menv u) = 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
+-- Returns a copy of the second enviroment whose upper enviroment is the first
 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)
+extendEnv upper (Enviroment menv Nothing) = Enviroment menv (Just upper)
+extendEnv upper (Enviroment menv (Just upperMenv)) = Enviroment menv (Just $ extendEnv upperMenv upper)

src/Evaluator.hs

@@ -3,23 +3,30 @@ 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
 
-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)
+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
 
-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)
+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

src/Main.hs

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