Skip to content

Commit

Permalink
add basic quasiquote and unquote behaviour
Browse files Browse the repository at this point in the history
  • Loading branch information
nerdypepper committed Oct 16, 2020
1 parent 55065d6 commit 297b498
Show file tree
Hide file tree
Showing 2 changed files with 20 additions and 11 deletions.
2 changes: 1 addition & 1 deletion src/Error/Base.hs
Expand Up @@ -24,7 +24,7 @@ literal v = "`" <> v <> "`"

instance Show LispError where
show (Parse e) = "Parser Error: " ++ show e
show (BadForm s expr) = "Bad Form: " ++ literal s ++ ": " ++ show expr
show (BadForm s expr) = "Bad Form: " ++ s ++ ": " ++ show expr
-- TODO: clean this up
show (ArgCount fn n es)
| null es = "Invalid arity, " ++ literal fn ++ " expects " ++ show n ++ " or more expression(s)!"
Expand Down
29 changes: 19 additions & 10 deletions src/Evaluator.hs
@@ -1,5 +1,7 @@
module Evaluator (eval) where

import Control.Applicative ((*>))
import Control.Arrow ((&&&))
import Control.Monad.Except
import Environment
import Error.Base (LispError (..), LispResult (..),
Expand All @@ -14,6 +16,19 @@ apply fn args = maybe
($ args)
(lookup fn primitives)

evalUnquote :: Env -> Expr -> IOResult Expr
evalUnquote env (List [Id "unquote", vs]) = eval env vs
evalUnquote env (List [Id "quote", vs]) =
liftM (List . ([Id "quote"] ++ ) . (: [])) (evalUnquote env vs)
evalUnquote env (List vs) = liftM List $ mapM (evalUnquote env) vs
evalUnquote env (Vector vs) = liftM Vector $ mapM (evalUnquote env) vs
evalUnquote env literal = return literal

evalQuasiQuote :: Env -> Expr -> IOResult Expr
evalQuasiQuote env v@(Vector _) = evalUnquote env v
evalQuasiQuote env q@(List _) = evalUnquote env q -- list of atoms which may be quoted or unquoted
evalQuasiQuote env literal = return literal -- just behave like quote otherwise

eval :: Env -> Expr -> IOResult Expr
eval _ v@(StringLiteral s) = return v
eval _ v@(IntLiteral i) = return v
Expand All @@ -22,16 +37,10 @@ eval env (Id l) = getVar env l
eval _ v@(FloatLiteral f) = return v
eval env v@(Vector xs) = liftM Vector $ mapM (eval env) xs
eval env (List[Id "quote", val]) = return val
eval env (List[Id "quasiquote", val]) = undefined
eval env (List[Id "unquote", val]) = eval env val
eval env (List [Id "set!", Id var, val]) = do
e <- eval env val
setVar env var e
return e
eval env (List [Id "define", Id var, val]) = do
e <- eval env val
defineVar env var e
return e
eval env (List[Id "quasiquote", val]) = evalQuasiQuote env val
eval env v@(List[Id "unquote", val]) = throwError $ BadForm "Cannot use `unquote` form outside quasiquote context" v
eval env (List [Id "set!", Id var, val]) = eval env val >>= uncurry (*>) . ((setVar env var) &&& pure)
eval env (List [Id "define", Id var, val]) = eval env val >>= uncurry (*>) . ((defineVar env var) &&& pure)
eval env (List (Id fn : args)) = mapM (eval env) args >>= liftLispResult . apply fn
eval env NoReturn = throwError $ BadForm "Invalid usage of non-returning expression" NoReturn

Expand Down

0 comments on commit 297b498

Please sign in to comment.