epsilon/src/Language/Epsilon/Eval.hs

43 lines
1.1 KiB
Haskell

module Language.Epsilon.Eval (eval) where
import Control.Monad.Except (throwError)
import Data.Text (Text)
import Language.Epsilon.Types
import qualified Language.Epsilon.Prims as Prims
prims = ("eval", Prim PrimFn eval) : Prims.prims
eval :: Value -> EvalM Value
eval (Snoc f x) = apply f x
eval (Symbol s) = maybe (throwError (Unbound s)) return $ lookup s prims
eval (Quote q) = return q
eval x = return x
apply :: Value -> Value -> EvalM Value
apply (Snoc f x) y = do
f' <- apply f x
apply f' y
apply (Fn v f) x = do
x' <- eval x
eval $ subst v x' f
apply (Macro v f) x = eval (subst v x f) >>= eval
apply (Prim PrimFn f) x = eval x >>= f >>= eval
apply (Prim PrimMacro f) x = f x
apply Nil x = eval x
apply f x = throwError $ BadApply f x
subst :: Ident -> Value -> Value -> Value
subst i e (Snoc a d) = Snoc (subst i e a) (subst i e d)
subst i e expr@(Fn v b)
| i == v = expr
| otherwise = Fn v $ subst i e b
subst i e expr@(Macro v b)
| i == v = expr
| otherwise = Macro v $ subst i e b
subst _ _ (Quote q) = Quote q
subst i e expr@(Symbol i')
| i == i' = e
| otherwise = expr
subst _ _ expr = expr