[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/02: Struct and array GDB pretty printers hint as arra
From: |
Ludovic Courtès |
Subject: |
[Guile-commits] 02/02: Struct and array GDB pretty printers hint as arrays |
Date: |
Wed, 25 Feb 2015 20:56:22 +0000 |
civodul pushed a commit to branch stable-2.0
in repository guile.
commit 79072a210a2d25e1c81943dedfb2411289468e7f
Author: Andy Wingo <address@hidden>
Date: Wed Feb 25 21:54:36 2015 +0100
Struct and array GDB pretty printers hint as arrays
* libguile/libguile-2.0-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.0-gdb.scm | 65 ++++++++++++++++++++++++++++++++++------
1 files changed, 55 insertions(+), 10 deletions(-)
diff --git a/libguile/libguile-2.0-gdb.scm b/libguile/libguile-2.0-gdb.scm
index fdd5cd8..4d09022 100644
--- a/libguile/libguile-2.0-gdb.scm
+++ b/libguile/libguile-2.0-gdb.scm
@@ -1,6 +1,6 @@
;;; GDB debugging support for Guile.
;;;
-;;; Copyright 2014 Free Software Foundation, Inc.
+;;; Copyright 2014, 2015 Free Software Foundation, Inc.
;;;
;;; This program is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
@@ -20,6 +20,7 @@
#:use-module ((gdb) #:hide (symbol?))
#:use-module (gdb printing)
#:use-module (srfi srfi-11)
+ #:use-module (ice-9 match)
#:export (%gdb-memory-backend
display-vm-frames))
@@ -81,16 +82,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))