Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 22:59:16 +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) {
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) {
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_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_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_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);

23
lib/init-7.scm
View file

@ -996,15 +996,20 @@
((and (> len ext-len 0) (equal? ext (substring file (- len ext-len))))
(%load file env))
(else
(call-with-input-file file
(lambda (in)
(set-port-line! in 1)
(let lp ()
(let ((x (read in)))
(cond
((not (eof-object? x))
(eval x env)
(lp)))))))))))
(let ((old-env (current-environment)))
(dynamic-wind
(lambda () (set-current-environment! env))
(lambda ()
(call-with-input-file file
(lambda (in)
(set-port-line! in 1)
(let lp ()
(let ((x (read in)))
(cond
((not (eof-object? x))
(eval x env)
(lp))))))))
(lambda () (set-current-environment! old-env))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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
#if SEXP_USE_MODULES
_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),
_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),