diff options
author | Andy Wingo <wingo@pobox.com> | 2013-10-03 22:31:37 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-10-03 22:31:37 +0200 |
commit | 7c54029740a147a623c1f0564708d5471addf232 (patch) | |
tree | 56c29ccd01569d30af163aa3c40963d486055e0c /libguile/programs.c | |
parent | d7928d7c61f297dca574e20bb5815253e90b3a36 (diff) | |
download | guile-7c54029740a147a623c1f0564708d5471addf232.tar.gz |
program-source / program-sources works with RTL programs
* libguile/programs.c (scm_program_sources): Define as %program-sources,
and let Scheme export the program-sources proper.
(scm_program_source): Call out to Scheme.
* module/system/vm/program.scm: Convert to use match instead of pmatch.
Adapt existing callers.
(program-sources, program-source): New Scheme implementations of these
functions.
(program-sources-pre-retire): Add RTL program case.
Diffstat (limited to 'libguile/programs.c')
-rw-r--r-- | libguile/programs.c | 36 |
1 files changed, 14 insertions, 22 deletions
diff --git a/libguile/programs.c b/libguile/programs.c index 37130d0c0..5039d2a2b 100644 --- a/libguile/programs.c +++ b/libguile/programs.c @@ -297,7 +297,7 @@ SCM_DEFINE (scm_program_bindings, "program-bindings", 1, 0, 0, } #undef FUNC_NAME -SCM_DEFINE (scm_program_sources, "program-sources", 1, 0, 0, +SCM_DEFINE (scm_program_sources, "%program-sources", 1, 0, 0, (SCM program), "") #define FUNC_NAME s_scm_program_sources @@ -365,32 +365,24 @@ scm_i_program_properties (SCM program) } #undef FUNC_NAME -static SCM -program_source (SCM program, size_t ip, SCM sources) +SCM +scm_program_source (SCM program, SCM ip, SCM sources) { - SCM source = SCM_BOOL_F; + static SCM program_source = SCM_BOOL_F; - while (!scm_is_null (sources) - && scm_to_size_t (scm_caar (sources)) <= ip) - { - source = scm_car (sources); - sources = scm_cdr (sources); - } - - return source; /* (addr . (filename . (line . column))) */ -} + if (scm_is_false (program_source)) { + if (!scm_module_system_booted_p) + return SCM_BOOL_F; + + program_source = + scm_c_private_variable ("system vm program", "program-source"); + } -SCM_DEFINE (scm_program_source, "program-source", 2, 1, 0, - (SCM program, SCM ip, SCM sources), - "") -#define FUNC_NAME s_scm_program_source -{ - SCM_VALIDATE_PROGRAM (1, program); if (SCM_UNBNDP (sources)) - sources = scm_program_sources (program); - return program_source (program, scm_to_size_t (ip), sources); + return scm_call_2 (scm_variable_ref (program_source), program, ip); + else + return scm_call_3 (scm_variable_ref (program_source), program, ip, sources); } -#undef FUNC_NAME SCM_DEFINE (scm_program_num_free_variables, "program-num-free-variables", 1, 0, 0, (SCM program), |