From b638b9f1b4a6a5c1b656b57ec32f43653ce5bc6a Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 12 Jan 2014 19:29:11 +0900 Subject: [PATCH] Hygiene change. Removing syntactic closure flattening to support unhygienic insertion. Breaks the previous assumption that syntactic closures were never nested. --- eval.c | 151 ++++++++++++++++++++++----------------- include/chibi/eval.h | 6 +- include/chibi/features.h | 4 ++ include/chibi/sexp.h | 5 +- lib/chibi/ast.c | 4 +- lib/chibi/heap-stats.c | 3 +- lib/srfi/18/threads.c | 4 +- main.c | 14 ++-- vm.c | 10 +-- 9 files changed, 111 insertions(+), 90 deletions(-) diff --git a/eval.c b/eval.c index c8666573..2b5a7ed7 100644 --- a/eval.c +++ b/eval.c @@ -80,17 +80,21 @@ sexp sexp_maybe_wrap_error (sexp ctx, sexp obj) { /* Look for the first defined instance of the variable. If not found, */ /* return the first undefined instance. */ -static sexp sexp_env_cell_loc (sexp env, sexp key, int localp, sexp *varenv) { - sexp ls, undefined = NULL, undefined_env = NULL; +static sexp sexp_env_cell_loc1 (sexp env, sexp key, int localp, sexp *varenv, + sexp *undefined, sexp *undefined_env) { + sexp ls; do { #if SEXP_USE_RENAME_BINDINGS for (ls=sexp_env_renames(env); sexp_pairp(ls); ls=sexp_env_next_cell(ls)) if (sexp_car(ls) == key) { + /* export-all hack - if this cell is undefined, only use it if */ + /* there is no other defined cell that matches. */ + /* TODO: order the environments properly and remove this */ if (sexp_pairp(sexp_cdr(ls)) && sexp_cdr(sexp_cdr(ls)) == SEXP_UNDEF) { if (!undefined) { - undefined_env = env; - undefined = sexp_cdr(ls); + *undefined_env = env; + *undefined = sexp_cdr(ls); } } else { if (varenv) *varenv = env; @@ -102,8 +106,8 @@ static sexp sexp_env_cell_loc (sexp env, sexp key, int localp, sexp *varenv) { if (sexp_car(ls) == key) { if (sexp_cdr(ls) == SEXP_UNDEF) { if (!undefined) { - undefined_env = env; - undefined = ls; + *undefined_env = env; + *undefined = ls; } } else { if (varenv) *varenv = env; @@ -113,16 +117,28 @@ static sexp sexp_env_cell_loc (sexp env, sexp key, int localp, sexp *varenv) { env = (localp ? NULL : sexp_env_parent(env)); } while (env && sexp_envp(env)); - if (undefined) { - if (varenv) *varenv = undefined_env; - return undefined; - } - return NULL; } -sexp sexp_env_cell (sexp env, sexp key, int localp) { - return sexp_env_cell_loc(env, key, localp, NULL); +static sexp sexp_env_cell_loc (sexp ctx, sexp env, sexp key, int localp, sexp *varenv) { + sexp cell, undefined = NULL, undefined_env = NULL; + cell = sexp_env_cell_loc1(env, key, localp, varenv, &undefined, &undefined_env); + while (!cell && sexp_synclop(key)) { + if (sexp_not(sexp_memq(ctx, sexp_synclo_expr(key), sexp_context_fv(ctx))) + && sexp_not(sexp_memq(ctx, sexp_synclo_expr(key), sexp_synclo_free_vars(key)))) + env = sexp_synclo_env(key); + key = sexp_synclo_expr(key); + cell = sexp_env_cell_loc1(env, key, 0, varenv, &undefined, &undefined_env); + } + if (!cell && undefined) { + if (varenv) *varenv = undefined_env; + return undefined; + } + return cell; +} + +sexp sexp_env_cell (sexp ctx, sexp env, sexp key, int localp) { + return sexp_env_cell_loc(ctx, env, key, localp, NULL); } static sexp sexp_env_undefine (sexp ctx, sexp env, sexp key) { @@ -164,13 +180,13 @@ sexp sexp_env_cell_define (sexp ctx, sexp env, sexp key, static sexp sexp_env_cell_create (sexp ctx, sexp env, sexp key, sexp value, sexp *varenv) { - sexp cell = sexp_env_cell_loc(env, key, 0, varenv); + sexp cell = sexp_env_cell_loc(ctx, env, key, 0, varenv); if (!cell) cell = sexp_env_cell_define(ctx, env, key, value, varenv); return cell; } -sexp sexp_env_ref (sexp env, sexp key, sexp dflt) { - sexp cell = sexp_env_cell(env, key, 0); +sexp sexp_env_ref (sexp ctx, sexp env, sexp key, sexp dflt) { + sexp cell = sexp_env_cell(ctx, env, key, 0); return (cell ? sexp_cdr(cell) : dflt); } @@ -178,7 +194,7 @@ sexp sexp_env_define (sexp ctx, sexp env, sexp key, sexp value) { sexp cell, tmp, res = SEXP_VOID; if (sexp_immutablep(env)) return sexp_user_exception(ctx, NULL, "immutable binding", key); - cell = sexp_env_cell(env, key, 1); + cell = sexp_env_cell(ctx, env, key, 1); if (!cell) { sexp_env_push(ctx, env, tmp, key, value); } else if (sexp_immutablep(cell)) { @@ -267,18 +283,27 @@ static sexp sexp_flatten_dot (sexp ctx, sexp ls) { return sexp_nreverse(ctx, sexp_reverse_flatten_dot(ctx, ls)); } -int sexp_param_index (sexp lambda, sexp name) { - sexp ls = sexp_lambda_params(lambda); - int i = 0; - for (i=0; sexp_pairp(ls); ls=sexp_cdr(ls), i++) - if (sexp_car(ls) == name) +int sexp_param_index (sexp ctx, sexp lambda, sexp name) { + sexp ls; + int i; + while (1) { + i = 0; + ls = sexp_lambda_params(lambda); + for (i=0; sexp_pairp(ls); ls=sexp_cdr(ls), i++) + if (sexp_car(ls) == name) + return i; + if (ls == name) return i; - if (ls == name) - return i; - ls = sexp_lambda_locals(lambda); - for (i=-1; sexp_pairp(ls); ls=sexp_cdr(ls), i--) - if (sexp_car(ls) == name) - return i-4; + ls = sexp_lambda_locals(lambda); + for (i=-1; sexp_pairp(ls); ls=sexp_cdr(ls), i--) + if (sexp_car(ls) == name) + return i-4; + if (sexp_synclop(name)) + name = sexp_synclo_expr(name); + else + break; + } + sexp_warn(ctx, "can't happen: no argument: ", name); return -10000; } @@ -384,7 +409,7 @@ sexp sexp_make_synclo_op (sexp ctx, sexp self, sexp_sint_t n, sexp env, sexp fv, if (! (sexp_symbolp(expr) || sexp_pairp(expr) || sexp_synclop(expr))) return expr; res = sexp_alloc_type(ctx, synclo, SEXP_SYNCLO); - if (sexp_synclop(expr)) { + if (SEXP_USE_FLAT_SYNTACTIC_CLOSURES && sexp_synclop(expr)) { sexp_synclo_env(res) = sexp_synclo_env(expr); sexp_synclo_free_vars(res) = sexp_synclo_free_vars(expr); sexp_synclo_expr(res) = sexp_synclo_expr(expr); @@ -566,6 +591,11 @@ sexp sexp_make_child_context (sexp ctx, sexp lambda) { /**************************** identifiers *****************************/ +int sexp_idp (sexp x) { + while (sexp_synclop(x)) x = sexp_synclo_expr(x); + return sexp_symbolp(x); +} + sexp sexp_identifierp_op (sexp ctx, sexp self, sexp_sint_t n, sexp x) { return sexp_make_boolean(sexp_idp(x)); } @@ -596,18 +626,8 @@ sexp sexp_strip_synclos (sexp ctx, sexp self, sexp_sint_t n, sexp x) { sexp sexp_identifier_eq_op (sexp ctx, sexp self, sexp_sint_t n, sexp e1, sexp id1, sexp e2, sexp id2) { sexp cell1, cell2; - cell1 = sexp_env_cell(e1, id1, 0); - if (!cell1 && sexp_synclop(id1)) { - e1 = sexp_synclo_env(id1); - id1 = sexp_synclo_expr(id1); - cell1 = sexp_env_cell(e1, id1, 0); - } - cell2 = sexp_env_cell(e2, id2, 0); - if (!cell2 && sexp_synclop(id2)) { - e2 = sexp_synclo_env(id2); - id2 = sexp_synclo_expr(id2); - cell2 = sexp_env_cell(e2, id2, 0); - } + cell1 = sexp_env_cell(ctx, e1, id1, 0); + cell2 = sexp_env_cell(ctx, e2, id2, 0); if (cell1 && (cell1 == cell2)) return SEXP_TRUE; else if (!cell1 && !cell2 && (id1 == id2)) @@ -616,10 +636,16 @@ sexp sexp_identifier_eq_op (sexp ctx, sexp self, sexp_sint_t n, sexp e1, sexp id /* If the identifiers are the same and the cells are either unbound * * or bound to top-level variables, consider them the same. Local * * (non-toplevel) bindings must still match exactly. */ - else if ((id1 == id2) - && (!cell1 || !sexp_lambdap(sexp_cdr(cell1))) - && (!cell2 || !sexp_lambdap(sexp_cdr(cell2)))) - return SEXP_TRUE; + else { + while (sexp_synclop(id1)) + id1 = sexp_synclo_expr(id1); + while (sexp_synclop(id2)) + id2 = sexp_synclo_expr(id2); + if ((id1 == id2) + && (!cell1 || !sexp_lambdap(sexp_cdr(cell1))) + && (!cell2 || !sexp_lambdap(sexp_cdr(cell2)))) + return SEXP_TRUE; + } #endif return SEXP_FALSE; } @@ -681,20 +707,15 @@ static sexp analyze_var_ref (sexp ctx, sexp x, sexp *varenv) { sexp env = sexp_context_env(ctx), res; sexp_gc_var1(cell); sexp_gc_preserve1(ctx, cell); - cell = sexp_env_cell_loc(env, x, 0, varenv); + cell = sexp_env_cell_loc(ctx, env, x, 0, varenv); if (! cell) { - if (sexp_synclop(x)) { - if (sexp_not(sexp_memq(ctx, sexp_synclo_expr(x), sexp_context_fv(ctx))) - && sexp_not(sexp_memq(ctx, sexp_synclo_expr(x), sexp_synclo_free_vars(x)))) - env = sexp_synclo_env(x); - x = sexp_synclo_expr(x); - } + while (sexp_synclop(x)) x = sexp_synclo_expr(x); cell = sexp_env_cell_create(ctx, env, x, SEXP_UNDEF, varenv); } if (sexp_macrop(sexp_cdr(cell)) || sexp_corep(sexp_cdr(cell))) { res = sexp_compile_error(ctx, "invalid use of syntax as value", x); } else { - res = sexp_make_ref(ctx, x, cell); + res = sexp_make_ref(ctx, sexp_car(cell), cell); } sexp_gc_release1(ctx); return res; @@ -853,7 +874,7 @@ static sexp analyze_define (sexp ctx, sexp x, int depth) { value = analyze_lambda(ctx, tmp, depth); } else value = analyze(ctx, sexp_caddr(x), depth); - tmp = sexp_env_cell_loc(env, name, 0, &varenv); + tmp = sexp_env_cell_loc(ctx, env, name, 0, &varenv); ref = sexp_make_ref(ctx, name, tmp); if (sexp_exceptionp(ref)) { res = ref; @@ -883,7 +904,7 @@ static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) { break; } else { if (sexp_idp(sexp_cadar(ls))) - mac = sexp_env_ref(sexp_context_env(eval_ctx), sexp_cadar(ls), SEXP_FALSE); + mac = sexp_env_ref(eval_ctx, sexp_context_env(eval_ctx), sexp_cadar(ls), SEXP_FALSE); else mac = sexp_eval(eval_ctx, sexp_cadar(ls), NULL); if (sexp_procedurep(mac)) @@ -962,11 +983,7 @@ static sexp analyze (sexp ctx, sexp object, int depth) { if (sexp_not(sexp_listp(ctx, x))) { res = sexp_compile_error(ctx, "dotted list in source", x); } else if (sexp_idp(sexp_car(x))) { - cell = sexp_env_cell(sexp_context_env(ctx), sexp_car(x), 0); - if (! cell && sexp_synclop(sexp_car(x))) - cell = sexp_env_cell(sexp_synclo_env(sexp_car(x)), - sexp_synclo_expr(sexp_car(x)), - 0); + cell = sexp_env_cell(ctx, sexp_context_env(ctx), sexp_car(x), 0); if (! cell) { res = analyze_app(ctx, x, depth); if (sexp_exceptionp(res)) @@ -1951,7 +1968,7 @@ sexp sexp_define_foreign_param (sexp ctx, sexp env, const char *name, sexp_gc_var1(tmp); sexp_gc_preserve1(ctx, tmp); tmp = sexp_intern(ctx, param, -1); - tmp = sexp_env_ref(env, tmp, SEXP_FALSE); + tmp = sexp_env_ref(ctx, env, tmp, SEXP_FALSE); if (sexp_opcodep(tmp)) res = sexp_define_foreign_aux(ctx, env, name, num_args, 3, f, tmp); sexp_gc_release1(ctx); @@ -2017,7 +2034,7 @@ sexp sexp_make_primitive_env_op (sexp ctx, sexp self, sexp_sint_t n, sexp versio sexp_opcode_name(op) = sexp_c_string(ctx, (char*)sexp_opcode_name(op), -1); if (sexp_opcode_opt_param_p(op) && sexp_opcode_data(op)) { sym = sexp_intern(ctx, (char*)sexp_opcode_data(op), -1); - sexp_opcode_data(op) = sexp_env_ref(e, sym, SEXP_FALSE); + sexp_opcode_data(op) = sexp_env_ref(ctx, e, sym, SEXP_FALSE); } else if (sexp_opcode_class(op) == SEXP_OPC_PARAMETER) { sexp_opcode_data(op) = sexp_cons(ctx, name, SEXP_FALSE); } @@ -2160,7 +2177,7 @@ sexp sexp_thread_parameters_set (sexp ctx, sexp self, sexp_sint_t n, sexp new) { } void sexp_set_parameter (sexp ctx, sexp env, sexp name, sexp value) { - sexp param = sexp_env_ref(env, name, SEXP_FALSE); + sexp param = sexp_env_ref(ctx, env, name, SEXP_FALSE); if (sexp_opcodep(param)) { if (! sexp_pairp(sexp_opcode_data(param))) sexp_opcode_data(param) = sexp_cons(ctx, name, value); @@ -2264,7 +2281,7 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) { sexp_push(ctx, sexp_global(ctx, SEXP_G_OPTIMIZATIONS), tmp); #endif sexp_global(ctx, SEXP_G_ERR_HANDLER) - = sexp_env_ref(e, sym=sexp_intern(ctx, "current-exception-handler", -1), SEXP_FALSE); + = sexp_env_ref(ctx, e, sym=sexp_intern(ctx, "current-exception-handler", -1), SEXP_FALSE); /* load init.scm */ len = strlen(sexp_init_file); strncpy(init_file, sexp_init_file, len); @@ -2288,7 +2305,7 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) { } if (!sexp_exceptionp(tmp)) { sym = sexp_intern(ctx, "repl-import", -1); - tmp = sexp_env_ref(tmp, sym, SEXP_VOID); + tmp = sexp_env_ref(ctx, tmp, sym, SEXP_VOID); sym = sexp_intern(ctx, "import", -1); sexp_env_define(ctx, e, sym, tmp); } @@ -2335,8 +2352,8 @@ sexp sexp_env_import_op (sexp ctx, sexp self, sexp_sint_t n, sexp to, sexp from, } else { newname = oldname = sexp_car(ls); } - oldcell = sexp_env_cell(to, newname, 0); - value = sexp_env_cell(from, oldname, 0); + oldcell = sexp_env_cell(ctx, to, newname, 0); + value = sexp_env_cell(ctx, from, oldname, 0); if (value) { #if SEXP_USE_RENAME_BINDINGS sexp_env_rename(ctx, to, newname, value); diff --git a/include/chibi/eval.h b/include/chibi/eval.h index beb6d79b..e694ebe2 100644 --- a/include/chibi/eval.h +++ b/include/chibi/eval.h @@ -79,7 +79,7 @@ SEXP_API void sexp_shrink_bcode (sexp ctx, sexp_uint_t i); SEXP_API void sexp_expand_bcode (sexp ctx, sexp_uint_t size); 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 int sexp_param_index (sexp ctx, 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); @@ -118,8 +118,8 @@ SEXP_API sexp sexp_open_binary_output_file(sexp ctx, sexp self, sexp_sint_t n, s SEXP_API sexp sexp_close_port_op(sexp ctx, sexp self, sexp_sint_t n, sexp x); SEXP_API sexp sexp_set_port_line_op (sexp ctx, sexp self, sexp_sint_t n, sexp port, sexp line); SEXP_API sexp sexp_env_define (sexp ctx, sexp env, sexp sym, sexp val); -SEXP_API sexp sexp_env_cell (sexp env, sexp sym, int localp); -SEXP_API sexp sexp_env_ref (sexp env, sexp sym, sexp dflt); +SEXP_API sexp sexp_env_cell (sexp ctx, sexp env, sexp sym, int localp); +SEXP_API sexp sexp_env_ref (sexp ctx, sexp env, sexp sym, sexp dflt); SEXP_API sexp sexp_parameter_ref (sexp ctx, sexp param); SEXP_API sexp sexp_warn_undefs_op (sexp ctx, sexp self, sexp_sint_t n, sexp from, sexp to, sexp res); SEXP_API sexp sexp_make_lit (sexp ctx, sexp value); diff --git a/include/chibi/features.h b/include/chibi/features.h index 48d86042..bfb6933a 100644 --- a/include/chibi/features.h +++ b/include/chibi/features.h @@ -412,6 +412,10 @@ #endif #endif +#ifndef SEXP_USE_FLAT_SYNTACTIC_CLOSURES +#define SEXP_USE_FLAT_SYNTACTIC_CLOSURES 0 +#endif + #if SEXP_USE_UNWRAPPED_TOPLEVEL_BINDINGS #define SEXP_USE_UNWRAPPED_TOPLEVEL_BINDINGS 0 #endif diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 4e629ee9..da554829 100755 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -683,8 +683,7 @@ sexp sexp_make_flonum(sexp ctx, double f); #define sexp_symbolp(x) (sexp_lsymbolp(x)) #endif -#define sexp_idp(x) \ - (sexp_symbolp(x) || (sexp_synclop(x) && sexp_symbolp(sexp_synclo_expr(x)))) +SEXP_API int sexp_idp(sexp x); #define sexp_portp(x) (sexp_check_tag(x, SEXP_IPORT) || sexp_check_tag(x, SEXP_OPORT)) @@ -1494,7 +1493,7 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx, sexp self, sexp_sint_t n, sexp obj (sexp_proc2)finalizer) #endif -#define sexp_current_error_port(ctx) sexp_parameter_ref(ctx, sexp_env_ref(sexp_context_env(ctx), sexp_global(ctx,SEXP_G_CUR_ERR_SYMBOL), SEXP_FALSE)) +#define sexp_current_error_port(ctx) sexp_parameter_ref(ctx, sexp_env_ref(ctx, sexp_context_env(ctx), sexp_global(ctx,SEXP_G_CUR_ERR_SYMBOL), SEXP_FALSE)) #define sexp_debug(ctx, msg, obj) (sexp_write_string(ctx, msg, sexp_current_error_port(ctx)), sexp_write(ctx, obj, sexp_current_error_port(ctx)), sexp_write_char(ctx, '\n', sexp_current_error_port(ctx))) /* simplify primitive API interface */ diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c index 18def0d8..d82c487e 100644 --- a/lib/chibi/ast.c +++ b/lib/chibi/ast.c @@ -42,13 +42,13 @@ static void sexp_define_accessors (sexp ctx, sexp env, sexp_uint_t ctype, static sexp sexp_get_env_cell (sexp ctx, sexp self, sexp_sint_t n, sexp env, sexp id, sexp createp) { sexp cell; sexp_assert_type(ctx, sexp_envp, SEXP_ENV, env); - cell = sexp_env_cell(env, id, 0); + cell = sexp_env_cell(ctx, env, id, 0); if (! cell) { if (sexp_synclop(id)) { env = sexp_synclo_env(id); id = sexp_synclo_expr(id); } - cell = sexp_env_cell(env, id, 0); + cell = sexp_env_cell(ctx, env, id, 0); if (!cell && createp) cell = sexp_env_cell_define(ctx, env, id, SEXP_UNDEF, NULL); } diff --git a/lib/chibi/heap-stats.c b/lib/chibi/heap-stats.c index 0f4438c5..2f61bc6a 100644 --- a/lib/chibi/heap-stats.c +++ b/lib/chibi/heap-stats.c @@ -57,7 +57,8 @@ static sexp sexp_heap_walk (sexp ctx, int depth, int printp) { if (printp) out = sexp_parameter_ref(ctx, - sexp_env_ref(sexp_context_env(ctx), + sexp_env_ref(ctx, + sexp_context_env(ctx), sexp_global(ctx,SEXP_G_CUR_OUT_SYMBOL), SEXP_FALSE)); diff --git a/lib/srfi/18/threads.c b/lib/srfi/18/threads.c index 2403a1ec..76f39e6b 100644 --- a/lib/srfi/18/threads.c +++ b/lib/srfi/18/threads.c @@ -427,7 +427,7 @@ sexp sexp_scheduler (sexp ctx, sexp self, sexp_sint_t n, sexp root_thread) { runner = sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER); if (! sexp_contextp(runner)) { /* ensure the runner exists */ if (sexp_envp(runner)) { - tmp = sexp_env_cell(runner, (tmp=sexp_intern(ctx, "signal-runner", -1)), 0); + tmp = sexp_env_cell(ctx, runner, (tmp=sexp_intern(ctx, "signal-runner", -1)), 0); if (sexp_pairp(tmp) && sexp_procedurep(sexp_cdr(tmp))) { runner = sexp_make_thread(ctx, self, 2, sexp_cdr(tmp), SEXP_FALSE); sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = runner; @@ -623,7 +623,7 @@ sexp sexp_scheduler (sexp ctx, sexp self, sexp_sint_t n, sexp root_thread) { /**************************************************************************/ sexp sexp_lookup_named_type (sexp ctx, sexp env, const char *name) { - sexp t = sexp_env_ref(env, sexp_intern(ctx, name, -1), SEXP_FALSE); + sexp t = sexp_env_ref(ctx, env, sexp_intern(ctx, name, -1), SEXP_FALSE); return sexp_make_fixnum((sexp_typep(t)) ? sexp_type_tag(t) : -1); } diff --git a/main.c b/main.c index e4a46ad0..b297ce2d 100644 --- a/main.c +++ b/main.c @@ -193,7 +193,7 @@ static sexp sexp_meta_env (sexp ctx) { } static sexp sexp_param_ref (sexp ctx, sexp env, sexp name) { - sexp res = sexp_env_ref(env, name, SEXP_FALSE); + sexp res = sexp_env_ref(ctx, env, name, SEXP_FALSE); return sexp_opcodep(res) ? sexp_parameter_ref(ctx, res) : NULL; } @@ -305,7 +305,7 @@ static sexp check_exception (sexp ctx, sexp res) { advise = sexp_vector_ref(advise, SEXP_ONE); if (sexp_envp(advise)) { sym = sexp_intern(ctx, "repl-advise-exception", -1); - advise = sexp_env_ref(advise, sym, SEXP_FALSE); + advise = sexp_env_ref(ctx, advise, sym, SEXP_FALSE); if (sexp_procedurep(advise)) sexp_apply(ctx, advise, tmp=sexp_list2(ctx, res, err)); } @@ -503,7 +503,7 @@ void run_main (int argc, char **argv) { if (! sexp_oportp(out)) out = sexp_eval_string(ctx, "(current-output-port)", -1, env); sexp_write_string(ctx, sexp_version_string, out); - tmp = sexp_env_ref(env, sym=sexp_intern(ctx, "*features*", -1), SEXP_NULL); + tmp = sexp_env_ref(ctx, env, sym=sexp_intern(ctx, "*features*", -1), SEXP_NULL); sexp_write(ctx, tmp, out); sexp_newline(ctx, out); return; @@ -565,11 +565,11 @@ void run_main (int argc, char **argv) { sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL), env); sexp_context_env(ctx) = env; sym = sexp_intern(ctx, "repl-import", -1); - tmp = sexp_env_ref(sexp_meta_env(ctx), sym, SEXP_VOID); + tmp = sexp_env_ref(ctx, sexp_meta_env(ctx), sym, SEXP_VOID); sym = sexp_intern(ctx, "import", -1); sexp_env_define(ctx, env, sym, tmp); sym = sexp_intern(ctx, "cond-expand", -1); - tmp = sexp_env_ref(sexp_meta_env(ctx), sym, SEXP_VOID); + tmp = sexp_env_ref(ctx, sexp_meta_env(ctx), sym, SEXP_VOID); sexp_env_define(ctx, env, sym, tmp); } #endif @@ -578,7 +578,7 @@ void run_main (int argc, char **argv) { #if SEXP_USE_MODULES /* use scheme load if possible for better stack traces */ sym = sexp_intern(ctx, "load", -1); - tmp = sexp_env_ref(sexp_meta_env(ctx), sym, SEXP_FALSE); + tmp = sexp_env_ref(ctx, sexp_meta_env(ctx), sym, SEXP_FALSE); if (sexp_procedurep(tmp)) { sym = sexp_c_string(ctx, argv[i], -1); sym = sexp_list2(ctx, sym, env); @@ -593,7 +593,7 @@ void run_main (int argc, char **argv) { /* SRFI-22: run main if specified */ if (main_symbol) { sym = sexp_intern(ctx, main_symbol, -1); - tmp = sexp_env_ref(env, sym, SEXP_FALSE); + tmp = sexp_env_ref(ctx, env, sym, SEXP_FALSE); if (sexp_procedurep(tmp)) { args = sexp_list1(ctx, args); check_exception(ctx, sexp_apply(ctx, tmp, args)); diff --git a/vm.c b/vm.c index f5925474..ead92f8c 100644 --- a/vm.c +++ b/vm.c @@ -214,7 +214,7 @@ static void generate_non_global_ref (sexp ctx, sexp name, sexp cell, if (loc == lambda && sexp_lambdap(lambda)) { /* local ref */ sexp_emit(ctx, SEXP_OP_LOCAL_REF); - sexp_emit_word(ctx, sexp_param_index(lambda, name)); + sexp_emit_word(ctx, sexp_param_index(ctx, lambda, name)); } else { /* closure ref */ for (i=0; sexp_pairp(fv); fv=sexp_cdr(fv), i++) @@ -277,7 +277,7 @@ static void generate_set (sexp ctx, sexp set) { } else { /* internally defined variable */ sexp_emit(ctx, SEXP_OP_LOCAL_SET); - sexp_emit_word(ctx, sexp_param_index(lambda, sexp_ref_name(ref))); + sexp_emit_word(ctx, sexp_param_index(ctx, lambda, sexp_ref_name(ref))); } } sexp_emit_push(ctx, SEXP_VOID); @@ -476,7 +476,7 @@ static void generate_tail_jump (sexp ctx, sexp name, sexp loc, sexp lam, sexp ap } for (ls1=ls3; sexp_pairp(ls1); ls1=sexp_cdr(ls1)) { sexp_emit(ctx, SEXP_OP_LOCAL_SET); - sexp_emit_word(ctx, sexp_param_index(lam, sexp_car(ls1))); + sexp_emit_word(ctx, sexp_param_index(ctx, lam, sexp_car(ls1))); } /* drop the current result and jump */ @@ -623,7 +623,7 @@ static void generate_lambda (sexp ctx, sexp name, sexp loc, sexp lam, sexp lambd } /* box mutable vars */ for (ls=sexp_lambda_sv(lambda); sexp_pairp(ls); ls=sexp_cdr(ls)) { - k = sexp_param_index(lambda, sexp_car(ls)); + k = sexp_param_index(ctx, lambda, sexp_car(ls)); sexp_emit(ctx2, SEXP_OP_LOCAL_REF); sexp_emit_word(ctx2, k); sexp_emit_push(ctx2, sexp_car(ls)); @@ -736,7 +736,7 @@ static sexp make_opcode_procedure (sexp ctx, sexp op, sexp_uint_t i) { } else { sexp_context_env(ctx2) = env; for (ls=params, refs=SEXP_NULL; sexp_pairp(ls); ls=sexp_cdr(ls)) { - ref = sexp_make_ref(ctx2, sexp_car(ls), sexp_env_cell(env, sexp_car(ls), 0)); + ref = sexp_make_ref(ctx2, sexp_car(ls), sexp_env_cell(ctx, env, sexp_car(ls), 0)); if (!sexp_exceptionp(ref)) sexp_push(ctx2, refs, ref); } if (!sexp_exceptionp(refs))