Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 13:19:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source
This commit is contained in:
Alex Shinn 2022-10-04 16:07:36 +09:00
parent e88374aae1
commit 0eeeac7650
6 changed files with 19 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
eval.c
View file

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

1
include/chibi/sexp.h
View file

@ -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, ...);

9
lib/chibi/ast.c
View file

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

7
lib/meta-7.scm
View file

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

4
main.c
View file

@ -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"\" "

1
opcodes.c
View file

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