diff options
author | Andy Wingo <wingo@pobox.com> | 2008-09-12 23:14:46 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2008-09-13 14:19:30 +0200 |
commit | e6fea6182305f12db177af855f5c8343b4768c14 (patch) | |
tree | c84fae74eb382ba993ed121cb45dd84770b7f236 /libguile/programs.c | |
parent | 5dcf8f3555d8a96cc0c028f50c12968a4e238506 (diff) | |
download | guile-e6fea6182305f12db177af855f5c8343b4768c14.tar.gz |
programs can now get at their names, and print nicely
* module/system/vm/frame.scm (frame-call-representation)
(frame-program-name): Rename program-name to frame-program-name, and
use the program-name if it is available.
* module/system/vm/program.scm (program-bindings): Return #f if there are
no bindings.
(program-name): New public procedure.
(program-bindings-as-lambda-list, write-program): A more useful writer
for programs.
* libguile/programs.c (scm_bootstrap_programs, program_print): Add a smob
printer for programs, which dispatches to `write-program'.
Diffstat (limited to 'libguile/programs.c')
-rw-r--r-- | libguile/programs.c | 17 |
1 files changed, 17 insertions, 0 deletions
diff --git a/libguile/programs.c b/libguile/programs.c index 1b3895ba2..71abaa750 100644 --- a/libguile/programs.c +++ b/libguile/programs.c @@ -54,6 +54,7 @@ scm_t_bits scm_tc16_program; static SCM zero_vector; +static SCM write_program = SCM_BOOL_F; SCM scm_c_make_program (void *addr, size_t size, SCM holder) @@ -125,6 +126,21 @@ program_apply (SCM program, SCM args) return scm_vm_apply (scm_the_vm (), program, args); } +static int +program_print (SCM program, SCM port, scm_print_state *pstate) +{ + if (SCM_FALSEP (write_program)) + write_program = scm_module_local_variable + (scm_c_resolve_module ("system vm program"), + scm_from_locale_symbol ("write-program")); + + if (SCM_FALSEP (write_program)) + return scm_smob_print (program, port, pstate); + + scm_call_2 (SCM_VARIABLE_REF (write_program), program, port); + return 1; +} + /* * Scheme interface @@ -252,6 +268,7 @@ scm_bootstrap_programs (void) scm_set_smob_mark (scm_tc16_program, program_mark); scm_set_smob_free (scm_tc16_program, program_free); scm_set_smob_apply (scm_tc16_program, program_apply, 0, 0, 1); + scm_set_smob_print (scm_tc16_program, program_print); } void |