implementation module int

import StdEnv
import Data.Either
import Data.Functor
import Data.Maybe
import Data.List
import Data.Tuple
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans

import ast

:: Eval a :== StateT EvalState (Either [String]) a
:: EvalState :== [([Char], Value)]

int :: Expression -> Either [String] Value
int e = evalStateT (eval e)
	[(['_if'], Func \i->pure (Func \t->pure (Func \e->eval i >>= \(Bool b)->if b (eval t) (eval e))))
	,(['_eq'],  binop \(Int i) (Int j)->Bool (i==j))
	,(['_sub'], binop \(Int i) (Int j)->Int  (i-j))
	,(['_add'], binop \(Int i) (Int j)->Int  (i+j))
	,(['_mul'], binop \(Int i) (Int j)->Int  (i*j))
	,(['_div'], binop \(Int i) (Int j)->Int  (i/j))
	]
where
	binop op = Func \l->pure (Func \r->op <$> eval l <*> eval r)

sub :: [Char] Expression Expression -> Expression
sub ident subst (Let ns rest)
	| not (isMember ident (map fst ns))
		= Let (fmap (sub ident subst) <$> ns) (sub ident subst rest)
sub ident subst (Var v)
	| ident == v = subst
sub ident subst (App e1 e2) = App (sub ident subst e1) (sub ident subst e2)
sub ident subst (Lambda v b)
	| ident <> v = Lambda v (sub ident b subst)
sub _ _ x = x

eval :: Expression -> Eval Value
eval (Let ns rest) = sequence [eval v >>= \v->modify (\vs->[(n, v):vs])\\(n, v)<-ns] >>| eval rest
eval (Lit v) = pure v
eval (Var v) = gets (lookup v) >>= maybe (liftT (Left [toString v +++ " not found"])) pure
eval (App e1 e2) = eval e1 >>= \(Func v)->v e2
eval (Lambda a b) = pure (Func \arg->eval (sub a arg b))