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 [([Char], Value)] (Either [String]) a

int :: !Expression -> Either [String] Value
int e = evalStateT (eval e)
	[(['_if'], Builtin \i->pure (Lit (Builtin \t->pure (Lit (Builtin \e->
		eval i >>= \(Bool b)->pure (if b t 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 :: (Value Value -> Value) -> Value
	binop op = Builtin \l->pure (Lit (Builtin \r->(o) Lit o op <$> eval l <*> eval r))

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 (Lambda a b) = pure (Lambda` a b)
eval (App e1 e2) = eval e1 >>= \v->case v of
	(Lambda` v b) = eval (sub v e2 b)
	(Builtin f) = f e2 >>= eval
where
	sub :: [Char] Expression Expression -> Expression
	sub i subs (Let ns rest)
		| not (isMember i (map fst ns)) = Let (fmap (sub i subs) <$> ns) (sub i subs rest)
	sub i subs (Var v)
		| i == v = subs
	sub i subs (App e1 e2) = App (sub i subs e1) (sub i subs e2)
	sub i subs (Lambda v b)
		| i <> v = Lambda v (sub i subs b)
	sub _ _ x = x