This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
Re: [RFC] Guile info/enable/disable command trio support
- From: Andy Wingo <wingo at igalia dot com>
- To: Doug Evans <xdje42 at gmail dot com>
- Cc: gdb-patches at sourceware dot org
- Date: Thu, 09 Apr 2015 11:27:01 +0200
- Subject: Re: [RFC] Guile info/enable/disable command trio support
- Authentication-results: sourceware.org; auth=none
- References: <m3y4mcicvn dot fsf at sspiff dot org>
Hi Doug!
A bunch of nits, for you to address or not as you choose :)
On Wed 01 Apr 2015 08:25, Doug Evans <xdje42@gmail.com> writes:
> diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c
> index 4abf5c5..5975472 100644
> --- a/gdb/guile/guile.c
> +++ b/gdb/guile/guile.c
> @@ -704,6 +705,15 @@ call_initialize_gdb_module (void *data)
> performed within the desired module. */
> scm_c_define_module (gdbscm_module_name, initialize_gdb_module, NULL);
>
> + /* Now that the (gdb) module is defined we can do the rest of Scheme
> + initialization. */
> + {
> + SCM finish_init = scm_c_public_lookup (gdbscm_init_module_name,
> + finish_init_func_name);
> +
> + scm_call_0 (scm_variable_ref (finish_init));
> + }
> +
> #if HAVE_GUILE_MANUAL_FINALIZATION
> scm_run_finalizers ();
> #endif
Here you can use scm_c_public_ref. "scm_c_public_ref (X, Y)" is the
same as "scm_variable_ref (scm_c_public_lookup (X, Y))".
> diff --git a/gdb/guile/lib/gdb/command-trio.scm b/gdb/guile/lib/gdb/command-trio.scm
> new file mode 100644
> index 0000000..5621121
> --- /dev/null
> +++ b/gdb/guile/lib/gdb/command-trio.scm
> @@ -0,0 +1,230 @@
> +(define-module (gdb command-trio)
> + #:use-module ((gdb) #:select (throw-user-error
> + string->argv
Side note: are we using tabs consciously? If not, the usual thing is to
use spaces, as it makes it easier to copy-paste definitions into a
console without causing tab completion to happen. If that's a possible
change, it's probably worth adding a .dir-locals.el addition.
> +(define-public (register-guile-command-trio!
> + cmd-name cmd-class
> + global-iterator progspace-iterator objfile-iterator
> + get-name-func get-enabled-func set-enabled-func
> + info-doc enable-doc disable-doc)
WDYT about changing these the "-func" names to get-name, get-enabled,
and set-enabled! ? That way their uses are clearer; something like:
(get-name-func x)
makes me think that the result is a name-func.
I also think that the iterators are not really idiomatic. As they are,
they should probably be named "for-each/global", "for-each/progspace"
etc because really they do a for-each on the lists; but it would be
better to express them as folds so that you can return a value if
needed. More comments below.
> + "Register info/enable/disable commands for CMD-NAME.
> +
> +INFO-DOC, ENABLE-DOC, DISABLE-DOC are the first sentence of the doc string
> +for their commands.
> +
> +Note: CMD-NAME must not be the plural form. We compute the plural form
> +in verbose output."
> +
> + (define (do-one doer name-re object arg count)
> + (if (re-match? name-re (get-name-func object))
> + (begin
> + (doer object arg)
> + (set-car! count (+ (car count) 1)))))
Single-arm "if" statements are usually better written with "when" or
"unless", especially if the body has a "begin". In this case:
(when (re-match? name-re (get-name-func object))
(doer object arg)
(set-car! count (+ (car count) 1)))
Incidentally "doer" is not a great name ;-) As a generic name "proc" is
better but not by much.
> + (define (do-locus iterator locus print-title name-re doer arg)
> + (let ((count (cons 0 0)))
> + (iterator locus name-re count-matching arg count)
> + (if (> (car count) 0)
> + (begin
> + (print-title)
> + (set! count (cons 0 0))
> + (iterator locus name-re doer arg count)))))
Regarding folds; how about:
(define (fold-matching-objects fold-objects locus name-re f seed)
(define (fold-matching object seed)
(if (re-match? name-re (get-name object))
(f object seed)
seed))
(fold-objects locus fold-matching seed))
(define (for-each-object fold-objects locus print-title name-re proc arg)
(match (fold-matching-objects fold-objects locus name-re cons '())
(()
;; No matching objects found.
*unspecified*)
(reversed-objects
(print-title)
(for-each (lambda (obj) (proc obj arg))
(reverse reversed-objects)))))
> + (define (print-info object name-re port count)
> + (do-one (lambda (object port)
> + (format port " ~a" (get-name-func object))
> + (if (not (get-enabled-func object))
> + (display " [disabled]" port))
> + (newline port))
> + name-re object port count))
See later use, but this can be simplified to:
(define (print-info object port)
(format port " ~a" (get-name object))
(unless (get-enabled object)
(display " [disabled]" port))
(newline port))
> +
> + (define (set-enabled! object name-re flag count)
> + (do-one set-enabled-func name-re object flag count))
> +
> + (define (count-matching object name-re ignore count)
> + (do-one (lambda (object arg) #f) name-re object ignore count))
> +
> + (define (re-match? regexp name)
> + (if regexp
> + (regexp-exec regexp name)
> + #t))
> +
> + (define (parse-args args)
> + (let loop ((argv (string->argv args))
> + (flags '()))
> + (cond ((eq? argv '())
> + (values flags #f #f))
> + ((string=? (string-take (car argv) 1) "-")
> + (loop (cdr argv) (cons (car argv) flags)))
> + ((> (length argv) 2)
> + (throw-user-error "too many args: ~a" args))
> + ((= (length argv) 2)
> + (values flags (car argv) (cadr argv)))
> + (else
> + (values flags (car argv) #f)))))
Better to use pattern matching to avoid meaningless cdaddring. You'd
have to import (ice-9 match).
(define (parse-args args)
(define (flag? str)
(string-prefix? "-" str))
(let loop ((argv (string->argv args)) (flags '()))
(match argv
(() (values flags #f #f))
(((? flag? flag) . argv)
(loop argv (cons flag flags)))
((locus)
(values flags locus #f))
((locus name)
(values flags locus name))
(_ (throw-user-error "too many args: ~a" args)))))
> + (define (print-all-info args)
> + (define-values (flags locus name) (parse-args args))
> + (let ((locus-re (and locus (make-regexp locus)))
> + (name-re (and name (make-regexp name)))
> + (port (current-output-port)))
> + (if (not (eq? flags '()))
> + (throw-user-error "unrecognized flag: ~a" (car flags)))
> + (if (re-match? locus-re "global")
> + (do-locus global-iterator #f
> + (lambda () (display "Global:\n"))
> + name-re print-info port))
(for-each-object fold-objects/global #f
(lambda () (display "Global:\n"))
name-re print-info port)
> + (if (re-match? locus-re "progspace")
> + (do-locus progspace-iterator (current-progspace)
> + (lambda ()
> + (format port "Progspace ~a:\n"
> + (progspace-filename (current-progspace))))
> + name-re print-info port))
> + (for-each (lambda (objfile)
> + (if (re-match? locus-re (objfile-filename objfile))
> + (do-locus objfile-iterator objfile
> + (lambda ()
> + (format port "Objfile ~a:\n"
> + (objfile-filename objfile)))
> + name-re print-info port)))
> + (objfiles))
> + *unspecified*))
> +
> + (define (count-enabled! object name-re ignore count)
> + (if (get-enabled-func object)
> + (set-car! count (+ (car count) 1)))
> + (set-cdr! count (+ (cdr count) 1)))
> +
> + (define (count-all-enabled)
> + (let ((count (cons 0 0)))
> + (global-iterator #f #f count-enabled! #f count)
> + (progspace-iterator (current-progspace) #f count-enabled! #f count)
> + (for-each (lambda (objfile)
> + (objfile-iterator objfile #f count-enabled! #f count))
> + (objfiles))
> + count))
Really here we want a two-valued fold; oh well.
(define (count-all-enabled)
(define (add-count object count)
(match count
((enabled . total)
(cons (+ enabled (if (get-enabled object) 1 0))
(+ total 1)))))
(define (visit-locus folder locus count)
(folder locus add-count count))
(let* ((count (cons 0 0))
(count (visit-locus fold-objects/global #f count))
(count (visit-locus fold-objects/progspace (current-progspace) count)))
;; SRFI-1 fold has its arguments reversed, oddly.
(fold (lambda (objfile count)
(visit-locus fold-objects/objfile objfile count))
count
(objfiles))))
Why are there three iterators? Is it not sufficient to have the
iterator test whether the argument is #f, a progspace, or an objfile?
If that were the case this could simplify to:
(define (count-all-enabled)
(define (add-count object count)
(match count
((enabled . total)
(cons (+ enabled (if (get-enabled object) 1 0))
(+ total 1)))))
(fold (lambda (locus count)
(fold-objects locus add-count count))
(cons 0 0)
(cons #f (current-progspace) (objfiles))))
> + (define (pluralize word count)
> + (if (= count 1)
> + word
> + (string-append word "s")))
Hmmmm :) I guess since the set of names is restricted this is fine.
We might as well use the facilities of "format" though:
(format #f "Disable filter~p" 3) => "Disable filters"
> + (define (summarize-enabled port setting orig-count new-count)
> + (let* ((change (- (car new-count) (car orig-count)))
Using "match" instead of cdaddring allows you to give a name to these
ad-hoc fields.
> diff --git a/gdb/guile/lib/gdb/command/pretty-printer.scm b/gdb/guile/lib/gdb/command/pretty-printer.scm
> new file mode 100644
> index 0000000..dff333c
> --- /dev/null
> +++ b/gdb/guile/lib/gdb/command/pretty-printer.scm
> @@ -0,0 +1,65 @@
> +;; Pretty-printer commands.
> +;;
> +;; Copyright (C) 2015 Free Software Foundation, Inc.
> +;;
> +;; This file is part of GDB.
> +;;
> +;; 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
> +;; the Free Software Foundation; either version 3 of the License, or
> +;; (at your option) any later version.
> +;;
> +;; This program is distributed in the hope that it will be useful,
> +;; but WITHOUT ANY WARRANTY; without even the implied warranty of
> +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> +;; GNU General Public License for more details.
> +;;
> +;; You should have received a copy of the GNU General Public License
> +;; along with this program. If not, see <http://www.gnu.org/licenses/>.
> +
> +(define-module (gdb command pretty-printer)
> + #:use-module ((gdb) #:select (COMMAND_DATA
> + pretty-printers
> + objfile-pretty-printers
> + progspace-pretty-printers
> + pretty-printer-name
> + pretty-printer-enabled?
> + set-pretty-printer-enabled!))
> + #:use-module (gdb command-trio))
> +
> +(define (global-iterator locus name-re doer arg count)
> + (for-each (lambda (printer)
> + (doer printer name-re arg count))
> + (pretty-printers))
> + *unspecified*)
> +
> +(define (progspace-iterator pspace name-re doer arg count)
> + (for-each (lambda (printer)
> + (doer printer name-re arg count))
> + (progspace-pretty-printers pspace))
> + *unspecified*)
> +
> +(define (objfile-iterator objfile name-re doer arg count)
> + (for-each (lambda (printer)
> + (doer printer name-re arg count))
> + (objfile-pretty-printers objfile))
> + *unspecified*)
(use-modules ((srfi srfi-1) #:select (fold)))
(define (fold-pretty-printers locus proc seed)
(match locus
(#f ; Global.
(fold proc seed (pretty-printers)))
((? progspace?)
(fold proc seed (progspace-pretty-printers locus)))
((? objfile?)
(fold proc seed (objfile-pretty-printers locus)))))
> +
> +(define (get-name-func printer)
> + (pretty-printer-name printer))
> +
> +(define (get-enabled-func printer)
> + (pretty-printer-enabled? printer))
> +
> +(define (set-enabled-func printer flag)
> + (set-pretty-printer-enabled! printer flag))
I would just pass pretty-printer-name, etc as values to
register-guile-command-trio!.
> +
> +(define-public (%install-pretty-printer-commands!)
> + (register-guile-command-trio!
> + "pretty-printer" COMMAND_DATA
> + global-iterator progspace-iterator objfile-iterator
> + get-name-func get-enabled-func set-enabled-func
> + "List all registered Guile pretty-printers."
> + "Enable the specified Guile pretty-printers."
> + "Disable the specified Guile pretty-printers.")
> + *unspecified*)
> diff --git a/gdb/guile/lib/gdb/init-gdb.scm b/gdb/guile/lib/gdb/init-gdb.scm
I only got up to here, but figured this might be useful to you. Happy
hacking!
Andy