diff --git a/cherry-lisp.cabal b/cherry-lisp.cabal index c757fbd..439a9bc 100644 --- a/cherry-lisp.cabal +++ b/cherry-lisp.cabal @@ -28,4 +28,5 @@ executable cherry build-depends: base >= 4.7 && < 5, containers, parsec, - haskeline + haskeline, + mtl diff --git a/src/Enviroment.hs b/src/Enviroment.hs index 549ea2a..c0cc3e3 100644 --- a/src/Enviroment.hs +++ b/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) diff --git a/src/Evaluator.hs b/src/Evaluator.hs index 9bd1da6..65fa612 100644 --- a/src/Evaluator.hs +++ b/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 diff --git a/src/Main.hs b/src/Main.hs index 9487648..1f5885d 100644 --- a/src/Main.hs +++ b/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