Make environment immutable and add mutable-environment alternative (issue #863).

eval.c

@@ -2544,10 +2544,19 @@ sexp sexp_make_standard_env_op (sexp ctx, sexp self, sexp_sint_t n, sexp version
   sexp_gc_preserve1(ctx, env);
   env = sexp_make_primitive_env(ctx, version);
   if (! sexp_exceptionp(env)) env = sexp_load_standard_env(ctx, env, SEXP_SEVEN);
+  if (sexp_envp(env)) sexp_immutablep(env) = 1;
   sexp_gc_release1(ctx);
   return env;
 }
 
+sexp sexp_make_immutable_op (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
+  if (sexp_pointerp(x)) {
+    sexp_immutablep(x) = 1;
+    return SEXP_TRUE;
+  }
+  return SEXP_FALSE;
+}
+
 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;

include/chibi/sexp.h

@@ -1756,6 +1756,7 @@ SEXP_API sexp sexp_lookup_type_op (sexp ctx, sexp self, sexp_sint_t n, sexp name
 SEXP_API sexp sexp_open_input_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp str);
 SEXP_API sexp sexp_open_output_string_op (sexp ctx, sexp self, sexp_sint_t n);
 SEXP_API sexp sexp_get_output_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp port);
+SEXP_API sexp sexp_make_immutable_op (sexp ctx, sexp self, sexp_sint_t n, sexp x);
 SEXP_API sexp sexp_make_exception (sexp ctx, sexp kind, sexp message, sexp irritants, sexp procedure, sexp source);
 SEXP_API sexp sexp_user_exception (sexp ctx, sexp self, const char *msg, sexp x);
 SEXP_API sexp sexp_user_exception_ls (sexp ctx, sexp self, const char *msg, int n, ...);

lib/chibi/ast.c

@@ -364,14 +364,6 @@ sexp sexp_immutablep_op (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
   return sexp_pointerp(x) ? sexp_make_boolean(sexp_immutablep(x)) : SEXP_TRUE;
 }
 
-sexp sexp_make_immutable_op (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
-  if (sexp_pointerp(x)) {
-    sexp_immutablep(x) = 1;
-    return SEXP_TRUE;
-  }
-  return SEXP_FALSE;
-}
-
 sexp sexp_immutable_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp s) {
   sexp res;
   sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, s);
@@ -772,7 +764,6 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
   sexp_define_foreign(ctx, env, "core-code", 1, sexp_core_code_op);
   sexp_define_foreign(ctx, env, "object-size", 1, sexp_object_size);
   sexp_define_foreign(ctx, env, "immutable?", 1, sexp_immutablep_op);
-  sexp_define_foreign(ctx, env, "make-immutable!", 1, sexp_make_immutable_op);
   sexp_define_foreign(ctx, env, "immutable-string", 1, sexp_immutable_string_op);
   sexp_define_foreign_opt(ctx, env, "integer->immediate", 2, sexp_integer_to_immediate, SEXP_FALSE);
   sexp_define_foreign_opt(ctx, env, "object->integer", 1, sexp_object_to_integer, SEXP_FALSE);

lib/meta-7.scm

@@ -230,7 +230,7 @@
       (warn-undefs env #f)
       env))))
 
-(define (environment . ls)
+(define (mutable-environment . ls)
   (let ((env (make-environment)))
     (for-each
      (lambda (m)
@@ -240,6 +240,11 @@
      ls)
     env))
 
+(define (environment . ls)
+  (let ((env (apply mutable-environment ls)))
+    (make-immutable! env)
+    env))
+
 (define (load-module name)
   (let ((mod (find-module name)))
     (if (and mod (not (module-env mod)))

main.c

@@ -14,11 +14,11 @@
 
 #define sexp_import_prefix "(import ("
 #define sexp_import_suffix "))"
-#define sexp_environment_prefix "(environment '("
+#define sexp_environment_prefix "(mutable-environment '("
 #define sexp_environment_suffix "))"
 #define sexp_trace_prefix "(module-env (load-module '("
 #define sexp_trace_suffix ")))"
-#define sexp_default_environment "(environment '(scheme small))"
+#define sexp_default_environment "(mutable-environment '(scheme small))"
 #define sexp_advice_environment "(load-module '(chibi repl))"
 
 #define sexp_version_string "chibi-scheme "sexp_version" \""sexp_release_name"\" "

opcodes.c

@@ -179,6 +179,7 @@ _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),
+_FN1(_I(SEXP_BOOLEAN), _I(SEXP_OBJECT), "make-immutable!", 0, sexp_make_immutable_op),
 _FN2OPTP(_I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_ENV), "compile", (sexp)"interaction-environment", sexp_compile_op),
 _FN2OPTP(_I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_ENV), "generate", (sexp)"interaction-environment", sexp_generate_op),
 _FN2OPTP(SEXP_VOID, _I(SEXP_STRING), _I(SEXP_ENV), "%load", (sexp)"interaction-environment", sexp_load_op),