type exp = Int of int | Add of exp * exp | Sub of exp * exp | Mul of exp * exp | Div of exp * exp | Bool of bool | Zero of exp | Equal of exp * exp | Cond of exp * exp * exp | One | Shi of exp | Lam of exp | App of exp * exp | Fix of exp exception Unreachable type value = ValInt of int | ValBool of bool | ValFun of exp * environ and environ = value list let eval(exp) = let rec ev = function (Int i, _) -> ValInt i | (Add (exp1, exp2), env) -> let ValInt i1 = ev(exp1, env) and ValInt i2 = ev(exp2, env) in ValInt (i1 + i2) | (Sub (exp1, exp2), env) -> let ValInt i1 = ev(exp1, env) and ValInt i2 = ev(exp2, env) in ValInt (i1 - i2) | (Mul (exp1, exp2), env) -> let ValInt i1 = ev(exp1, env) and ValInt i2 = ev(exp2, env) in ValInt (i1 * i2) | (Div (exp1, exp2), env) -> let ValInt i1 = ev(exp1, env) and ValInt i2 = ev(exp2, env) in ValInt (i1 / i2) | (Bool b, _) -> ValBool b | (Zero exp, env) -> let ValInt i = ev(exp, env) in ValBool (i = 0) | (Cond (exp, exp1, exp2), env) -> let ValBool b = ev(exp, env) in if b then ev(exp1, env) else ev(exp2, env) | (Equal(exp1, exp2), env) -> let ValInt i1 = ev(exp1, env) and ValInt i2 = ev(exp2, env) in ValBool (i1 = i2) | (One, v :: _) -> v | (Shi(exp), _ :: env) -> ev(exp, env) | (Lam _ as f, env) -> ValFun(f, env) | (App(exp1, exp2), env) -> let fexp = ev(exp1, env) and farg = ev(exp2, env) in let ValFun(f, env) = fexp in begin match f with Lam body -> ev(body, farg :: env) | Fix (Lam body) -> ev(body, farg :: fexp :: env) end | (Fix f as exp, env) -> ValFun(f, ValFun(exp, env) :: env) | _ -> raise Unreachable (* this can be safely eliminated *) in ev(exp, []) let test times code arg = let start = Sys.time () in let _ = for i = 1 to times do code arg done in let finish = Sys.time () in let sys_time = finish -. start in Printf.printf ("The sys time is %f.\n") sys_time let fact = Fix(Lam(Cond(Zero(One), Int 1, Mul(One, App(Shi(One), Sub(One, Int 1)))))) let fib = Fix(Lam(Cond(Equal(One, Int 1), Int 1, Cond(Equal(One, Int 2), Int 1, Add(App(Shi(One), Sub(One, Int 1)), App(Shi(One), Sub(One, Int 2))))))) let _ = test 1 eval (App(fib, Int 30)) ;;