
(* Author:  Walid Taha and Cristiano Calcagno
   Date:    Fri Aug 31 03:03:11 EDT 2001 *)

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

type dom = J of int
         | F of (dom -> dom)

let unJ(J i) = i
let unF(F f) = f

let term0 = A(L("x",V"x"),I 7)

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

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) -> (unF(eval e1 env)) (eval e2 env)
| L (x,e) -> F (fun v -> eval e (ext env x v))
| D e -> J ((unJ (eval e env))-1)
| C (e1,e2,e3) -> if (unJ(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)

let unstagedRunning = Trx.timenew "unstaged running"(fun () -> eval term1 env0)

let rec eval' e env =
match e with
  I i -> .<J i>.
| V s -> env s
| A (e1,e2) -> .<(unF .~(eval' e1 env)) (.~(eval' e2 env))>.
| L (x,e) -> .<F (fun v -> .~(eval' e (ext env x .<v>.)))>.
| D e -> .<J (unJ .~(eval' e env) - 1)>.
| C (e1,e2,e3) -> .< if (unJ .~(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)>.

let stage1Running =
  Trx.timenew "stage 10 running" (fun () -> eval' term1 env0)

let compiling = Trx.timenew "compiling"
                  (fun () -> .! .<fun () -> .~ stage1Running>.)

let stage2Running = Trx.timenew "stage 2 running" (fun () -> (compiling ()))

let unJ' = .<fun (J i) -> i>.
let unF' = .<fun (F f) -> f>.

let _ = Trx.print_times ()
