diff options
Diffstat (limited to 'libguile/debug.c')
-rw-r--r-- | libguile/debug.c | 31 |
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 |