diff --git a/eval.c b/eval.c
index 1414340a..cf5e1419 100644
--- a/eval.c
+++ b/eval.c
@@ -50,23 +50,42 @@ void sexp_warn_undefs (sexp ctx, sexp from, sexp to) {
/********************** environment utilities ***************************/
-static sexp sexp_env_cell_loc (sexp env, sexp key, sexp *varenv) {
+static sexp sexp_env_cell_loc (sexp env, sexp key, int localp, sexp *varenv) {
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) {
+ if (varenv) *varenv = env;
+ return sexp_cdr(ls);
+ }
+#endif
for (ls=sexp_env_bindings(env); sexp_pairp(ls); ls=sexp_env_next_cell(ls))
if (sexp_car(ls) == key) {
if (varenv) *varenv = env;
return ls;
}
- env = sexp_env_parent(env);
+ env = (localp ? NULL : sexp_env_parent(env));
} while (env);
return NULL;
}
-sexp sexp_env_cell (sexp env, sexp key) {
- return sexp_env_cell_loc(env, key, NULL);
+sexp sexp_env_cell (sexp env, sexp key, int localp) {
+ return sexp_env_cell_loc(env, key, localp, NULL);
+}
+
+static sexp sexp_env_undefine (sexp ctx, sexp env, sexp key) {
+ sexp ls1=NULL, ls2;
+ for (ls2=sexp_env_bindings(env); sexp_pairp(ls2);
+ ls1=ls2, ls2=sexp_env_next_cell(ls2))
+ if (sexp_car(ls2) == key) {
+ if (ls1) sexp_env_next_cell(ls1) = sexp_env_next_cell(ls2);
+ else sexp_env_bindings(env) = sexp_env_next_cell(ls2);
+ return SEXP_TRUE;
+ }
+ return SEXP_FALSE;
}
static sexp sexp_env_cell_define (sexp ctx, sexp env, sexp key,
@@ -75,6 +94,13 @@ static sexp sexp_env_cell_define (sexp ctx, sexp env, sexp key,
while (sexp_env_lambda(env) || sexp_env_syntactic_p(env))
env = sexp_env_parent(env);
if (varenv) *varenv = env;
+#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) {
+ sexp_car(ls) = SEXP_FALSE;
+ break;
+ }
+#endif
for (ls=sexp_env_bindings(env); sexp_pairp(ls); ls=sexp_env_next_cell(ls))
if (sexp_car(ls) == key)
return ls;
@@ -86,60 +112,51 @@ static 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, varenv);
+ sexp cell = sexp_env_cell_loc(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);
+ sexp cell = sexp_env_cell(env, key, 0);
return (cell ? sexp_cdr(cell) : dflt);
}
-sexp sexp_env_global_ref (sexp env, sexp key, sexp dflt) {
- while (sexp_env_lambda(env) && sexp_env_parent(env))
- env = sexp_env_parent(env);
- return sexp_env_ref(env, key, dflt);
-}
-
sexp sexp_env_define (sexp ctx, sexp env, sexp key, sexp value) {
- sexp cell=SEXP_FALSE, res=SEXP_VOID;
- sexp_gc_var2(ls1, ls2);
- if (sexp_immutablep(env)) {
+ 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);
+ if (!cell) {
+ sexp_env_push(ctx, env, tmp, key, value);
+ } else if (sexp_immutablep(cell)) {
res = sexp_user_exception(ctx, NULL, "immutable binding", key);
+ } else if (sexp_syntacticp(value) && !sexp_syntacticp(sexp_cdr(cell))) {
+ sexp_env_undefine(ctx, env, key);
+ sexp_env_push(ctx, env, tmp, key, value);
} else {
- sexp_gc_preserve2(ctx, ls1, ls2);
- for (ls1=NULL, ls2=sexp_env_bindings(env); sexp_pairp(ls2);
- ls1=ls2, ls2=sexp_env_next_cell(ls2))
- if (sexp_car(ls2) == key) {
- cell = ls2;
- break;
- }
- if (sexp_truep(cell)) {
- if (sexp_immutablep(cell)) {
- res = sexp_user_exception(ctx, NULL, "immutable binding", key);
- } else if ((sexp_corep(value) || sexp_macrop(value))
- && !(sexp_corep(sexp_cdr(cell))
- || sexp_macrop(sexp_cdr(cell)))) {
- if (ls1) sexp_env_next_cell(ls1) = sexp_env_next_cell(ls2);
- else sexp_env_bindings(env) = sexp_env_next_cell(ls2);
- sexp_env_push(ctx, env, ls2, key, value);
- } else {
- sexp_cdr(cell) = value;
- }
- } else {
- sexp_env_push(ctx, env, ls2, key, value);
- }
- sexp_gc_release2(ctx);
+ sexp_cdr(cell) = value;
}
return res;
}
+#if SEXP_USE_RENAME_BINDINGS
+sexp sexp_env_rename (sexp ctx, sexp env, sexp key, sexp value) {
+ sexp tmp;
+ sexp_env_push_rename(ctx, env, tmp, key, value);
+ return SEXP_VOID;
+}
+#endif
+
sexp sexp_env_exports_op (sexp ctx sexp_api_params(self, n), sexp env) {
sexp ls;
sexp_gc_var1(res);
sexp_gc_preserve1(ctx, res);
res = SEXP_NULL;
+#if SEXP_USE_RENAME_BINDINGS
+ for (ls=sexp_env_renames(env); sexp_pairp(ls); ls=sexp_env_next_cell(ls))
+ sexp_push(ctx, res, sexp_cadr(ls));
+#endif
for (ls=sexp_env_bindings(env); sexp_pairp(ls); ls=sexp_env_next_cell(ls))
sexp_push(ctx, res, sexp_car(ls));
sexp_gc_release1(ctx);
@@ -152,6 +169,9 @@ sexp sexp_extend_env (sexp ctx, sexp env, sexp vars, sexp value) {
e = sexp_alloc_type(ctx, env, SEXP_ENV);
sexp_env_parent(e) = env;
sexp_env_bindings(e) = SEXP_NULL;
+#if SEXP_USE_RENAME_BINDINGS
+ sexp_env_renames(e) = SEXP_NULL;
+#endif
for ( ; sexp_pairp(vars); vars = sexp_cdr(vars))
sexp_env_push(ctx, e, tmp, sexp_car(vars), value);
sexp_gc_release2(ctx);
@@ -443,22 +463,30 @@ sexp sexp_strip_synclos (sexp ctx sexp_api_params(self, n), sexp x) {
}
sexp sexp_identifier_eq_op (sexp ctx sexp_api_params(self, n), sexp e1, sexp id1, sexp e2, sexp id2) {
- sexp cell, lam1=SEXP_FALSE, lam2=SEXP_FALSE;
- if (sexp_synclop(id1)) {
+ 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);
}
- if (sexp_synclop(id2)) {
+ 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);
}
- cell = sexp_env_cell(e1, id1);
- if (cell && sexp_lambdap(sexp_cdr(cell)))
- lam1 = sexp_cdr(cell);
- cell = sexp_env_cell(e2, id2);
- if (cell && sexp_lambdap(sexp_cdr(cell)))
- lam2 = sexp_cdr(cell);
- return sexp_make_boolean((id1 == id2) && (lam1 == lam2));
+ if (cell1 && (cell1 == cell2))
+ return SEXP_TRUE;
+ else if (!cell1 && !cell2 && (id1 == id2))
+ return SEXP_TRUE;
+#if ! SEXP_USE_STRICT_TOPLEVEL_BINDINGS
+ else if (cell1 && !sexp_lambdap(sexp_cdr(cell1))
+ && cell2 && !sexp_lambdap(sexp_cdr(cell2))
+ && (id1 == id2))
+ return SEXP_TRUE;
+#endif
+ return SEXP_FALSE;
}
/************************* the compiler ***************************/
@@ -513,7 +541,7 @@ 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, varenv);
+ cell = sexp_env_cell_loc(env, x, 0, varenv);
if (! cell) {
if (sexp_synclop(x)) {
if (sexp_not(sexp_memq(ctx, sexp_synclo_expr(x), sexp_context_fv(ctx)))
@@ -659,7 +687,7 @@ static sexp analyze_define (sexp ctx, sexp x) {
res = SEXP_VOID;
} else {
if (sexp_synclop(name)) name = sexp_synclo_expr(name);
- sexp_env_cell_define(ctx, env, name, SEXP_VOID, NULL);
+ sexp_env_cell_define(ctx, env, name, SEXP_VOID, &varenv);
if (sexp_pairp(sexp_cadr(x))) {
tmp = sexp_cons(ctx, sexp_cdadr(x), sexp_cddr(x));
tmp = sexp_cons(ctx, SEXP_VOID, tmp);
@@ -667,8 +695,7 @@ static sexp analyze_define (sexp ctx, sexp x) {
value = analyze_lambda(ctx, tmp);
} else
value = analyze(ctx, sexp_caddr(x));
- tmp = sexp_env_cell_loc(env, name, &varenv);
- if (!tmp) tmp = sexp_env_cell_create(ctx, env, name, SEXP_UNDEF, &varenv);
+ tmp = sexp_env_cell_loc(env, name, 0, &varenv);
ref = sexp_make_ref(ctx, name, tmp);
if (sexp_exceptionp(ref)) {
res = ref;
@@ -734,6 +761,9 @@ static sexp analyze_let_syntax_aux (sexp ctx, sexp x, int recp) {
sexp_env_syntactic_p(env) = 1;
sexp_env_parent(env) = sexp_context_env(ctx);
sexp_env_bindings(env) = SEXP_NULL;
+#if SEXP_USE_RENAME_BINDINGS
+ sexp_env_renames(env) = SEXP_NULL;
+#endif
ctx2 = sexp_make_child_context(ctx, sexp_context_lambda(ctx));
sexp_context_env(ctx2) = env;
tmp = analyze_bind_syntax(sexp_cadr(x), (recp ? ctx2 : ctx), ctx2);
@@ -761,10 +791,11 @@ static sexp analyze (sexp ctx, sexp object) {
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));
+ 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)));
+ sexp_synclo_expr(sexp_car(x)),
+ 0);
if (! cell) {
res = analyze_app(ctx, x);
if (sexp_exceptionp(res))
@@ -1494,6 +1525,9 @@ sexp sexp_make_env_op (sexp ctx sexp_api_params(self, n)) {
sexp_env_lambda(e) = NULL;
sexp_env_parent(e) = NULL;
sexp_env_bindings(e) = SEXP_NULL;
+#if SEXP_USE_RENAME_BINDINGS
+ sexp_env_renames(e) = SEXP_NULL;
+#endif
return e;
}
@@ -1750,9 +1784,15 @@ sexp sexp_env_copy_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, se
sexp_env_parent(to) = value;
sexp_immutablep(value) = 1;
sexp_env_bindings(value) = sexp_env_bindings(from);
+ sexp_env_renames(value) = sexp_env_renames(from);
} else {
- for (ls=sexp_env_bindings(from); sexp_pairp(ls); ls=sexp_env_next_cell(ls))
+ for (ls=sexp_env_bindings(from); sexp_pairp(ls); ls=sexp_env_next_cell(ls)) {
+#if SEXP_USE_RENAME_BINDINGS
+ sexp_env_rename(ctx, to, sexp_car(ls), ls);
+#else
sexp_env_define(ctx, to, sexp_car(ls), sexp_cdr(ls));
+#endif
+ }
}
} else {
for ( ; sexp_pairp(ls); ls=sexp_cdr(ls)) {
@@ -1761,9 +1801,13 @@ sexp sexp_env_copy_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, se
} else {
newname = oldname = sexp_car(ls);
}
- value = sexp_env_ref(from, oldname, SEXP_UNDEF);
- if (value != SEXP_UNDEF) {
- sexp_env_define(ctx, to, newname, value);
+ value = sexp_env_cell(from, oldname, 0);
+ if (value) {
+#if SEXP_USE_RENAME_BINDINGS
+ sexp_env_rename(ctx, to, newname, value);
+#else
+ sexp_env_define(ctx, to, newname, sexp_cdr(value));
+#endif
#if SEXP_USE_WARN_UNDEFS
} else {
sexp_warn(ctx, "importing undefined variable: ", oldname);
diff --git a/include/chibi/eval.h b/include/chibi/eval.h
index f8737345..a716eaa0 100644
--- a/include/chibi/eval.h
+++ b/include/chibi/eval.h
@@ -164,9 +164,8 @@ SEXP_API sexp sexp_open_input_file_op(sexp ctx sexp_api_params(self, n), sexp x)
SEXP_API sexp sexp_open_output_file_op(sexp ctx sexp_api_params(self, n), sexp x);
SEXP_API sexp sexp_close_port_op(sexp ctx sexp_api_params(self, n), sexp x);
SEXP_API sexp sexp_env_define (sexp ctx, sexp env, sexp sym, sexp val);
-SEXP_API sexp sexp_env_cell (sexp env, sexp sym);
+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_global_ref (sexp env, sexp sym, sexp dflt);
SEXP_API sexp sexp_parameter_ref (sexp ctx, sexp param);
SEXP_API void sexp_warn_undefs (sexp ctx, sexp from, sexp to);
SEXP_API sexp sexp_make_opcode (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc1);
@@ -179,8 +178,11 @@ SEXP_API sexp sexp_define_foreign_aux (sexp ctx, sexp env, const char *name, int
SEXP_API sexp sexp_define_foreign_param (sexp ctx, sexp env, const char *name, int num_args, sexp_proc1 f, const char *param);
+#define sexp_env_key(x) sexp_car(x)
+#define sexp_env_value(x) sexp_cdr(x)
#define sexp_env_next_cell(x) sexp_pair_source(x)
#define sexp_env_push(ctx, env, tmp, name, value) (tmp=sexp_cons(ctx,name,value), sexp_env_next_cell(tmp)=sexp_env_bindings(env), sexp_env_bindings(env)=tmp)
+#define sexp_env_push_rename(ctx, env, tmp, name, value) (tmp=sexp_cons(ctx,name,value), sexp_env_next_cell(tmp)=sexp_env_renames(env), sexp_env_renames(env)=tmp)
#if SEXP_USE_TYPE_DEFS
SEXP_API sexp sexp_make_type_predicate_op (sexp ctx sexp_api_params(self, n), sexp name, sexp type);
diff --git a/include/chibi/features.h b/include/chibi/features.h
index 41e7c896..2a0f52f7 100644
--- a/include/chibi/features.h
+++ b/include/chibi/features.h
@@ -348,6 +348,18 @@
#endif
#endif
+#ifndef SEXP_USE_STRICT_TOPLEVEL_BINDINGS
+#define SEXP_USE_STRICT_TOPLEVEL_BINDINGS 0
+#endif
+
+#if SEXP_USE_STRICT_TOPLEVEL_BINDINGS
+#define SEXP_USE_RENAME_BINDINGS 1
+#else
+#ifndef SEXP_USE_RENAME_BINDINGS
+#define SEXP_USE_RENAME_BINDINGS 0
+#endif
+#endif
+
#ifndef SEXP_USE_EXTENDED_FCALL
#define SEXP_USE_EXTENDED_FCALL ! SEXP_USE_NO_FEATURES
#endif
diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h
index bb7dcf83..f789b1f9 100644
--- a/include/chibi/sexp.h
+++ b/include/chibi/sexp.h
@@ -300,6 +300,9 @@ struct sexp_struct {
/* runtime types */
struct {
sexp parent, lambda, bindings;
+#if SEXP_USE_RENAME_BINDINGS
+ sexp renames;
+#endif
} env;
struct {
sexp_uint_t length;
@@ -549,6 +552,7 @@ sexp sexp_make_flonum(sexp ctx, double f);
#define sexp_corep(x) (sexp_check_tag(x, SEXP_CORE))
#define sexp_opcodep(x) (sexp_check_tag(x, SEXP_OPCODE))
#define sexp_macrop(x) (sexp_check_tag(x, SEXP_MACRO))
+#define sexp_syntacticp(x) (sexp_corep(x) || sexp_macrop(x))
#define sexp_synclop(x) (sexp_check_tag(x, SEXP_SYNCLO))
#define sexp_lambdap(x) (sexp_check_tag(x, SEXP_LAMBDA))
#define sexp_cndp(x) (sexp_check_tag(x, SEXP_CND))
@@ -730,6 +734,7 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
#define sexp_env_syntactic_p(x) ((x)->syntacticp)
#define sexp_env_parent(x) (sexp_field(x, env, SEXP_ENV, parent))
#define sexp_env_bindings(x) (sexp_field(x, env, SEXP_ENV, bindings))
+#define sexp_env_renames(x) (sexp_field(x, env, SEXP_ENV, renames))
#define sexp_env_local_p(x) (sexp_env_parent(x))
#define sexp_env_global_p(x) (! sexp_env_local_p(x))
#define sexp_env_lambda(x) (sexp_field(x, env, SEXP_ENV, lambda))
diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c
index efee4ae7..1c393087 100644
--- a/lib/chibi/ast.c
+++ b/lib/chibi/ast.c
@@ -32,7 +32,7 @@ static void sexp_define_accessors (sexp ctx, sexp env, sexp_uint_t ctype,
}
static sexp sexp_get_env_cell (sexp ctx sexp_api_params(self, n), sexp env, sexp id) {
- sexp cell = sexp_env_cell(env, id);
+ sexp cell = sexp_env_cell(env, id, 0);
while ((! cell) && sexp_synclop(id)) {
env = sexp_synclo_env(id);
id = sexp_synclo_expr(id);
diff --git a/lib/chibi/heap-stats.c b/lib/chibi/heap-stats.c
index d0859d0e..9d02eb69 100644
--- a/lib/chibi/heap-stats.c
+++ b/lib/chibi/heap-stats.c
@@ -56,9 +56,10 @@ static sexp sexp_heap_walk (sexp ctx, int depth, int printp) {
sexp_gc_var3(res, tmp, name);
if (printp)
- out = sexp_env_global_ref(sexp_context_env(ctx),
- sexp_global(ctx, SEXP_G_CUR_OUT_SYMBOL),
- SEXP_FALSE);
+ out = sexp_parameter_ref(ctx,
+ sexp_env_ref(sexp_context_env(ctx),
+ sexp_global(ctx,SEXP_G_CUR_OUT_SYMBOL),
+ SEXP_FALSE));
/* run gc once to remove unused variables */
sexp_gc(ctx, &freed);
diff --git a/lib/chibi/test.module b/lib/chibi/test.module
index 8babebfa..8c084653 100644
--- a/lib/chibi/test.module
+++ b/lib/chibi/test.module
@@ -11,4 +11,3 @@
(import-immutable (scheme))
(import (srfi 39) (srfi 98) (chibi time) (chibi ast))
(include "test.scm"))
-
diff --git a/lib/config.scm b/lib/config.scm
index ded98207..5b71ea4f 100644
--- a/lib/config.scm
+++ b/lib/config.scm
@@ -62,14 +62,10 @@
((and (pair? (cdr x)) (pair? (cadr x)))
(if (memq (car x) '(only except rename))
(let* ((mod-name+imports (resolve-import (cadr x)))
- (imp-ids (cdr mod-name+imports))
- (imp-ids (if (and (not imp-ids) (not (eq? 'only (car x))))
- (begin
- (set-cdr! mod-name+imports
- (module-exports
- (find-module (car mod-name+imports))))
- (cdr mod-name+imports))
- imp-ids)))
+ (imp-ids (or (cdr mod-name+imports)
+ (and (not (eq? 'only (car x)))
+ (module-exports
+ (find-module (car mod-name+imports)))))))
(cons (car mod-name+imports)
(case (car x)
((only)
@@ -81,7 +77,7 @@
((rename)
(map (lambda (i)
(let ((rename (assq (to-id i) (cddr x))))
- (if rename (cons (cdr rename) (from-id i)) i)))
+ (if rename (cons (cadr rename) (from-id i)) i)))
imp-ids)))))
(error "invalid import modifier" x)))
((and (eq? 'prefix (car x)) (symbol? (cadr x)) (list? (caddr x)))
@@ -116,7 +112,11 @@
(mod2 (load-module (car mod2-name+imports))))
(%env-copy! env (module-env mod2) (cdr mod2-name+imports)
(eq? (car x) 'import-immutable))))
- (cdr x)))
+ (cdr x)))))
+ (module-meta-data mod))
+ (for-each
+ (lambda (x)
+ (case (and (pair? x) (car x))
((include)
(load-modules (cdr x) ""))
((include-shared)
diff --git a/lib/init.scm b/lib/init.scm
index ad6b639a..728e51da 100644
--- a/lib/init.scm
+++ b/lib/init.scm
@@ -640,7 +640,9 @@
(cond
((identifier? p)
(if (any (lambda (l) (compare p l)) lits)
- (list _and (list _compare v (list _quote p)) (k vars))
+ (list _and
+ (list _compare v (list _rename (list _quote p)))
+ (k vars))
(list _let (list (list p v)) (k (cons (cons p dim) vars)))))
((ellipsis? p)
(cond
diff --git a/lib/srfi/18/threads.c b/lib/srfi/18/threads.c
index 596869e7..cd682311 100644
--- a/lib/srfi/18/threads.c
+++ b/lib/srfi/18/threads.c
@@ -377,7 +377,7 @@ sexp sexp_scheduler (sexp ctx sexp_api_params(self, 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)));
+ tmp = sexp_env_cell(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;
diff --git a/sexp.c b/sexp.c
index 37829ba8..e2b6851b 100644
--- a/sexp.c
+++ b/sexp.c
@@ -103,7 +103,11 @@ static struct sexp_type_struct _sexp_type_specs[] = {
{SEXP_PROCEDURE, sexp_offsetof(procedure, bc), 2, 2, 0, 0, sexp_sizeof(procedure), 0, 0, 0, 0, 0, 0, 0, 0, "procedure", SEXP_FALSE, SEXP_FALSE, NULL},
{SEXP_MACRO, sexp_offsetof(macro, proc), 2, 2, 0, 0, sexp_sizeof(macro), 0, 0, 0, 0, 0, 0, 0, 0, "macro", SEXP_FALSE, SEXP_FALSE, NULL},
{SEXP_SYNCLO, sexp_offsetof(synclo, env), 3, 3, 0, 0, sexp_sizeof(synclo), 0, 0, 0, 0, 0, 0, 0, 0, "syntactic-closure", SEXP_FALSE, SEXP_FALSE, NULL},
+#if SEXP_USE_RENAME_BINDINGS
+ {SEXP_ENV, sexp_offsetof(env, parent), 4, 4, 0, 0, sexp_sizeof(env), 0, 0, 0, 0, 0, 0, 0, 0, "environment", SEXP_FALSE, SEXP_FALSE, NULL},
+#else
{SEXP_ENV, sexp_offsetof(env, parent), 3, 3, 0, 0, sexp_sizeof(env), 0, 0, 0, 0, 0, 0, 0, 0, "environment", SEXP_FALSE, SEXP_FALSE, NULL},
+#endif
{SEXP_BYTECODE, sexp_offsetof(bytecode, name), 3, 3, 0, 0, sexp_sizeof(bytecode), offsetof(struct sexp_struct, value.bytecode.length), 1, 0, 0, 0, 0, 0, 0, "bytecode", SEXP_FALSE, SEXP_FALSE, NULL},
{SEXP_CORE, 0, 0, 0, 0, 0, sexp_sizeof(core), 0, 0, 0, 0, 0, 0, 0, 0, "core-form", SEXP_FALSE, SEXP_FALSE, NULL},
{SEXP_OPCODE, sexp_offsetof(opcode, data), 7, 7, 0, 0, sexp_sizeof(opcode), 0, 0, 0, 0, 0, 0, 0, 0, "opcode", SEXP_FALSE, SEXP_FALSE, NULL},
diff --git a/vm.c b/vm.c
index 0c130e35..4a1ac499 100644
--- a/vm.c
+++ b/vm.c
@@ -466,7 +466,7 @@ static sexp make_opcode_procedure (sexp ctx, sexp op, sexp_uint_t i) {
env = sexp_extend_env(ctx2, sexp_context_env(ctx), params, lambda);
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)));
+ ref = sexp_make_ref(ctx2, sexp_car(ls), sexp_env_cell(env, sexp_car(ls), 0));
sexp_push(ctx2, refs, ref);
}
refs = sexp_reverse(ctx2, refs);