Taking a frozen copy of the initial env when we setup the meta env.

This is so that you can import into the interaction env without affecting
the (chibi) module.

eval.c

@@ -2294,7 +2294,7 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
 #endif
   sexp_global(ctx, SEXP_G_ERR_HANDLER)
     = sexp_env_ref(ctx, e, sym=sexp_intern(ctx, "current-exception-handler", -1), SEXP_FALSE);
-  /* load init.scm */
+  /* load init-7.scm */
   len = strlen(sexp_init_file);
   strncpy(init_file, sexp_init_file, len);
   init_file[len] = sexp_unbox_fixnum(version) + '0';
@@ -2302,7 +2302,7 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
   init_file[len + 1 + strlen(sexp_init_file_suffix)] = 0;
   tmp = sexp_load_module_file(ctx, init_file, e);
   sexp_set_parameter(ctx, e, sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL), e);
-  /* load and bind config env */
+  /* load and bind meta-7.scm env */
 #if SEXP_USE_MODULES
   if (!sexp_exceptionp(tmp)) {
     if (!sexp_envp(tmp=sexp_global(ctx, SEXP_G_META_ENV))) {
@@ -2319,7 +2319,11 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
       sym = sexp_intern(ctx, "repl-import", -1);
       tmp = sexp_env_ref(ctx, tmp, sym, SEXP_VOID);
       sym = sexp_intern(ctx, "import", -1);
-      sexp_env_define(ctx, e, sym, tmp);
+      /* splice import in place to mutate both this env and the */
+      /* frozen version in the meta env) */
+      tmp = sexp_cons(ctx, sym, tmp);
+      sexp_env_next_cell(tmp) = sexp_env_next_cell(sexp_env_bindings(e));
+      sexp_env_next_cell(sexp_env_bindings(e)) = tmp;
     }
   }
 #endif
@@ -2336,6 +2340,11 @@ sexp sexp_make_standard_env_op (sexp ctx, sexp self, sexp_sint_t n, sexp version
   return env;
 }
 
+sexp sexp_env_parent_op (sexp ctx, sexp self, sexp_sint_t n, sexp e) {
+  sexp_assert_type(ctx, sexp_envp, SEXP_ENV, e);
+  return sexp_env_parent(e) ? sexp_env_parent(e) : SEXP_FALSE;
+}
+
 #if SEXP_USE_RENAME_BINDINGS
 #define sexp_same_bindingp(x, y) ((x) == (y))
 #else

include/chibi/eval.h

@@ -120,6 +120,7 @@ SEXP_API sexp sexp_set_port_line_op (sexp ctx, sexp self, sexp_sint_t n, sexp po
 SEXP_API sexp sexp_env_define (sexp ctx, sexp env, sexp sym, sexp val);
 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_env_parent_op (sexp ctx, sexp self, sexp_sint_t n, sexp env);
 SEXP_API sexp sexp_parameter_ref (sexp ctx, sexp param);
 #if SEXP_USE_RENAME_BINDINGS
 SEXP_API sexp sexp_env_rename (sexp ctx, sexp env, sexp key, sexp value);

lib/chibi/ast.c

@@ -211,11 +211,6 @@ static sexp sexp_type_of (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
     return sexp_type_by_index(ctx, SEXP_OBJECT);
 }
 
-static sexp sexp_env_parent_op (sexp ctx, sexp self, sexp_sint_t n, sexp e) {
-  sexp_assert_type(ctx, sexp_envp, SEXP_ENV, e);
-  return sexp_env_parent(e) ? sexp_env_parent(e) : SEXP_FALSE;
-}
-
 static sexp sexp_env_parent_set_op (sexp ctx, sexp self, sexp_sint_t n, sexp e) {
   sexp_assert_type(ctx, sexp_envp, SEXP_ENV, e);
   return sexp_env_parent(e) ? sexp_env_parent(e) : SEXP_FALSE;
@@ -603,7 +598,6 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
   sexp_define_foreign(ctx, env, "type-slots", 1, sexp_type_slots_op);
   sexp_define_foreign(ctx, env, "type-num-slots", 1, sexp_type_num_slots_op);
   sexp_define_foreign(ctx, env, "type-printer", 1, sexp_type_printer_op);
-  sexp_define_foreign(ctx, env, "env-parent", 1, sexp_env_parent_op);
   sexp_define_foreign(ctx, env, "env-parent-set!", 2, sexp_env_parent_set_op);
   sexp_define_foreign(ctx, env, "env-lambda", 1, sexp_env_lambda_op);
   sexp_define_foreign(ctx, env, "env-lambda-set!", 2, sexp_env_lambda_set_op);

lib/meta-7.scm

@@ -354,7 +354,11 @@
 (define *modules*
   (list
    (cons '(chibi)
-         (make-module #f (interaction-environment) '((include "init-7.scm"))))
+         ;; capture a static copy of the current environment to serve
+         ;; as the (chibi) module
+         (let ((env (make-environment)))
+           (%import env (interaction-environment) #f #t)
+           (make-module #f (env-parent env) '((include "init-7.scm")))))
    (cons '(chibi primitive)
          (make-module #f #f (lambda (env) (primitive-environment 7))))
    (cons '(meta)

main.c

@@ -587,7 +587,7 @@ void run_main (int argc, char **argv) {
           sym = sexp_intern(ctx, "repl-import", -1);
           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);
+          check_exception(ctx, sexp_env_define(ctx, env, sym, tmp));
           sym = sexp_intern(ctx, "cond-expand", -1);
           tmp = sexp_env_cell(ctx, sexp_meta_env(ctx), sym, 0);
 #if SEXP_USE_RENAME_BINDINGS

opcodes.c

@@ -165,6 +165,7 @@ _FN1(_I(SEXP_OPORT), _I(SEXP_STRING), "open-binary-output-file", 0, sexp_open_bi
 _FN1(SEXP_VOID, _I(SEXP_IPORT), "close-input-port", 0, sexp_close_port_op),
 _FN1(SEXP_VOID, _I(SEXP_OPORT), "close-output-port", 0, sexp_close_port_op),
 _FN0(_I(SEXP_ENV), "make-environment", 0, sexp_make_env_op),
+_FN1(_I(SEXP_ENV), _I(SEXP_ENV), "env-parent", 0, sexp_env_parent_op),
 _FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "null-environment", 0, sexp_make_null_env_op),
 _FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "primitive-environment", 0, sexp_make_primitive_env_op),
 _FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "scheme-report-environment", 0, sexp_make_standard_env_op),

sexp.c

@@ -1907,6 +1907,22 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
       sexp_write(ctx, sexp_type_name(obj), out);
       sexp_write_string(ctx, ">", out);
       break;
+#if 0
+    case SEXP_ENV:
+      sexp_write_string(ctx, "#<Env ", out);
+      sexp_write(ctx, sexp_make_fixnum(obj), out);
+      sexp_write_string(ctx, " ", out);
+      sexp_write(ctx, sexp_make_fixnum(sexp_env_bindings(obj)), out);
+      sexp_write_string(ctx, " (", out);
+      sexp_write(ctx, sexp_length(ctx, sexp_env_bindings(obj)), out);
+      sexp_write_string(ctx, ")", out);
+      if (sexp_env_parent(obj)) {
+        sexp_write_string(ctx, " ", out);
+        sexp_write(ctx, sexp_env_parent(obj), out);
+      }
+      sexp_write_string(ctx, ">", out);
+      break;
+#endif
     case SEXP_STRING:
       sexp_write_char(ctx, '"', out);
       i = sexp_string_size(obj);