mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Improve the printer of SRFI-35 error conditions.
* module/srfi/srfi-35.scm (print-condition): Print the name and value of each field.
This commit is contained in:
parent
99480e1118
commit
67231cef72
1 changed files with 16 additions and 3 deletions
|
@ -100,9 +100,22 @@
|
|||
(cons "pr" layout)))))
|
||||
|
||||
(define (print-condition c port)
|
||||
(format port "#<condition ~a ~a>"
|
||||
(condition-type-id (condition-type c))
|
||||
(number->string (object-address c) 16)))
|
||||
;; Print condition C to PORT in a way similar to how records print:
|
||||
;; #<condition TYPE [FIELD: VALUE ...] ADDRESS>.
|
||||
(define (field-values)
|
||||
(let* ((type (struct-vtable c))
|
||||
(strings (fold (lambda (field result)
|
||||
(cons (format #f "~A: ~S" field
|
||||
(condition-ref c field))
|
||||
result))
|
||||
'()
|
||||
(condition-type-all-fields type))))
|
||||
(string-join (reverse strings) " ")))
|
||||
|
||||
(format port "#<condition ~a [~a] ~a>"
|
||||
(condition-type-id (condition-type c))
|
||||
(field-values)
|
||||
(number->string (object-address c) 16)))
|
||||
|
||||
(define (make-condition-type id parent field-names)
|
||||
"Return a new condition type named ID, inheriting from PARENT, and with the
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue