diff --git a/eval.c b/eval.c index ea94287b..38bdaeac 100644 --- a/eval.c +++ b/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 diff --git a/include/chibi/eval.h b/include/chibi/eval.h index 421acef3..e82f8fa2 100644 --- a/include/chibi/eval.h +++ b/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); diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c index d82c487e..915b77f1 100644 --- a/lib/chibi/ast.c +++ b/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); diff --git a/lib/meta-7.scm b/lib/meta-7.scm index 6d55a113..e90d2047 100644 --- a/lib/meta-7.scm +++ b/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) diff --git a/main.c b/main.c index 98462501..841a5be8 100644 --- a/main.c +++ b/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 diff --git a/opcodes.c b/opcodes.c index c7143c1d..928fde48 100644 --- a/opcodes.c +++ b/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), diff --git a/sexp.c b/sexp.c index 42a0288d..27ceeae8 100644 --- a/sexp.c +++ b/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, "#", out); + break; +#endif case SEXP_STRING: sexp_write_char(ctx, '"', out); i = sexp_string_size(obj);