Trx.init_times ()

type exp = I of int
         | V of string
         | A of exp * exp
         | L of string * exp
         | D of exp
         | C of exp * exp * exp
         | R of string * string * exp
         | Add of exp * exp
         | Sub of exp * exp
         | Mult of exp * exp
type dom = J of int
         | F of (dom -> dom)

exception Yiikes

let env0 = fun x -> raise Yiikes

let ext env x v = fun y -> if x=y then v else env y

let rec eval' e env =
match e with
  I i -> .<~~J i>.
| V s -> env s
| A (e1,e2) -> .<(~~F^ .~(eval' e1 env)) (.~(eval' e2 env))>.
| L (x,e) -> .<~~F (fun v -> .~(eval' e (ext env x .<v>.)))>.
| D e -> .<~~J (~~J^ .~(eval' e env) - 1)>.
| C (e1,e2,e3) -> .< if (~~J^ .~(eval' e1 env)) = 0 
                              then .~(eval' e2 env)
                              else .~(eval' e3 env) >.
| R (f,x,e) ->
  .<~~F (let rec ff xx = .~(eval' e (ext (ext env x .<xx>.) f .<~~F ff>.)) in ff)>.
| Add (e1,e2) -> .< ~~J((~~J^ (.~ (eval' e1 env))) + (~~J^ (.~(eval' e2 env)))) >.
| Sub (e1,e2) -> .< ~~J((~~J^ (.~ (eval' e1 env))) - (~~J^ (.~(eval' e2 env)))) >.
| Mult(e1,e2) -> .< ~~J((~~J^ (.~ (eval' e1 env))) * (~~J^ (.~(eval' e2 env)))) >.

let term0 = Add ((I 10), (I 5))


let term1 = A(R ("f", "n", C(V "n",I 42,A (V "f",D (V "n")))),I 1000)

let fibfun = R ("fib","n", C(Sub(V "n", I 1) , I 1, 
            C(Sub(V "n", I 2), I 1, Add(A (V "fib", Sub(V "n", I 1)), A (V "fib", Sub(V "n", I 2))))))
let facfun = R ("fac","n", C(V "n", I 1, Mult( V "n", A(V "fac", D (V "n")))))

let term2 = A(fibfun, I 10)
let term3 = A(facfun, I 12)
let term4 = Add (I 10, L("x", V"x"))

let st1 =  Trx.time 1000 "stage 1 running" (fun () -> eval' term3 env0)

let tagfree = Trx.time 1000 "Tag elimination running" 
	(fun () -> .& {(_,#J int) code} st1)

let competag = Trx.time 1000 "compiling tagfree"
	(fun () -> .! .<fun () -> .~ tagfree>.)
let comp = Trx.time 1000 "compiling tagged"
                  (fun () -> .! .<fun () -> .~ st1>.)

let st2etag = Trx.time 1000 "stage 2 running (tagless)" (fun () -> (competag ()))
let st2wtag = Trx.time 1000 "stage 2 runnint (tagged)"  (fun () -> (comp ()))



let _ = Trx.print_times ();;
