master 1d2487b 1/2: * lisp/emacs-lisp/edebug.el: Misc cleanups.

[Stefan Monnier]

branch: master
commit 1d2487b1fc5f0648deb80507be8c713d4482fd8d
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * lisp/emacs-lisp/edebug.el: Misc cleanups.
    
    Move all definitions under the `edebug-` prefix.
    
    (edebug-get-spec): Rename from `get-edebug-spec`.
    (edebug-move-cursor): Use `cl-callf`.
    (edebug-spec-p): Remove unused function.
    (def-edebug-spec, edebug-spec-list, edebug-spec): Remove unused specs
    (nothing in there gets instrumented anyway).
    (edebug-tracing): Use `declare`.
    (edebug-cancel-on-entry): Rename from `cancel-edebug-on-entry`.
    (edebug-global-prefix): Rename from `global-edebug-prefix`.
    (edebug-global-map): Rename from `global-edebug-map`.
    
    * lisp/emacs-lisp/pcase.el (pcase-PAT): Remove `let`.
    (let): Use `declare` instead.
    (pcase--edebug-match-macro): Use new name `edebug-get-spec`.
---
 etc/NEWS                  |   3 ++
 lisp/emacs-lisp/edebug.el | 101 ++++++++++++++++++++++------------------------
 lisp/emacs-lisp/pcase.el  |  30 +++++++-------
 3 files changed, 65 insertions(+), 69 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 9a9c75f..228b773 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -935,6 +935,9 @@ To customize obsolete user options, use 'customize-option' 
or
 
 ** Edebug
 
+---
+*** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'.
+
 +++
 *** Edebug specification lists can use the new keyword '&error', which
 unconditionally aborts the current edebug instrumentation with the
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 0733dce..04a4829 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -244,19 +244,22 @@ If the result is non-nil, then break.  Errors are 
ignored."
 
 ;;; Form spec utilities.
 
-(defun get-edebug-spec (symbol)
+(defun edebug-get-spec (symbol)
+  "Return the Edebug spec of a given Lisp expression's head SYMBOL.
+The argument is usually a symbol, but it doesn't have to be."
   ;; Get the spec of symbol resolving all indirection.
   (let ((spec nil)
        (indirect symbol))
     (while
-        (progn
-          (and (symbolp indirect)
-               (setq indirect
-                     (function-get indirect 'edebug-form-spec 'macro))))
+        (and (symbolp indirect)
+             (setq indirect
+                   (function-get indirect 'edebug-form-spec 'macro)))
       ;; (edebug-trace "indirection: %s" edebug-form-spec)
       (setq spec indirect))
     spec))
 
+(define-obsolete-function-alias 'get-edebug-spec #'edebug-get-spec "28.1")
+
 ;;;###autoload
 (defun edebug-basic-spec (spec)
   "Return t if SPEC uses only extant spec symbols.
@@ -961,6 +964,18 @@ circular objects.  Let `read' read everything else."
 
 ;;; Cursors for traversal of list and vector elements with offsets.
 
+;; Edebug's instrumentation is based on parsing the sexps, which come with
+;; auxiliary position information.  Instead of keeping the position
+;; information together with the sexps, it is kept in a "parallel
+;; tree" of offsets.
+;;
+;; An "edebug cursor" is a pair of a *list of sexps* (called the
+;; "expressions") together with a matching list of offsets.
+;; When we're parsing the content of a list, the
+;; `edebug-cursor-expressions' is simply the list but when parsing
+;; a vector, the `edebug-cursor-expressions' is a list formed of the
+;; elements of the vector.
+
 (defvar edebug-dotted-spec nil
   "Set to t when matching after the dot in a dotted spec list.")
 
@@ -1015,8 +1030,8 @@ circular objects.  Let `read' read everything else."
   ;; The following test should always fail.
   (if (edebug-empty-cursor cursor)
       (edebug-no-match cursor "Not enough arguments."))
-  (setcar cursor (cdr (car cursor)))
-  (setcdr cursor (cdr (cdr cursor)))
+  (cl-callf cdr (car cursor))
+  (cl-callf cdr (cdr cursor))
   cursor)
 
 
@@ -1153,7 +1168,7 @@ purpose by adding an entry to this alist, and setting
               (eq 'symbol (progn (forward-char 1) (edebug-next-token-class))))
          ;; Find out if this is a defining form from first symbol
          (setq def-kind (read (current-buffer))
-               spec (and (symbolp def-kind) (get-edebug-spec def-kind))
+               spec (and (symbolp def-kind) (edebug-get-spec def-kind))
                defining-form-p (and (listp spec)
                                     (eq '&define (car spec)))
                ;; This is incorrect in general!! But OK most of the time.
@@ -1502,7 +1517,7 @@ contains a circular object."
          (if (eq 'quote (car form))
              form
            (let* ((head (car form))
-                  (spec (and (symbolp head) (get-edebug-spec head)))
+                  (spec (and (symbolp head) (edebug-get-spec head)))
                   (new-cursor (edebug-new-cursor form offset)))
              ;; Find out if this is a defining form from first symbol.
              ;; An indirect spec would not work here, yet.
@@ -1542,7 +1557,7 @@ contains a circular object."
 (defsubst edebug-list-form-args (head cursor)
   ;; Process the arguments of a list form given that head of form is a symbol.
   ;; Helper for edebug-list-form
-  (let ((spec (get-edebug-spec head)))
+  (let ((spec (edebug-get-spec head)))
     (cond
      ;; Treat cl-macrolet bindings like macros with no spec.
      ((member head edebug--cl-macrolet-defs)
@@ -1645,7 +1660,7 @@ contains a circular object."
        edebug-error-point
        (edebug-gate edebug-gate)  ;; locally bound to limit effect
        )
-    (edebug-match-specs cursor specs 'edebug-match-specs)))
+    (edebug-match-specs cursor specs #'edebug-match-specs)))
 
 
 (defun edebug-match-one-spec (cursor spec)
@@ -1741,11 +1756,16 @@ contains a circular object."
                (gate . edebug-match-gate)
                ;;   (nil . edebug-match-nil)  not this one - special case it.
                ))
+  ;; FIXME: We abuse `edebug-form-spec' here.  It's normally used to store the
+  ;; specs for a given sexp's head, but here we use it to keep the
+  ;; function implementing of a given "core spec".
   (put (car pair) 'edebug-form-spec (cdr pair)))
 
 (defun edebug-match-symbol (cursor symbol)
   ;; Match a symbol spec.
-  (let* ((spec (get-edebug-spec symbol)))
+  ;; FIXME: We abuse `edebug-get-spec' here, passing it a *spec* rather than
+  ;; the head element of a source sexp.
+  (let* ((spec (edebug-get-spec symbol)))
     (cond
      (spec
       (if (consp spec)
@@ -2000,7 +2020,7 @@ contains a circular object."
                cursor "Expected lambda expression"))
         (offset (edebug-top-offset cursor))
         (head (and (consp sexp) (car sexp)))
-        (spec (and (symbolp head) (get-edebug-spec head)))
+        (spec (and (symbolp head) (edebug-get-spec head)))
         (edebug-inside-func nil))
     ;; Find out if this is a defining form from first symbol.
     (if (and (consp spec) (eq '&define (car spec)))
@@ -2145,37 +2165,6 @@ into `edebug--cl-macrolet-defs' which is checked in 
`edebug-list-form-args'."
 ;;;; Edebug Form Specs
 ;;; ==========================================================
 
-;;;;* Spec for def-edebug-spec
-;;; Out of date.
-
-(defun edebug-spec-p (object)
-  "Return non-nil if OBJECT is a symbol with an edebug-form-spec property."
-  (and (symbolp object)
-       (get object 'edebug-form-spec)))
-
-(def-edebug-spec def-edebug-spec
-  ;; Top level is different from lower levels.
-  (&define :name edebug-spec name
-          &or "nil" edebug-spec-p "t" "0" (&rest edebug-spec)))
-
-(def-edebug-spec edebug-spec-list
-  ;; A list must have something in it, or it is nil, a symbolp
-  ((edebug-spec . [&or nil edebug-spec])))
-
-(def-edebug-spec edebug-spec
-  (&or
-   edebug-spec-list
-   (vector &rest edebug-spec)          ; matches a vector
-   ("vector" &rest edebug-spec)                ; matches a vector spec
-   ("quote" symbolp)
-   stringp
-   [edebug-lambda-list-keywordp &rest edebug-spec]
-   [keywordp gate edebug-spec]
-   edebug-spec-p  ;; Including all the special ones e.g. form.
-   symbolp;; a predicate
-   ))
-
-
 ;;;* Emacs special forms and some functions.
 
 ;; quote expects only one argument, although it allows any number.
@@ -2485,11 +2474,10 @@ STATUS should be a list returned by 
`edebug-var-status'."
       (edebug-print-trace-after
        (format "%s result: %s" function edebug-result)))))
 
-(def-edebug-spec edebug-tracing (form body))
-
 (defmacro edebug-tracing (msg &rest body)
   "Print MSG in *edebug-trace* before and after evaluating BODY.
 The result of BODY is also printed."
+  (declare (debug (form body)))
   `(let ((edebug-stack-depth (1+ edebug-stack-depth))
         edebug-result)
      (edebug-print-trace-before ,msg)
@@ -3601,7 +3589,10 @@ canceled the first time the function is entered."
   ;; Could store this in the edebug data instead.
   (put function 'edebug-on-entry (if flag 'temp t)))
 
-(defalias 'edebug-cancel-edebug-on-entry #'cancel-edebug-on-entry)
+(define-obsolete-function-alias 'edebug-cancel-edebug-on-entry
+  #'edebug-cancel-on-entry "28.1")
+(define-obsolete-function-alias 'cancel-edebug-on-entry
+  #'edebug-cancel-on-entry "28.1")
 
 (defun edebug--edebug-on-entry-functions ()
   (let ((functions nil))
@@ -3613,7 +3604,7 @@ canceled the first time the function is entered."
      obarray)
     functions))
 
-(defun cancel-edebug-on-entry (function)
+(defun edebug-cancel-on-entry (function)
   "Cause Edebug to not stop when FUNCTION is called.
 The removes the effect of `edebug-on-entry'.  If FUNCTION is is
 nil, remove `edebug-on-entry' on all functions."
@@ -3937,10 +3928,14 @@ be installed in `emacs-lisp-mode-map'.")
 ;; Autoloading these global bindings doesn't make sense because
 ;; they cannot be used anyway unless Edebug is already loaded and active.
 
-(defvar global-edebug-prefix "\^XX"
+(define-obsolete-variable-alias 'global-edebug-prefix
+  'edebug-global-prefix "28.1")
+(defvar edebug-global-prefix "\^XX"
   "Prefix key for global edebug commands, available from any buffer.")
 
-(defvar global-edebug-map
+(define-obsolete-variable-alias 'global-edebug-map
+  'edebug-global-map "28.1")
+(defvar edebug-global-map
   (let ((map (make-sparse-keymap)))
 
     (define-key map " " 'edebug-step-mode)
@@ -3973,9 +3968,9 @@ be installed in `emacs-lisp-mode-map'.")
     map)
   "Global map of edebug commands, available from any buffer.")
 
-(when global-edebug-prefix
-  (global-unset-key global-edebug-prefix)
-  (global-set-key global-edebug-prefix global-edebug-map))
+(when edebug-global-prefix
+  (global-unset-key edebug-global-prefix)
+  (global-set-key edebug-global-prefix edebug-global-map))
 
 
 (defun edebug-help ()
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index ec746fa..7a88bdf 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -27,19 +27,10 @@
 
 ;; Todo:
 
-;; - (pcase e (`(,x . ,x) foo)) signals an "x unused" warning if `foo' doesn't
-;;   use x, because x is bound separately for the equality constraint
-;;   (as well as any pred/guard) and for the body, so uses at one place don't
-;;   count for the other.
-;; - provide ways to extend the set of primitives, with some kind of
-;;   define-pcase-matcher.  We could easily make it so that (guard BOOLEXP)
-;;   could be defined this way, as a shorthand for (pred (lambda (_) BOOLEXP)).
-;;   But better would be if we could define new ways to match by having the
-;;   extension provide its own `pcase--split-<foo>' thingy.
-;; - along these lines, provide patterns to match CL structs.
+;; - Allow to provide new `pcase--split-<foo>' thingy.
 ;; - provide something like (setq VAR) so a var can be set rather than
 ;;   let-bound.
-;; - provide a way to fallthrough to subsequent cases
+;; - provide a way to continue matching to subsequent cases
 ;;   (e.g. Like Racket's (=> ID).
 ;; - try and be more clever to reduce the size of the decision tree, and
 ;;   to reduce the number of leaves that need to be turned into functions:
@@ -77,7 +68,6 @@
        ("or" &rest pcase-PAT)
        ("and" &rest pcase-PAT)
        ("guard" form)
-       ("let" pcase-PAT form)
        ("pred" pcase-FUN)
        ("app" pcase-FUN pcase-PAT)
        pcase-MACRO
@@ -91,10 +81,10 @@
        sexp))
 
 ;; See bug#24717
-(put 'pcase-MACRO 'edebug-form-spec 'pcase--edebug-match-macro)
+(put 'pcase-MACRO 'edebug-form-spec #'pcase--edebug-match-macro)
 
 ;; Only called from edebug.
-(declare-function get-edebug-spec "edebug" (symbol))
+(declare-function edebug-get-spec "edebug" (symbol))
 (declare-function edebug-match "edebug" (cursor specs))
 
 (defun pcase--get-macroexpander (s)
@@ -106,13 +96,15 @@
     (mapatoms
      (lambda (s)
        (let ((m (pcase--get-macroexpander s)))
-        (when (and m (get-edebug-spec m))
-          (push (cons (symbol-name s) (get-edebug-spec m))
+        (when (and m (edebug-get-spec m))
+          (push (cons (symbol-name s) (edebug-get-spec m))
                 specs)))))
     (edebug-match cursor (cons '&or specs))))
 
 ;;;###autoload
 (defmacro pcase (exp &rest cases)
+  ;; FIXME: Add some "global pattern" to wrap every case?
+  ;; Could be used to wrap all cases in a `
   "Evaluate EXP to get EXPVAL; try passing control to one of CASES.
 CASES is a list of elements of the form (PATTERN CODE...).
 For the first CASE whose PATTERN \"matches\" EXPVAL,
@@ -1002,7 +994,13 @@ The predicate is the logical-AND of:
 
 (pcase-defmacro let (pat expr)
   "Matches if EXPR matches PAT."
+  (declare (debug (pcase-PAT form)))
   `(app (lambda (_) ,expr) ,pat))
 
+;; (pcase-defmacro guard (expr)
+;;   "Matches if EXPR is non-nil."
+;;   (declare (debug (form)))
+;;   `(pred (lambda (_) ,expr)))
+
 (provide 'pcase)
 ;;; pcase.el ends here