mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 21:10:27 +02:00
Code Activity

tweaks for printing programs

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2008-09-13 13:14:45 +02:00
parent e6fea61823
commit 0ba8bb7143
2 changed files with 8 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

6
libguile/programs.c
View file

@ -129,15 +129,19 @@ program_apply (SCM program, SCM args)
static int static int
program_print (SCM program, SCM port, scm_print_state *pstate) program_print (SCM program, SCM port, scm_print_state *pstate)
{ {
static int print_error = 0;
if (SCM_FALSEP (write_program)) if (SCM_FALSEP (write_program))
write_program = scm_module_local_variable write_program = scm_module_local_variable
(scm_c_resolve_module ("system vm program"), (scm_c_resolve_module ("system vm program"),
scm_from_locale_symbol ("write-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); return scm_smob_print (program, port, pstate);
print_error = 1;
scm_call_2 (SCM_VARIABLE_REF (write_program), program, port); scm_call_2 (SCM_VARIABLE_REF (write_program), program, port);
print_error = 0;
return 1; return 1;
} }

4
module/system/vm/program.scm
View file

@ -82,7 +82,7 @@
(let ((bindings (program-bindings prog)) (let ((bindings (program-bindings prog))
(nargs (arity:nargs (program-arity prog))) (nargs (arity:nargs (program-arity prog)))
(rest? (not (zero? (arity:nrest (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)) (if rest? (cons (1- nargs) 1) (list nargs))
(let ((arg-names (map binding:name (cdar bindings)))) (let ((arg-names (map binding:name (cdar bindings))))
(if rest? (if rest?
@ -92,5 +92,7 @@
(define (write-program prog port) (define (write-program prog port)
(format port "#<program ~a ~a>" (format port "#<program ~a ~a>"
(or (program-name prog) (or (program-name prog)
(let ((s (program-sources prog)))
(and (not (null? s)) (cdar s)))
(number->string (object-address prog) 16)) (number->string (object-address prog) 16))
(program-bindings-as-lambda-list prog))) (program-bindings-as-lambda-list prog)))