diff options
Diffstat (limited to 'src/Evaluator.hs')
-rw-r--r-- | src/Evaluator.hs | 42 |
1 files changed, 26 insertions, 16 deletions
diff --git a/src/Evaluator.hs b/src/Evaluator.hs index 3d3be02..9e6632e 100644 --- a/src/Evaluator.hs +++ b/src/Evaluator.hs | |||
@@ -16,13 +16,20 @@ apply fn args = maybe | |||
16 | ($ args) | 16 | ($ args) |
17 | (lookup fn primitives) | 17 | (lookup fn primitives) |
18 | 18 | ||
19 | evalUnquoteSplicing :: Env -> Expr -> IOResult Expr | ||
20 | evalUnquoteSplicing env (List xs) = List <$> mapM (eval env) xs | ||
21 | evalUnquoteSplicing env literal = return literal | ||
22 | |||
19 | evalUnquote :: Env -> Expr -> IOResult Expr | 23 | evalUnquote :: Env -> Expr -> IOResult Expr |
20 | evalUnquote env (List [Id "unquote", vs]) = eval env vs | 24 | evalUnquote env (DottedList h t) = List . (:[]) <$> liftM2 DottedList (mapM (evalUnquote env) h) (evalUnquote env t) |
21 | evalUnquote env (List [Id "quote", vs]) = | 25 | evalUnquote env (Vector vs) = List . (:[]) . Vector <$> mapM (evalUnquote env) vs |
22 | fmap (List . ([Id "quote"] ++ ) . (: [])) (evalUnquote env vs) | 26 | evalUnquote env (List [Id "unquote", v]) = List . (:[]) <$> eval env v |
23 | evalUnquote env (List vs) = List <$> mapM (evalUnquote env) vs | 27 | evalUnquote env (List [Id "unquote-splicing", v]) = eval env v |
24 | evalUnquote env (Vector vs) = Vector <$> mapM (evalUnquote env) vs | 28 | evalUnquote env (List (Id "unquote-splicing":vs)) = List <$> mapM (eval env) vs |
25 | evalUnquote env literal = return literal | 29 | evalUnquote env (List (Id "unquote":vs)) = List . (:[]) . List <$> mapM (eval env) vs |
30 | evalUnquote env (List [Id "quote", vs]) = List . (:[]) <$> fmap (List . ([Id "quote"] ++ ) . (: [])) (evalUnquote env vs) | ||
31 | evalUnquote env (List vs) = List . concat <$> mapM ((unwrapList <$>) . evalUnquote env) vs | ||
32 | evalUnquote env literal = return $ List . (:[]) $ literal | ||
26 | 33 | ||
27 | evalQuasiQuote :: Env -> Expr -> IOResult Expr | 34 | evalQuasiQuote :: Env -> Expr -> IOResult Expr |
28 | evalQuasiQuote env v@(Vector _) = evalUnquote env v | 35 | evalQuasiQuote env v@(Vector _) = evalUnquote env v |
@@ -30,20 +37,23 @@ evalQuasiQuote env q@(List _) = evalUnquote env q -- list of atoms which may b | |||
30 | evalQuasiQuote env literal = return literal -- just behave like quote otherwise | 37 | evalQuasiQuote env literal = return literal -- just behave like quote otherwise |
31 | 38 | ||
32 | eval :: Env -> Expr -> IOResult Expr | 39 | eval :: Env -> Expr -> IOResult Expr |
33 | eval _ v@(StringLiteral s) = return v | 40 | eval _ v@(StringLiteral s) = return v |
34 | eval _ v@(IntLiteral i) = return v | 41 | eval _ v@(IntLiteral i) = return v |
35 | eval _ v@(BoolLiteral b) = return v | 42 | eval _ v@(BoolLiteral b) = return v |
36 | eval env (Id l) = getVar env l | 43 | eval env (Id l) = getVar env l |
37 | eval _ v@(FloatLiteral f) = return v | 44 | eval _ v@(FloatLiteral f) = return v |
38 | eval env v@(Vector xs) = Vector <$> mapM (eval env) xs | 45 | eval env v@(Vector xs) = Vector <$> mapM (eval env) xs |
39 | eval env (List[Id "quote", val]) = return val | 46 | eval env (List[Id "quote", val]) = return val |
40 | eval env (List[Id "quasiquote", val]) = evalQuasiQuote env val | 47 | eval env (List[Id "quasiquote", val]) = evalQuasiQuote env val |
41 | eval env v@(List[Id "unquote", val]) = throwError $ BadForm "Cannot use `unquote` outside quasiquote form" v | 48 | eval env v@(List[Id "unquote", val]) = throwError $ BadForm "Cannot use `unquote` outside quasiquote form" v |
49 | eval env v@(List[Id "unquote-splicing", val]) = throwError $ BadForm "Cannot use `unquote-splicing` outside quasiquote form" v | ||
42 | eval env (List [Id "set!", Id var, val]) = eval env val >>= uncurry (*>) . (setVar env var &&& pure) | 50 | eval env (List [Id "set!", Id var, val]) = eval env val >>= uncurry (*>) . (setVar env var &&& pure) |
43 | eval env (List [Id "define", Id var, val]) = eval env val >>= uncurry (*>) . (defineVar env var &&& pure) | 51 | eval env (List [Id "define", Id var, val]) = eval env val >>= uncurry (*>) . (defineVar env var &&& pure) |
44 | eval env (List (Id fn : args)) = mapM (eval env) args >>= liftLispResult . apply fn | 52 | eval env (List (Id fn : args)) = mapM (eval env) args >>= liftLispResult . apply fn |
45 | eval env NoReturn = throwError $ BadForm "Invalid usage of non-returning expression" NoReturn | ||
46 | 53 | ||
47 | -- handle bad forms | 54 | -- handle bad forms |
48 | eval env invalidForm = throwError $ BadForm "lisk can't recognize this form" invalidForm | 55 | eval env invalidForm = throwError $ BadForm "lisk can't recognize this form" invalidForm |
49 | 56 | ||
57 | unwrapList :: Expr -> [Expr] | ||
58 | unwrapList (List x) = x | ||
59 | unwrapList literal = [literal] | ||