From: Stefan Monnier Date: Fri, 12 Feb 2021 16:12:49 +0000 (-0500) Subject: * lisp/emacs-lisp/edebug.el: Misc cleanups. X-Git-Tag: emacs-28.0.90~3794 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=1d2487b1fc5f0648deb80507be8c713d4482fd8d;p=emacs.git * 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`. --- diff --git a/etc/NEWS b/etc/NEWS index 9a9c75f0f8c..228b773cb27 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 0733dcec27b..04a4829c5e6 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 ec746fa4747..7a88bdf8de5 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-' thingy. -;; - along these lines, provide patterns to match CL structs. +;; - Allow to provide new `pcase--split-' 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