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

Adding set-current-environment! and using it in the pure-Scheme load.

Browse source 
This is necessary if the loaded file uses import.
This commit is contained in:
Alex Shinn 2013-09-02 21:05:42 +09:00
parent d1efacb9c4
commit d32cc99cc1
4 changed files with 23 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
eval.c
View file

@ -1991,6 +1991,13 @@ sexp sexp_load_module_file_op (sexp ctx, sexp self, sexp_sint_t n, sexp file, se
sexp sexp_current_environment (sexp ctx, sexp self, sexp_sint_t n) { sexp sexp_current_environment (sexp ctx, sexp self, sexp_sint_t n) {
return sexp_context_env(ctx); return sexp_context_env(ctx);
} }
sexp sexp_set_current_environment (sexp ctx, sexp self, sexp_sint_t n, sexp env) {
sexp oldenv;
sexp_assert_type(ctx, sexp_envp, SEXP_ENV, env);
oldenv = sexp_context_env(ctx);
sexp_context_env(ctx) = env;
return oldenv;
}
sexp sexp_meta_environment (sexp ctx, sexp self, sexp_sint_t n) { sexp sexp_meta_environment (sexp ctx, sexp self, sexp_sint_t n) {
return sexp_global(ctx, SEXP_G_META_ENV); return sexp_global(ctx, SEXP_G_META_ENV);
} }

1
include/chibi/eval.h
View file

@ -101,6 +101,7 @@ SEXP_API sexp sexp_find_module_file_op (sexp ctx, sexp self, sexp_sint_t n, sexp
SEXP_API sexp sexp_load_module_file_op (sexp ctx, sexp self, sexp_sint_t n, sexp file, sexp env); SEXP_API sexp sexp_load_module_file_op (sexp ctx, sexp self, sexp_sint_t n, sexp file, sexp env);
SEXP_API sexp sexp_add_module_directory_op (sexp ctx, sexp self, sexp_sint_t n, sexp dir, sexp appendp); SEXP_API sexp sexp_add_module_directory_op (sexp ctx, sexp self, sexp_sint_t n, sexp dir, sexp appendp);
SEXP_API sexp sexp_current_environment (sexp ctx, sexp self, sexp_sint_t n); SEXP_API sexp sexp_current_environment (sexp ctx, sexp self, sexp_sint_t n);
SEXP_API sexp sexp_set_current_environment (sexp ctx, sexp self, sexp_sint_t n, sexp env);
SEXP_API sexp sexp_meta_environment (sexp ctx, sexp self, sexp_sint_t n); SEXP_API sexp sexp_meta_environment (sexp ctx, sexp self, sexp_sint_t n);
SEXP_API sexp sexp_extend_env (sexp ctx, sexp env, sexp vars, sexp value); SEXP_API sexp sexp_extend_env (sexp ctx, sexp env, sexp vars, sexp value);
SEXP_API sexp sexp_env_import_op (sexp ctx, sexp self, sexp_sint_t n, sexp to, sexp from, sexp ls, sexp immutp); SEXP_API sexp sexp_env_import_op (sexp ctx, sexp self, sexp_sint_t n, sexp to, sexp from, sexp ls, sexp immutp);

7
lib/init-7.scm
View file

@ -996,6 +996,10 @@
((and (> len ext-len 0) (equal? ext (substring file (- len ext-len)))) ((and (> len ext-len 0) (equal? ext (substring file (- len ext-len))))
(%load file env)) (%load file env))
(else (else
(let ((old-env (current-environment)))
(dynamic-wind
(lambda () (set-current-environment! env))
(lambda ()
(call-with-input-file file (call-with-input-file file
(lambda (in) (lambda (in)
(set-port-line! in 1) (set-port-line! in 1)
@ -1004,7 +1008,8 @@
(cond (cond
((not (eof-object? x)) ((not (eof-object? x))
(eval x env) (eval x env)
(lp))))))))))) (lp))))))))
(lambda () (set-current-environment! old-env))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; promises ;; promises

1
opcodes.c
View file

@ -246,6 +246,7 @@ _FN1(_I(SEXP_OBJECT), _I(SEXP_IPORT), "port-fileno", 0, sexp_get_port_fileno),
#endif #endif
#if SEXP_USE_MODULES #if SEXP_USE_MODULES
_FN0(_I(SEXP_ENV), "current-environment", 0, sexp_current_environment), _FN0(_I(SEXP_ENV), "current-environment", 0, sexp_current_environment),
_FN1(_I(SEXP_ENV), _I(SEXP_ENV), "set-current-environment!", 0, sexp_set_current_environment),
_FN0(_I(SEXP_ENV), "%meta-env", 0, sexp_meta_environment), _FN0(_I(SEXP_ENV), "%meta-env", 0, sexp_meta_environment),
_FN1(SEXP_NULL, _I(SEXP_ENV), "env-exports", 0, sexp_env_exports_op), _FN1(SEXP_NULL, _I(SEXP_ENV), "env-exports", 0, sexp_env_exports_op),
_FN0(_I(SEXP_PAIR), "current-module-path", 0, sexp_current_module_path_op), _FN0(_I(SEXP_PAIR), "current-module-path", 0, sexp_current_module_path_op),