From c5126fb2b09325878838e9211d151a40fa4d27d0 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 25 Apr 2011 23:29:30 +0900 Subject: [PATCH] adding optional strict top-level matching for syntax-rules literals --- eval.c | 160 +++++++++++++++++++++++++-------------- include/chibi/eval.h | 6 +- include/chibi/features.h | 12 +++ include/chibi/sexp.h | 5 ++ lib/chibi/ast.c | 2 +- lib/chibi/heap-stats.c | 7 +- lib/chibi/test.module | 1 - lib/config.scm | 20 ++--- lib/init.scm | 4 +- lib/srfi/18/threads.c | 2 +- sexp.c | 4 + vm.c | 2 +- 12 files changed, 147 insertions(+), 78 deletions(-) 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);