Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 06:39:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Factoring out generate opcode and exporting it.

Browse source
This commit is contained in:
Alex Shinn 2013-04-07 20:09:39 +09:00
parent f4b42132a3
commit 63a365f214
3 changed files with 30 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
eval.c
View file

@ -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;
}

1
include/chibi/eval.h
View file

@ -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);

1
opcodes.c
View file

@ -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),