aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Error/Base.hs2
-rw-r--r--src/Evaluator.hs29
2 files changed, 20 insertions, 11 deletions
diff --git a/src/Error/Base.hs b/src/Error/Base.hs
index ef32d52..747904a 100644
--- a/src/Error/Base.hs
+++ b/src/Error/Base.hs
@@ -24,7 +24,7 @@ literal v = "`" <> v <> "`"
24 24
25instance Show LispError where 25instance Show LispError where
26 show (Parse e) = "Parser Error: " ++ show e 26 show (Parse e) = "Parser Error: " ++ show e
27 show (BadForm s expr) = "Bad Form: " ++ literal s ++ ": " ++ show expr 27 show (BadForm s expr) = "Bad Form: " ++ s ++ ": " ++ show expr
28 -- TODO: clean this up 28 -- TODO: clean this up
29 show (ArgCount fn n es) 29 show (ArgCount fn n es)
30 | null es = "Invalid arity, " ++ literal fn ++ " expects " ++ show n ++ " or more expression(s)!" 30 | null es = "Invalid arity, " ++ literal fn ++ " expects " ++ show n ++ " or more expression(s)!"
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