(* A strict functional language with integers and first-order 
   one-argument functions * sestoft@dina.kvl.dk 2000-09-20, 2002-02-24

   Does not admit mutually recursive function bindings.

   Performs tail recursion in constant space (because Moscow ML does).
*)

app load ["Env", "Absyn"];

open Env Absyn;

datatype value = 
    Int of int
  | RClo of string * string * expr * vfenv       (* (f, x, body, bodyenv) *)
withtype vfenv = (string, value) env

fun eval (e : expr) (env : vfenv) : int =
    case e of 
        CstI i => i
      | CstB b => if b then 1 else 0
      | Var x  => (case lookup env x of 
                       Int i => i 
                     | _     => raise Fail "eval Var")
      | Prim(ope, [e1, e2]) => 
            let val i1 = eval e1 env
                val i2 = eval e2 env
            in 
                case ope of
                    "*" => i1 * i2
                  | "+" => i1 + i2
                  | "-" => i1 - i2
                  | "=" => if i1 = i2 then 1 else 0
                  | "<" => if i1 < i2 then 1 else 0
                  | _   => raise Fail "unknown primitive"
            end
      | Prim _ => raise Fail "eval Prim: unknown arity"
      | Let(x, erhs, ebody) => 
            let val xval = eval erhs env
                val env1 = bind1 env (x, Int xval)
            in eval ebody env1 end
      | If(e1, e2, e3) => 
            let val b = eval e1 env
            in
                if b<>0 then eval e2 env
                else eval e3 env
            end
      | Letfun(f, x, fbody, ebody) => 
            let val env1 = bind1 env (f, RClo(f, x, fbody, env))
            in eval ebody env1 end
      | Call(Var f, earg) => 
            (case lookup env f of
                 fclosure as RClo (f, x, fbody, fenv) =>
                     let val argv = Int(eval earg env)
                         val env2 = bind1 fenv (f, fclosure)
                         val env3 = bind1 env2 (x, argv)
                     in eval fbody env3 end
               | _ => raise Fail "eval Call: not a function")
      | Call _ => raise Fail "eval Call: illegal function expression"

(* Examples in abstract syntax *)

val ex1 = Letfun("f1", "x", Prim("+", [Var "x", CstI 1]), 
                 Call(Var "f1", CstI 12));

(* Example: factorial *)

val ex2 = Letfun("fac", "x",
                 If(Prim("=", [Var "x", CstI 0]),
                    CstI 1,
                    Prim("*", [Var "x", 
                               Call(Var "fac", 
                                    Prim("-", [Var "x", CstI 1]))])),
                 Call(Var "fac", Var "n"));

val fac10 = eval ex2 (Env.fromList [("n", Int 10)]);

(* Example: deep recursion to check for constant-space tail recursion *)

val ex3 = Letfun("deep", "x", 
                 If(Prim("=", [Var "x", CstI 0]),
                    CstI 1,
                    Call(Var "deep", Prim("-", [Var "x", CstI 1]))),
                 Call(Var "deep", Var "count"));
    
fun rundeep n = eval ex3 (Env.fromList [("count", Int n)]);

(* Example: static scope (result 14) or dynamic scope (result 25) *)

val ex4 =
    Let("y", CstI 11,
        Letfun("f", "x", Prim("+", [Var "x", Var "y"]),
               Let("y", CstI 22, Call(Var "f", CstI 3))));

(* Example: two function definitions *)

val ex5 = 
    Letfun("ge2", "x", Prim("<", [CstI 1, Var "x"]),
           Letfun("fib", "n",
                  If(Call(Var "ge2", Var "n"),
                     Prim("+",
                          [Call(Var "fib", Prim("-", [Var "n", CstI 1])),
                           Call(Var "fib", Prim("-", [Var "n", CstI 2]))]),
                     CstI 1), Call(Var "fib", CstI 25)));