[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: Struct and array GDB pretty printers hint as arra
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/01: Struct and array GDB pretty printers hint as arrays |
Date: |
Tue, 17 Feb 2015 10:54:36 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit c4c21de44f0108c5721fe0991da3a050d3c12677
Author: Andy Wingo <address@hidden>
Date: Tue Feb 17 11:53:03 2015 +0100
Struct and array GDB pretty printers hint as arrays
* libguile/libguile-2.2-gdb.scm (make-scm-pretty-printer-worker):
(%scm-pretty-printer): Refactor to avoid printing all struct / array
fields by hinting these as arrays. The resulting print is not as
faithful to the original data, but that's probably OK.
---
libguile/libguile-2.2-gdb.scm | 62 +++++++++++++++++++++++++++++++++++------
1 files changed, 53 insertions(+), 9 deletions(-)
diff --git a/libguile/libguile-2.2-gdb.scm b/libguile/libguile-2.2-gdb.scm
index 6c8d8a3..7e0559e 100644
--- a/libguile/libguile-2.2-gdb.scm
+++ b/libguile/libguile-2.2-gdb.scm
@@ -87,16 +87,60 @@ if the information is not available."
"Return a representation of value VALUE as a string."
(object->string (scm->object (value->integer value) backend))))
+(define (make-scm-pretty-printer-worker obj)
+ (define (list->iterator list)
+ (make-iterator list list
+ (let ((n 0))
+ (lambda (iter)
+ (match (iterator-progress iter)
+ (() (end-of-iteration))
+ ((elt . list)
+ (set-iterator-progress! iter list)
+ (let ((name (format #f "[~a]" n)))
+ (set! n (1+ n))
+ (cons name (object->string elt)))))))))
+ (cond
+ ((string? obj)
+ (make-pretty-printer-worker
+ "string" ; display hint
+ (lambda (printer) obj)
+ #f))
+ ((and (array? obj)
+ (match (array-shape obj)
+ (((0 _)) #t)
+ (_ #f)))
+ (make-pretty-printer-worker
+ "array" ; display hint
+ (lambda (printer)
+ (let ((tag (array-type obj)))
+ (case tag
+ ((#t) "#<vector>")
+ ((b) "#<bitvector>")
+ (else (format #f "#<~avector>" tag)))))
+ (lambda (printer)
+ (list->iterator (array->list obj)))))
+ ((inferior-struct? obj)
+ (make-pretty-printer-worker
+ "array" ; display hint
+ (lambda (printer)
+ (format #f "#<struct ~a>" (inferior-struct-name obj)))
+ (lambda (printer)
+ (list->iterator (inferior-struct-fields obj)))))
+ (else
+ (make-pretty-printer-worker
+ #f ; display hint
+ (lambda (printer)
+ (object->string obj))
+ #f))))
+
(define %scm-pretty-printer
- (make-pretty-printer "SCM"
- (lambda (pp value)
- (let ((name (type-name (value-type value))))
- (and (and name (string=? name "SCM"))
- (make-pretty-printer-worker
- #f ; display hint
- (lambda (printer)
- (scm-value->string value
%gdb-memory-backend))
- #f))))))
+ (make-pretty-printer
+ "SCM"
+ (lambda (pp value)
+ (let ((name (type-name (value-type value))))
+ (and (and name (string=? name "SCM"))
+ (make-scm-pretty-printer-worker
+ (scm->object (value->integer value) %gdb-memory-backend)))))))
(define* (register-pretty-printer #:optional objfile)
(prepend-pretty-printer! objfile %scm-pretty-printer))