From e772da80f1aa3f41dedfbbf6dda64ecf36b38f2f Mon Sep 17 00:00:00 2001 From: jarnaldich Date: Tue, 13 Dec 2011 13:38:20 +0100 Subject: [PATCH] Seems to work --- evaluator.ml | 10 +++++----- interactive.ml | 4 ++-- types.ml | 2 +- types.mli | 2 +- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/evaluator.ml b/evaluator.ml index 1e7744b..41c11a7 100644 --- a/evaluator.ml +++ b/evaluator.ml @@ -7,8 +7,8 @@ I think this would be enough: - Rewind (application and call/cc) re-evaluates the last result, applying the last rib and popping a frame. - PopEnv (closure) Pop an environment frame. + Rewind (application and call/cc) re-evaluates the last result, applying the last rib and popping a result frame. + RestoreEnv (Env) Restore an environment (return from a closure) Cond of schemeobj * schemeobj If the last result is true, pile up the true case... Bind(var) per a define @@ -176,9 +176,9 @@ let rec eval (state:eval_state) : eval_state = eval (rewind { state with cont = rest }) | Closure (body, closure_env, formals) -> let env = (Environment.push_env_frame closure_env formals current_res_frame) in - eval { env; cont=body::PopEnv::rest; pending_results = older_res_frames } - | PopEnv -> - eval { state with env = (List.tl state.env); cont = rest } + eval { env; cont=body::(RestoreEnv state.env)::rest; pending_results = older_res_frames } + | RestoreEnv (env) -> + eval { state with env; cont = rest } | Continuation (saved_env, saved_cont, saved_res) -> eval { env=saved_env; cont= saved_cont; diff --git a/interactive.ml b/interactive.ml index eb64969..03a23b0 100644 --- a/interactive.ml +++ b/interactive.ml @@ -27,9 +27,9 @@ let go exp = let read s = Parser.main Lexer.token (Lexing.from_string s);; let rev x = go (read x);; -"(+ 1 (+ 1 (call/cc (lambda (k) (k 3))) 5) 3)" |> rev;; +(* "(+ 1 (+ 1 (call/cc (lambda (k) (k 3))) 5) 3)" |> rev;; *) -"(+ 1 1)" |> rev;; +(* "(+ 1 1)" |> rev;; *) (* "(define x 1)" |> rev;; *) (* "(define add-x (lambda (y) (+ x y)))" |> rev;; *) (* "(add-x 1)" |> rev;; *) diff --git a/types.ml b/types.ml index 915253f..8cf4d1b 100644 --- a/types.ml +++ b/types.ml @@ -13,7 +13,7 @@ type scheme_object = | Closure of scheme_object * scheme_environment * (symbol list) | Builtin of ((scheme_object list) -> (scheme_object option)) | Continuation of scheme_environment * (scheme_object list) * (scheme_object list list) - | PopEnv + | RestoreEnv of scheme_environment | Rewind | Cond of (scheme_object * scheme_object) | Set of string diff --git a/types.mli b/types.mli index b31180e..9ffa754 100644 --- a/types.mli +++ b/types.mli @@ -20,7 +20,7 @@ type scheme_object = | Closure of scheme_object * scheme_environment * (symbol list) | Builtin of ((scheme_object list) -> (scheme_object option)) | Continuation of scheme_environment * (scheme_object list) * (scheme_object list list) - | PopEnv + | RestoreEnv of scheme_environment | Rewind | Cond of (scheme_object * scheme_object) | Set of string -- 2.11.4.GIT