(* A functional language with integers and higher-order functions 
   sestoft@dina.kvl.dk 2001-02-28, 2002-03-02

   Does not admit mutually recursive function bindings.
 *)

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

open Absyn Env;

fun int2bool 0 = false
  | int2bool _ = true

fun bool2int false = 0
  | bool2int true  = 1

(* A functional value is a recursive closure. *)

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) : value =
    case e of 
        CstI i => Int i
      | CstB b => Int (bool2int b)
      | Var x  => lookup env x
      | Prim(ope, [e1, e2]) => 
            (case (eval e1 env, eval e2 env) of
                 (Int i1, Int i2) =>
                     (case ope of
                          "*" => Int(i1 * i2)
                        | "+" => Int(i1 + i2)
                        | "-" => Int(i1 - i2)
                        | "=" => Int (bool2int (i1 = i2))
                        | "<" => Int (bool2int (i1 < i2))
                        | _   => raise Fail "unknown primitive")
               | _ => raise Fail "eval Prim")
      | Prim _ => raise Fail "eval Prim: unknown arity"
      | Let(x, erhs, ebody) => 
            let val xval = eval erhs env
                val env1 = bind1 env (x, xval)
            in eval ebody env1 end
      | If(e1, e2, e3) => 
            (case eval e1 env of 
                 Int b => if int2bool b then eval e2 env
                          else eval e3 env
               | _     => raise Fail "eval If")
      | Letfun(f, x, fbody, ebody) => 
            let val env1 = bind1 env (f, RClo(f, x, fbody, env))
            in eval ebody env1 end
      | Call(efun, earg) => 
            (case eval efun env of
                 fclosure as RClo (f, x, fbody, fenv) =>
                     let val argv = 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");

(* Examples in abstract syntax *)

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

(* 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)]);

val ex3 = 
    Letfun("tw", "g", 
           Letfun("app", "x", Call(Var "g", Call(Var "g", Var "x")), 
                  Var "app"),
           Letfun("doubl", "y", Prim("*", [CstI 2, Var "y"]), 
                  Call(Call(Var "tw", Var "doubl"), CstI 11)));

val ex4 = 
    Letfun("tw", "g",
           Letfun("app", "x", Call(Var "g", Call(Var "g", Var "x")), 
                  Var "app"),
           Letfun("doubl", "y", Prim("*", [CstI 2, Var "y"]), 
                  Call(Var "tw", Var "doubl")));

val ex5 = 
    parses "let tw g = let app x = g (g x) in app end \
           \in let doubl x = 2 * x \
           \in let quad = tw doubl \
           \in quad 7 end end end";

val ex6 = 
    parses "let tw g = let app x = g (g x) in app end \
           \in let doubl x = 2 * x \
           \in let quad = tw doubl \
           \in quad end end end";

val ex7 = 
    parses "let rep n = \
                \let rep1 g = \
                     \let rep2 x = if n=0 then x else rep (n-1) g (g x) \
                     \in rep2 end \
                \in rep1 end \
           \in let doubl x = 2 * x \
           \in let tw = rep 2 \
           \in let quad = tw doubl \
           \in quad 7 end end end end";
val ex8 = 
    parses "let rep n = \
                \let rep1 g = \
                     \let rep2 x = if n=0 then x else rep (n-1) g (g x) \
                     \in rep2 end \
                \in rep1 end \
           \in let doubl x = 2 * x \
           \in let twototen = rep 10 doubl \
           \in twototen 7 end end end";
val ex9 = 
    parses "let rep n = \
                \let rep1 g = \
                     \let rep2 x = if n=0 then x else rep (n-1) g (g x) \
                     \in rep2 end \
                \in rep1 end \
           \in let doubl x = 2 * x \
           \in let twototen = (rep 10) doubl \
           \in twototen 7 end end end";