fixing syntactic-closure free-variable references for wrapped expressions

(also renaming %env-copy! to %import)

eval.c

@@ -178,6 +178,27 @@ sexp sexp_extend_env (sexp ctx, sexp env, sexp vars, sexp value) {
   return e;
 }
 
+sexp sexp_extend_synclo_env (sexp ctx, sexp env) {
+  sexp e1, e2;
+  sexp_gc_var1(e);
+  sexp_gc_preserve1(ctx, e);
+  e = env;
+  if (sexp_pairp(sexp_context_fv(ctx))) {
+    e = sexp_alloc_type(ctx, env, SEXP_ENV);
+    for (e1=env, e2=NULL; e1; e1=sexp_env_parent(e1)) {
+      e2 = e2 ? (sexp_env_parent(e2) = sexp_alloc_type(ctx, env, SEXP_ENV)) : e;
+      sexp_env_bindings(e2) = sexp_env_bindings(e1);
+      sexp_env_syntactic_p(e2) = 1;
+#if SEXP_USE_RENAME_BINDINGS
+      sexp_env_renames(e2) = sexp_env_renames(e1);
+#endif
+    }
+    sexp_env_parent(e2) = sexp_context_env(ctx);
+  }
+  sexp_gc_release1(ctx);
+  return e;
+}
+
 static sexp sexp_reverse_flatten_dot (sexp ctx, sexp ls) {
   sexp_gc_var1(res);
   sexp_gc_preserve1(ctx, res);
@@ -871,10 +892,10 @@ static sexp analyze (sexp ctx, sexp object) {
     res = analyze_var_ref(ctx, x, NULL);
   } else if (sexp_synclop(x)) {
     tmp = sexp_make_child_context(ctx, sexp_context_lambda(ctx));
-    sexp_context_env(tmp) = sexp_synclo_env(x);
     sexp_context_fv(tmp) = sexp_append2(tmp,
                                         sexp_synclo_free_vars(x),
                                         sexp_context_fv(tmp));
+    sexp_context_env(tmp) = sexp_extend_synclo_env(tmp, sexp_synclo_env(x));
     x = sexp_synclo_expr(x);
     res = analyze(tmp, x);
   } else if (sexp_nullp(x)) {
@@ -1778,7 +1799,7 @@ sexp sexp_make_standard_env_op (sexp ctx sexp_api_params(self, n), sexp version)
 #define sexp_same_bindingp(x, y) (sexp_env_value(x) == sexp_env_value(y))
 #endif
 
-sexp sexp_env_copy_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, sexp ls, sexp immutp) {
+sexp sexp_env_import_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, sexp ls, sexp immutp) {
   sexp oldname, newname;
   sexp_gc_var2(value, oldcell);
   sexp_gc_preserve2(ctx, value, oldcell);

include/chibi/eval.h

@@ -156,7 +156,7 @@ SEXP_API sexp sexp_find_module_file (sexp ctx, const char *file);
 SEXP_API sexp sexp_load_module_file (sexp ctx, const char *file, sexp env);
 SEXP_API sexp sexp_add_module_directory_op (sexp ctx sexp_api_params(self, n), sexp dir, sexp appendp);
 SEXP_API sexp sexp_extend_env (sexp ctx, sexp env, sexp vars, sexp value);
-SEXP_API sexp sexp_env_copy_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, sexp ls, sexp immutp);
+SEXP_API sexp sexp_env_import_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, sexp ls, sexp immutp);
 SEXP_API sexp sexp_identifier_op(sexp ctx sexp_api_params(self, n), sexp x);
 SEXP_API sexp sexp_syntactic_closure_expr(sexp ctx sexp_api_params(self, n), sexp x);
 SEXP_API sexp sexp_identifier_eq_op(sexp ctx sexp_api_params(self, n), sexp a, sexp b, sexp c, sexp d);
@@ -200,7 +200,7 @@ SEXP_API sexp sexp_make_setter_op (sexp ctx sexp_api_params(self, n), sexp name,
 #define sexp_add_module_directory(ctx, d, a) sexp_add_module_directory_op(ctx sexp_api_pass(NULL, 1), d, a)
 #define sexp_eval(ctx, x, e) sexp_eval_op(ctx sexp_api_pass(NULL, 2), x, e)
 #define sexp_load(ctx, f, e) sexp_load_op(ctx sexp_api_pass(NULL, 2), f, e)
-#define sexp_env_copy(ctx, a, b, c, d) sexp_env_copy_op(ctx sexp_api_pass(NULL, 4), a, b, c, d)
+#define sexp_env_import(ctx, a, b, c, d) sexp_env_import_op(ctx sexp_api_pass(NULL, 4), a, b, c, d)
 #define sexp_identifierp(ctx, x) sexp_identifierp_op(ctx sexp_api_pass(NULL, 1), x)
 #define sexp_identifier_to_symbol(ctx, x) sexp_syntactic_closure_expr(ctx sexp_api_pass(NULL, 1), x)
 #define sexp_identifier_eq(ctx, a, b, c, d) sexp_identifier_eq_op(ctx sexp_api_pass(NULL, 4), a, b, c, d)

lib/config.scm

@@ -110,7 +110,7 @@
            (lambda (m)
              (let* ((mod2-name+imports (resolve-import m))
                     (mod2 (load-module (car mod2-name+imports))))
-               (%env-copy! env (module-env mod2) (cdr mod2-name+imports) #t)))
+               (%import env (module-env mod2) (cdr mod2-name+imports) #t)))
            (cdr x)))))
      (module-meta-data mod))
     (for-each

lib/init.scm

@@ -897,7 +897,7 @@
          (let ((mod+imps (eval `(resolve-import ',(car ls)) *config-env*)))
            (if (pair? mod+imps)
                (lp (cdr ls)
-                   (cons `(%env-copy!
+                   (cons `(%import
                            #f
                            (vector-ref
                             (eval '(load-module ',(car mod+imps)) *config-env*)

opcodes.c

@@ -118,7 +118,7 @@ _FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "null-environment", 0, sexp_make_null_env_op
 _FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "scheme-report-environment", 0, sexp_make_standard_env_op),
 _FN2OPTP(_I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_ENV), "compile", (sexp)"interaction-environment", sexp_compile_op),
 _FN2OPTP(SEXP_VOID, _I(SEXP_STRING), _I(SEXP_ENV), "load", (sexp)"interaction-environment", sexp_load_op),
-_FN4(SEXP_VOID, _I(SEXP_ENV), _I(SEXP_ENV), _I(SEXP_OBJECT), "%env-copy!", 0, sexp_env_copy_op),
+_FN4(SEXP_VOID, _I(SEXP_ENV), _I(SEXP_ENV), _I(SEXP_OBJECT), "%import", 0, sexp_env_import_op),
 _FN2(SEXP_VOID, _I(SEXP_EXCEPTION), _I(SEXP_OPORT), "print-exception", 0, sexp_print_exception_op),
 _FN1(_I(SEXP_OBJECT), _I(SEXP_EXCEPTION), "exception-type", 0, sexp_exception_type_op),
 _FN2OPT(_I(SEXP_STRING), _I(SEXP_FIXNUM), _I(SEXP_CHAR), "make-string", sexp_make_character(' '), sexp_make_string_op),