From 63a365f2140f962ce31e2d10a9cd5393c673d1ce Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sun, 7 Apr 2013 20:09:39 +0900
Subject: [PATCH] Factoring out generate opcode and exporting it.
---
eval.c | 42 ++++++++++++++++++++++++++++--------------
include/chibi/eval.h | 1 +
opcodes.c | 1 +
3 files changed, 30 insertions(+), 14 deletions(-)
diff --git a/eval.c b/eval.c
index 25e36a86..8705578c 100644
--- a/eval.c
+++ b/eval.c
@@ -80,7 +80,7 @@ static sexp sexp_env_cell_loc (sexp env, sexp key, int localp, sexp *varenv) {
return ls;
}
env = (localp ? NULL : sexp_env_parent(env));
- } while (env);
+ } while (env && sexp_envp(env));
return NULL;
}
@@ -2187,12 +2187,35 @@ sexp sexp_env_import_op (sexp ctx, sexp self, sexp_sint_t n, sexp to, sexp from,
/************************** eval interface ****************************/
+sexp sexp_generate_op (sexp ctx, sexp self, sexp_sint_t n, sexp ast, sexp env) {
+ sexp_gc_var3(ctx2, vec, res);
+ if (sexp_contextp(env)) {
+ ctx2 = env;
+ } else {
+ sexp_assert_type(ctx, sexp_envp, SEXP_ENV, env);
+ ctx2 = sexp_make_eval_context(ctx, NULL, env, 0, 0);
+ }
+ sexp_gc_preserve3(ctx, ctx2, vec, res);
+ sexp_free_vars(ctx2, ast, SEXP_NULL); /* should return SEXP_NULL */
+ sexp_emit_enter(ctx2);
+ sexp_generate(ctx2, 0, 0, 0, ast);
+ res = sexp_complete_bytecode(ctx2);
+ if (!sexp_exceptionp(res)) {
+ sexp_context_specific(ctx2) = SEXP_FALSE;
+ vec = sexp_make_vector(ctx2, 0, SEXP_VOID);
+ if (sexp_exceptionp(vec)) res = vec;
+ else res = sexp_make_procedure(ctx2, SEXP_ZERO, SEXP_ZERO, res, vec);
+ }
+ sexp_gc_release3(ctx);
+ return res;
+}
+
sexp sexp_compile_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp env) {
- sexp_gc_var4(ast, vec, tmp, res);
+ sexp_gc_var3(ast, tmp, res);
sexp ctx2;
if (! env) env = sexp_context_env(ctx);
sexp_assert_type(ctx, sexp_envp, SEXP_ENV, env);
- sexp_gc_preserve4(ctx, ast, vec, tmp, res);
+ sexp_gc_preserve3(ctx, ast, tmp, res);
ctx2 = sexp_make_eval_context(ctx, NULL, env, 0, 0);
if (sexp_exceptionp(ctx2)) {
res = ctx2;
@@ -2209,22 +2232,13 @@ sexp sexp_compile_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp env) {
if (sexp_exceptionp(ast)) {
res = ast;
} else {
- sexp_free_vars(ctx2, ast, SEXP_NULL); /* should return SEXP_NULL */
- sexp_emit_enter(ctx2);
- sexp_generate(ctx2, 0, 0, 0, ast);
- res = sexp_complete_bytecode(ctx2);
- if (!sexp_exceptionp(res)) {
- sexp_context_specific(ctx2) = SEXP_FALSE;
- vec = sexp_make_vector(ctx2, 0, SEXP_VOID);
- if (sexp_exceptionp(vec)) res = vec;
- else res = sexp_make_procedure(ctx2, SEXP_ZERO, SEXP_ZERO, res, vec);
- }
+ res = sexp_generate_op(ctx2, self, n, ast, ctx2);
}
}
sexp_context_child(ctx) = tmp;
sexp_context_last_fp(ctx) = sexp_context_last_fp(ctx2);
}
- sexp_gc_release4(ctx);
+ sexp_gc_release3(ctx);
return res;
}
diff --git a/include/chibi/eval.h b/include/chibi/eval.h
index f6e04631..aa996af7 100644
--- a/include/chibi/eval.h
+++ b/include/chibi/eval.h
@@ -80,6 +80,7 @@ SEXP_API void sexp_stack_trace (sexp ctx, sexp out);
SEXP_API sexp sexp_free_vars (sexp context, sexp x, sexp fv);
SEXP_API int sexp_param_index (sexp lambda, sexp name);
SEXP_API sexp sexp_compile_op (sexp context, sexp self, sexp_sint_t n, sexp obj, sexp env);
+SEXP_API sexp sexp_generate_op (sexp context, sexp self, sexp_sint_t n, sexp obj, sexp env);
SEXP_API sexp sexp_eval_op (sexp context, sexp self, sexp_sint_t n, sexp obj, sexp env);
SEXP_API sexp sexp_eval_string (sexp context, const char *str, sexp_sint_t len, sexp env);
SEXP_API sexp sexp_load_op (sexp context, sexp self, sexp_sint_t n, sexp expr, sexp env);
diff --git a/opcodes.c b/opcodes.c
index f333eaa7..371c84f2 100644
--- a/opcodes.c
+++ b/opcodes.c
@@ -167,6 +167,7 @@ _FN0(_I(SEXP_ENV), "make-environment", 0, sexp_make_env_op),
_FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "null-environment", 0, sexp_make_null_env_op),
_FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "scheme-report-environment", 0, sexp_make_standard_env_op),
_FN2OPTP(_I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_ENV), "compile", (sexp)"interaction-environment", sexp_compile_op),
+_FN2OPTP(_I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_ENV), "generate", (sexp)"interaction-environment", sexp_generate_op),
_FN2OPTP(SEXP_VOID, _I(SEXP_STRING), _I(SEXP_ENV), "%load", (sexp)"interaction-environment", sexp_load_op),
_FN4(SEXP_VOID, _I(SEXP_ENV), _I(SEXP_ENV), _I(SEXP_OBJECT), "%import", 0, sexp_env_import_op),
_FN2OPTP(SEXP_VOID, _I(SEXP_EXCEPTION), _I(SEXP_OPORT), "print-exception", (sexp)"current-error-port", sexp_print_exception_op),