Compare commits

..

No commits in common. "d74730afdee6c6bfddafd1dd1232e2f2c4a74711" and "6b8b70fc20d394b8e109efd2b495eb39f110e0bb" have entirely different histories.

4 changed files with 28 additions and 37 deletions

View File

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

View File

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

View File

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

View File

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