Compare commits
No commits in common. "d74730afdee6c6bfddafd1dd1232e2f2c4a74711" and "6b8b70fc20d394b8e109efd2b495eb39f110e0bb" have entirely different histories.
d74730afde
...
6b8b70fc20
|
@ -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
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue