From 0ba8bb7143204fb8f2b99c80ff62b16bed4b56fd Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sat, 13 Sep 2008 13:14:45 +0200 Subject: [PATCH] tweaks for printing programs * module/system/vm/program.scm (program-bindings-as-lambda-list): Handle the bindings-is-null case too -- not sure how it comes about, though. A thunk with no let, perhaps. (write-program): Another default for the name: the source location at which it was defined. * libguile/programs.c (program_print): Add some "logic" to stop doing detailed prints if one print had a nonlocal exit -- preventing exceptions in backtraces. --- libguile/programs.c | 6 +++++- module/system/vm/program.scm | 4 +++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/libguile/programs.c b/libguile/programs.c index 71abaa750..dfa6196d4 100644 --- a/libguile/programs.c +++ b/libguile/programs.c @@ -129,15 +129,19 @@ program_apply (SCM program, SCM args) static int program_print (SCM program, SCM port, scm_print_state *pstate) { + static int print_error = 0; + 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)) + if (SCM_FALSEP (write_program) || print_error) return scm_smob_print (program, port, pstate); + print_error = 1; scm_call_2 (SCM_VARIABLE_REF (write_program), program, port); + print_error = 0; return 1; } diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm index 4be2da10e..f31d5bf31 100644 --- a/module/system/vm/program.scm +++ b/module/system/vm/program.scm @@ -82,7 +82,7 @@ (let ((bindings (program-bindings prog)) (nargs (arity:nargs (program-arity prog))) (rest? (not (zero? (arity:nrest (program-arity prog)))))) - (if (not bindings) + (if (or (null? bindings) (not bindings)) (if rest? (cons (1- nargs) 1) (list nargs)) (let ((arg-names (map binding:name (cdar bindings)))) (if rest? @@ -92,5 +92,7 @@ (define (write-program prog port) (format port "#" (or (program-name prog) + (let ((s (program-sources prog))) + (and (not (null? s)) (cdar s))) (number->string (object-address prog) 16)) (program-bindings-as-lambda-list prog)))