summaryrefslogtreecommitdiff
path: root/libguile/programs.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2008-09-12 23:14:46 +0200
committerAndy Wingo <wingo@pobox.com>2008-09-13 14:19:30 +0200
commite6fea6182305f12db177af855f5c8343b4768c14 (patch)
treec84fae74eb382ba993ed121cb45dd84770b7f236 /libguile/programs.c
parent5dcf8f3555d8a96cc0c028f50c12968a4e238506 (diff)
downloadguile-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.c17
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