guile-commits
[Top][All Lists]
Advanced

[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))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]