aboutsummaryrefslogtreecommitdiff
path: root/src/Evaluator.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Evaluator.hs')
-rw-r--r--src/Evaluator.hs29
1 files changed, 19 insertions, 10 deletions
diff --git a/src/Evaluator.hs b/src/Evaluator.hs
index e3bf697..1cc9edd 100644
--- a/src/Evaluator.hs
+++ b/src/Evaluator.hs
@@ -1,5 +1,7 @@
1module Evaluator (eval) where 1module Evaluator (eval) where
2 2
3import Control.Applicative ((*>))
4import Control.Arrow ((&&&))
3import Control.Monad.Except 5import Control.Monad.Except
4import Environment 6import Environment
5import Error.Base (LispError (..), LispResult (..), 7import Error.Base (LispError (..), LispResult (..),
@@ -14,6 +16,19 @@ apply fn args = maybe
14 ($ args) 16 ($ args)
15 (lookup fn primitives) 17 (lookup fn primitives)
16 18
19evalUnquote :: Env -> Expr -> IOResult Expr
20evalUnquote env (List [Id "unquote", vs]) = eval env vs
21evalUnquote env (List [Id "quote", vs]) =
22 liftM (List . ([Id "quote"] ++ ) . (: [])) (evalUnquote env vs)
23evalUnquote env (List vs) = liftM List $ mapM (evalUnquote env) vs
24evalUnquote env (Vector vs) = liftM Vector $ mapM (evalUnquote env) vs
25evalUnquote env literal = return literal
26
27evalQuasiQuote :: Env -> Expr -> IOResult Expr
28evalQuasiQuote env v@(Vector _) = evalUnquote env v
29evalQuasiQuote env q@(List _) = evalUnquote env q -- list of atoms which may be quoted or unquoted
30evalQuasiQuote env literal = return literal -- just behave like quote otherwise
31
17eval :: Env -> Expr -> IOResult Expr 32eval :: Env -> Expr -> IOResult Expr
18eval _ v@(StringLiteral s) = return v 33eval _ v@(StringLiteral s) = return v
19eval _ v@(IntLiteral i) = return v 34eval _ v@(IntLiteral i) = return v
@@ -22,16 +37,10 @@ eval env (Id l) = getVar env l
22eval _ v@(FloatLiteral f) = return v 37eval _ v@(FloatLiteral f) = return v
23eval env v@(Vector xs) = liftM Vector $ mapM (eval env) xs 38eval env v@(Vector xs) = liftM Vector $ mapM (eval env) xs
24eval env (List[Id "quote", val]) = return val 39eval env (List[Id "quote", val]) = return val
25eval env (List[Id "quasiquote", val]) = undefined 40eval env (List[Id "quasiquote", val]) = evalQuasiQuote env val
26eval env (List[Id "unquote", val]) = eval env val 41eval env v@(List[Id "unquote", val]) = throwError $ BadForm "Cannot use `unquote` form outside quasiquote context" v
27eval env (List [Id "set!", Id var, val]) = do 42eval env (List [Id "set!", Id var, val]) = eval env val >>= uncurry (*>) . ((setVar env var) &&& pure)
28 e <- eval env val 43eval env (List [Id "define", Id var, val]) = eval env val >>= uncurry (*>) . ((defineVar env var) &&& pure)
29 setVar env var e
30 return e
31eval env (List [Id "define", Id var, val]) = do
32 e <- eval env val
33 defineVar env var e
34 return e
35eval env (List (Id fn : args)) = mapM (eval env) args >>= liftLispResult . apply fn 44eval env (List (Id fn : args)) = mapM (eval env) args >>= liftLispResult . apply fn
36eval env NoReturn = throwError $ BadForm "Invalid usage of non-returning expression" NoReturn 45eval env NoReturn = throwError $ BadForm "Invalid usage of non-returning expression" NoReturn
37 46