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