summaryrefslogtreecommitdiff
path: root/libguile/modules.c
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>1999-03-19 02:28:09 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>1999-03-19 02:28:09 +0000
commitd164a5af5c50775bb46db38f2c70b27f55e9d32f (patch)
treeb7fcd6b10fd11ccf29e47addc533a606cb400f7a /libguile/modules.c
parentbedec8037a4695804052851b98eb8af19a194ad9 (diff)
downloadguile-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.c45
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");
}