1;; Copyright (C) 2014-2020 Free Software Foundation, Inc. 2;; 3;; This program is free software; you can redistribute it and/or modify 4;; it under the terms of the GNU General Public License as published by 5;; the Free Software Foundation; either version 3 of the License, or 6;; (at your option) any later version. 7;; 8;; This program is distributed in the hope that it will be useful, 9;; but WITHOUT ANY WARRANTY; without even the implied warranty of 10;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11;; GNU General Public License for more details. 12;; 13;; You should have received a copy of the GNU General Public License 14;; along with this program. If not, see <http://www.gnu.org/licenses/>. 15 16(use-modules (gdb) (gdb printing)) 17 18(define (make-pp_s-printer val) 19 (make-pretty-printer-worker 20 #f 21 (lambda (printer) 22 (let ((m (value-field val "m"))) 23 (format #f "m=<~A>" m))) 24 #f)) 25 26(define (make-pp_ss-printer val) 27 (make-pretty-printer-worker 28 #f 29 (lambda (printer) "super struct") 30 (lambda (printer) 31 (make-iterator val 32 (make-field-iterator (value-type val)) 33 (lambda (iter) 34 (let ((field (iterator-next! 35 (iterator-progress iter)))) 36 (if (end-of-iteration? field) 37 field 38 (let ((name (field-name field))) 39 (cons name (value-field val name)))))))))) 40 41(define (get-type-for-printing val) 42 "Return type of val, stripping away typedefs, etc." 43 (let ((type (value-type val))) 44 (if (= (type-code type) TYPE_CODE_REF) 45 (set! type (type-target type))) 46 (type-strip-typedefs (type-unqualified type)))) 47 48(define (make-pretty-printer-dict) 49 (let ((dict (make-hash-table))) 50 (hash-set! dict "struct s" make-pp_s-printer) 51 (hash-set! dict "s" make-pp_s-printer) 52 (hash-set! dict "struct ss" make-pp_ss-printer) 53 (hash-set! dict "ss" make-pp_ss-printer) 54 dict)) 55 56(define *pretty-printer* 57 (make-pretty-printer 58 "pretty-printer-test" 59 (let ((pretty-printers-dict (make-pretty-printer-dict))) 60 (lambda (matcher val) 61 "Look-up and return a pretty-printer that can print val." 62 (let ((type (get-type-for-printing val))) 63 (let ((typename (type-tag type))) 64 (if typename 65 (let ((printer-maker (hash-ref pretty-printers-dict typename))) 66 (and printer-maker (printer-maker val))) 67 #f))))))) 68 69(append-pretty-printer! #f *pretty-printer*) 70