summaryrefslogtreecommitdiff
path: root/libguile/debug.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/debug.c')
-rw-r--r--libguile/debug.c31
1 files changed, 31 insertions, 0 deletions
diff --git a/libguile/debug.c b/libguile/debug.c
index 20c8d4e6b..fe54b64df 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -400,6 +400,37 @@ SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_procedure_module, "procedure-module", 1, 0, 0,
+ (SCM proc),
+ "Return the module that was current when this procedure was defined.\n"
+ "Free variables in this procedure are resolved relative to the\n"
+ "procedure's module.")
+#define FUNC_NAME s_scm_procedure_module
+{
+ SCM_VALIDATE_PROC (SCM_ARG1, proc);
+
+ if (scm_is_true (scm_program_p (proc)))
+ return scm_program_module (proc);
+ else
+ {
+ SCM env = scm_procedure_environment (proc);
+
+ if (scm_is_null (env))
+ return SCM_BOOL_F;
+ else
+ {
+ for (; !scm_is_null (scm_cdr (env)); env = scm_cdr (env))
+ ;
+ if (SCM_EVAL_CLOSURE_P (scm_car (env)))
+ return SCM_PACK (SCM_SMOB_DATA (scm_car (env)));
+ else
+ return SCM_BOOL_F;
+ }
+ }
+}
+#undef FUNC_NAME
+
+
/* Eval in a local environment. We would like to have the ability to