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