diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1999-03-19 02:28:09 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1999-03-19 02:28:09 +0000 |
commit | d164a5af5c50775bb46db38f2c70b27f55e9d32f (patch) | |
tree | b7fcd6b10fd11ccf29e47addc533a606cb400f7a /libguile/modules.c | |
parent | bedec8037a4695804052851b98eb8af19a194ad9 (diff) | |
download | guile-d164a5af5c50775bb46db38f2c70b27f55e9d32f.tar.gz |
* modules.c: #include "procprop.h"
(scm_system_module_env_p): Assume root environment is no lookup
closure is found.
* modules.c, modules.h, eval.c, eval.h (scm_env_top_level,
scm_top_level_env, scm_system_module_env_p): Moved to modules.c.
Diffstat (limited to 'libguile/modules.c')
-rw-r--r-- | libguile/modules.c | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/libguile/modules.c b/libguile/modules.c index 9c0278ad1..3b3f4d28b 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -43,10 +43,12 @@ #include "_scm.h" #include "eval.h" +#include "procprop.h" #include "modules.h" static SCM the_root_module; +static SCM root_module_lookup_closure; SCM scm_the_root_module () @@ -130,6 +132,47 @@ scm_load_scheme_module (SCM name) return scm_apply (SCM_CDR (try_module_autoload), SCM_LIST1 (name), SCM_EOL); } +/* Environments + */ + +SCM +scm_top_level_env (thunk) + SCM thunk; +{ + if (SCM_IMP (thunk)) + return SCM_EOL; + else + return scm_cons (thunk, SCM_EOL); +} + +SCM +scm_env_top_level (SCM env) +{ + while (SCM_NIMP (env)) + { + if (!SCM_CONSP (SCM_CAR (env)) + && SCM_NFALSEP (scm_procedure_p (SCM_CAR (env)))) + return SCM_CAR(env); + env = SCM_CDR (env); + } + return SCM_BOOL_F; +} + + +SCM_SYMBOL (scm_sym_system_module, "system-module"); + +SCM +scm_system_module_env_p (SCM env) +{ + SCM proc = scm_env_top_level (env); + if (SCM_FALSEP (proc)) + proc = root_module_lookup_closure; + return ((SCM_NFALSEP (scm_procedure_property (proc, + scm_sym_system_module))) + ? SCM_BOOL_T + : SCM_BOOL_F); +} + void scm_init_modules () { @@ -147,6 +190,8 @@ scm_post_boot_init_modules () make_modules_in = scm_intern0 ("make-modules-in"); beautify_user_module_x = scm_intern0 ("beautify-user-module!"); module_eval_closure = scm_intern0 ("module-eval-closure"); + root_module_lookup_closure = scm_permanent_object + (scm_module_lookup_closure (SCM_CDR (the_root_module))); resolve_module = scm_intern0 ("resolve-module"); try_module_autoload = scm_intern0 ("try-module-autoload"); } |