Re: [RFC] Guile info/enable/disable command trio support

[Andy Wingo <wingo at igalia dot com>]

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