adding optional strict top-level matching for syntax-rules literals

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) {
+sexp sexp_env_cell (sexp env, sexp key, int localp) {
-  return sexp_env_cell_loc(env, key, NULL);
+  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 cell, tmp, res = SEXP_VOID;
-  sexp_gc_var2(ls1, ls2);
+  if (sexp_immutablep(env))
-  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);
+    sexp_cdr(cell) = value;
-    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);
   }
   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;
+  sexp cell1, cell2;
-  if (sexp_synclop(id1)) {
+  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 (cell1 && (cell1 == cell2))
-  if (cell && sexp_lambdap(sexp_cdr(cell)))
+    return SEXP_TRUE;
-    lam1 = sexp_cdr(cell);
+  else if (!cell1 && !cell2 && (id1 == id2))
-  cell = sexp_env_cell(e2, id2);
+    return SEXP_TRUE;
-  if (cell && sexp_lambdap(sexp_cdr(cell)))
+#if ! SEXP_USE_STRICT_TOPLEVEL_BINDINGS
-    lam2 = sexp_cdr(cell);
+  else if (cell1 && !sexp_lambdap(sexp_cdr(cell1))
-  return sexp_make_boolean((id1 == id2) && (lam1 == lam2));
+           && 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);
+      tmp = sexp_env_cell_loc(env, name, 0, &varenv);
-      if (!tmp) tmp = sexp_env_cell_create(ctx, env, name, SEXP_UNDEF, &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);
+      value = sexp_env_cell(from, oldname, 0);
-      if (value != SEXP_UNDEF) {
+      if (value) {
-        sexp_env_define(ctx, to, newname, 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);

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

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

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

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

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),
+    out = sexp_parameter_ref(ctx,
-                              sexp_global(ctx, SEXP_G_CUR_OUT_SYMBOL),
+                             sexp_env_ref(sexp_context_env(ctx),
-                              SEXP_FALSE);
+                                          sexp_global(ctx,SEXP_G_CUR_OUT_SYMBOL),
+                                          SEXP_FALSE));
 
   /* run gc once to remove unused variables */
   sexp_gc(ctx, &freed);

lib/chibi/test.module

@@ -11,4 +11,3 @@
   (import-immutable (scheme))
   (import (srfi 39) (srfi 98) (chibi time) (chibi ast))
   (include "test.scm"))
-

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 (or (cdr mod-name+imports)
-               (imp-ids (if (and (not imp-ids) (not (eq? 'only (car x))))
+                            (and (not (eq? 'only (car x)))
-                            (begin
+                                 (module-exports
-                              (set-cdr! mod-name+imports
+                                  (find-module (car mod-name+imports)))))))
-                                        (module-exports
-                                         (find-module (car mod-name+imports))))
-                              (cdr mod-name+imports))
-                            imp-ids)))
           (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)

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

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;

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},

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