;;; 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.
;;; 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.")
;; 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)
(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.
(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.
(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)
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)
(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)
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)))
;;;; 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.
(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)
;; 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))
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."
;; 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)
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 ()
;; 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:
("or" &rest pcase-PAT)
("and" &rest pcase-PAT)
("guard" form)
- ("let" pcase-PAT form)
("pred" pcase-FUN)
("app" pcase-FUN pcase-PAT)
pcase-MACRO
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)
(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,
(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
projects / emacs.git / commitdiff