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

   Does not admit mutually recursive function bindings.
 *)

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

open Absyn Env;

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

datatype value = 
    Int of int
  | RClo of string * string * expr * vfenv       (* (f, x, fbody, fenv) *)

withtype vfenv = (string, value) env


fun eval (e : expr) (env : vfenv) : value =
    case e of 
        CstI i => Int i
      | CstB b => Int (if b then 1 else 0)
      | Var x  => lookup env x
      | Prim(ope, [e1, e2]) => 
	    let val v1 = eval e1 env
                val v2 = eval e2 env
            in 
		case (ope, v1, v2) of
		    ("*", Int i1, Int i2) => Int(i1 * i2)
		  | ("+", Int i1, Int i2) => Int(i1 + i2)
		  | ("-", Int i1, Int i2) => Int(i1 - i2)
		  | ("=", Int i1, Int i2) => Int (if i1 = i2 then 1 else 0)
		  | ("<", Int i1, Int i2) => Int (if i1 < i2 then 1 else 0)
		  |  _ => raise Fail "unknown primitive or wrong type"
	    end
      | 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 b<>0 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) => 
	    let val fclosure = eval efun env
	    in 
		case fclosure of
		    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"
	    end

(* 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 = 
    parse "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 = 
    parse "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 = 
    parse "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 = 
    parse "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 = 
    parse "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";
*)