Allow Edebug's instrumentation to be used for other purposes

* lisp/emacs-lisp/edebug.el:
(edebug-after-instrumentation-functions)
(edebug-new-definition-functions): New hook variables.
(edebug-behavior-alist): New variable.
(edebug-read-and-maybe-wrap-form): Run a hook after a form is
wrapped.
(edebug-make-form-wrapper): Run a hook after a definition is
wrapped. Remove message for each definition.
(edebug-announce-definition): New function.
(edebug-enter): Rewritten to change behavior of Edebug based
on symbol property `edebug-behavior' and `edebug-behavior-alist'.
(edebug-default-enter): New function which does what `edebug-enter'
used to do.
(edebug-run-slow, edebug-run-fast): Modify edebug-behavior-alist.
(edebug-before, edebug-after): Function definitions are now set by
`edebug-enter'.
This commit is contained in:
Gemini Lasswell 2017-10-01 09:12:29 -07:00
parent 85b4e88194
commit 06e452a572
3 changed files with 142 additions and 48 deletions

View file

@ -1690,3 +1690,38 @@ Whether or not to pause for @code{edebug-sit-for-seconds} on reaching
a breakpoint. Set to @code{nil} to prevent the pause, non-@code{nil}
to allow it.
@end defopt
@defopt edebug-behavior-alist
By default, this alist contains one entry with the key @code{edebug}
and a list of three functions, which are the default implementations
of the functions inserted in instrumented code: @code{edebug-enter},
@code{edebug-before} and @code{edebug-after}. To change Edebug's
behavior globally, modify the default entry.
Edebug's behavior may also be changed on a per-definition basis by
adding an entry to this alist, with a key of your choice and three
functions. Then set the @code{edebug-behavior} symbol property of an
instrumented definition to the key of the new entry, and Edebug will
call the new functions in place of its own for that definition.
@end defopt
@defopt edebug-new-definition-functions
An abnormal hook run by Edebug after it wraps the body of a definition
or closure. After Edebug has initialized its own data, each function
is called with one argument, the symbol associated with the
definition, which may be the actual symbol defined or one generated by
Edebug. This hook may be used to set the @code{edebug-behavior}
symbol property of each definition instrumented by Edebug.
By default @code{edebug-new-definition-functions} contains
@code{edebug-announce-definition} which prints a message each time a
definition is instrumented. If you are instrumenting a lot of code
and find the messages excessive, remove
@code{edebug-announce-definition}.
@end defopt
@defopt edebug-after-instrumentation-functions
An abnormal hook run by Edebug after it instruments a form.
Each function is called with one argument, a form which has
just been instrumented by Edebug.
@end defopt

View file

@ -56,6 +56,15 @@ replaced by a double typographic quote.
* Changes in Specialized Modes and Packages in Emacs 27.1
** Edebug
+++
*** The runtime behavior of Edebug's instrumentation can be changed
using the new variable 'edebug-behavior-alist' and the new abnormal
hooks 'edebug-after-instrumentation-functions' and
'edebug-new-definition-functions'. Edebug's behavior can be changed
globally or for individual definitions.
** Enhanced xterm support
*** New variable 'xterm-set-window-title' controls whether Emacs

View file

@ -1065,6 +1065,31 @@ circular objects. Let `read' read everything else."
(defvar edebug-error-point nil)
(defvar edebug-best-error nil)
;; Hooks which may be used to extend Edebug's functionality. See
;; Testcover for an example.
(defvar edebug-after-instrumentation-functions nil
"Abnormal hook run on code after instrumentation for debugging.
Each function is called with one argument, a form which has just
been instrumented for Edebugging.")
(defvar edebug-new-definition-functions '(edebug-announce-definition)
"Abnormal hook run after Edebug wraps a new definition.
After Edebug has initialized its own data, each hook function is
called with one argument, the symbol associated with the
definition, which may be the actual symbol defined or one
generated by Edebug.")
(defvar edebug-behavior-alist
'((edebug edebug-default-enter edebug-slow-before edebug-slow-after))
"Alist describing the runtime behavior of Edebug's instrumented code.
Each definition instrumented by Edebug will have a
`edebug-behavior' property which is a key to this alist. When
the instrumented code is running, Edebug will look here for the
implementations of `edebug-enter', `edebug-before', and
`edebug-after'. Edebug's instrumentation may be used for a new
purpose by adding an entry to this alist and a hook to
`edebug-new-definition-functions' which sets `edebug-behavior'
for the definition.")
(defun edebug-read-and-maybe-wrap-form ()
;; Read a form and wrap it with edebug calls, if the conditions are right.
@ -1124,47 +1149,48 @@ circular objects. Let `read' read everything else."
(eq 'symbol (edebug-next-token-class)))
(read (current-buffer))))))
;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms)
(cond
(defining-form-p
(if (or edebug-all-defs edebug-all-forms)
;; If it is a defining form and we are edebugging defs,
;; then let edebug-list-form start it.
(let ((cursor (edebug-new-cursor
(list (edebug-read-storing-offsets (current-buffer)))
(list edebug-offsets))))
(car
(edebug-make-form-wrapper
cursor
(edebug-before-offset cursor)
(1- (edebug-after-offset cursor))
(list (cons (symbol-name def-kind) (cdr spec))))))
(let ((result
(cond
(defining-form-p
(if (or edebug-all-defs edebug-all-forms)
;; If it is a defining form and we are edebugging defs,
;; then let edebug-list-form start it.
(let ((cursor (edebug-new-cursor
(list (edebug-read-storing-offsets (current-buffer)))
(list edebug-offsets))))
(car
(edebug-make-form-wrapper
cursor
(edebug-before-offset cursor)
(1- (edebug-after-offset cursor))
(list (cons (symbol-name def-kind) (cdr spec))))))
;; Not edebugging this form, so reset the symbol's edebug
;; property to be just a marker at the definition's source code.
;; This only works for defs with simple names.
(put def-name 'edebug (point-marker))
;; Also nil out dependent defs.
'(mapcar (function
(lambda (def)
(put def-name 'edebug nil)))
(get def-name 'edebug-dependents))
(edebug-read-sexp)))
;; Not edebugging this form, so reset the symbol's edebug
;; property to be just a marker at the definition's source code.
;; This only works for defs with simple names.
(put def-name 'edebug (point-marker))
;; Also nil out dependent defs.
'(mapcar (function
(lambda (def)
(put def-name 'edebug nil)))
(get def-name 'edebug-dependents))
(edebug-read-sexp)))
;; If all forms are being edebugged, explicitly wrap it.
(edebug-all-forms
(let ((cursor (edebug-new-cursor
(list (edebug-read-storing-offsets (current-buffer)))
(list edebug-offsets))))
(edebug-make-form-wrapper
cursor
(edebug-before-offset cursor)
(edebug-after-offset cursor)
nil)))
;; Not a defining form, and not edebugging.
(t (edebug-read-sexp)))
))
;; If all forms are being edebugged, explicitly wrap it.
(edebug-all-forms
(let ((cursor (edebug-new-cursor
(list (edebug-read-storing-offsets (current-buffer)))
(list edebug-offsets))))
(edebug-make-form-wrapper
cursor
(edebug-before-offset cursor)
(edebug-after-offset cursor)
nil)))
;; Not a defining form, and not edebugging.
(t (edebug-read-sexp)))))
(run-hook-with-args 'edebug-after-instrumentation-functions result)
result)))
(defvar edebug-def-args) ; args of defining form.
(defvar edebug-def-interactive) ; is it an emacs interactive function?
@ -1332,7 +1358,6 @@ expressions; a `progn' form will be returned enclosing these forms."
;; (message "defining: %s" edebug-def-name) (sit-for 2)
(edebug-make-top-form-data-entry form-data-entry)
(message "Edebug: %s" edebug-def-name)
;;(debug edebug-def-name)
;; Destructively reverse edebug-offset-list and make vector from it.
@ -1358,9 +1383,15 @@ expressions; a `progn' form will be returned enclosing these forms."
edebug-offset-list
edebug-top-window-data
))
(put edebug-def-name 'edebug-behavior 'edebug)
(run-hook-with-args 'edebug-new-definition-functions edebug-def-name)
result
)))
(defun edebug-announce-definition (def-name)
"Announce Edebug's processing of DEF-NAME."
(message "Edebug: %s" def-name))
(defun edebug-clear-frequency-count (name)
;; Create initial frequency count vector.
@ -2167,7 +2198,21 @@ error is signaled again."
;;; Entering Edebug
(defun edebug-enter (function args body)
(defun edebug-enter (func args body)
"Enter Edebug for a function.
FUNC should be the symbol with the Edebug information, ARGS is
the list of arguments and BODY is the code.
Look up the `edebug-behavior' for FUNC in `edebug-behavior-alist'
and run its entry function, and set up `edebug-before' and
`edebug-after'."
(cl-letf* ((behavior (get func 'edebug-behavior))
(functions (cdr (assoc behavior edebug-behavior-alist)))
((symbol-function #'edebug-before) (nth 1 functions))
((symbol-function #'edebug-after) (nth 2 functions)))
(funcall (nth 0 functions) func args body)))
(defun edebug-default-enter (function args body)
;; Entering FUNC. The arguments are ARGS, and the body is BODY.
;; Setup edebug variables and evaluate BODY. This function is called
;; when a function evaluated with edebug-eval-top-level-form is entered.
@ -2198,7 +2243,7 @@ error is signaled again."
edebug-initial-mode
edebug-execution-mode)
edebug-next-execution-mode nil)
(edebug-enter function args body))))
(edebug-default-enter function args body))))
(let* ((edebug-data (get function 'edebug))
(edebug-def-mark (car edebug-data)) ; mark at def start
@ -2317,22 +2362,27 @@ MSG is printed after `::::} '."
value
(edebug-debugger after-index 'after value)
)))
(defun edebug-fast-after (_before-index _after-index value)
;; Do nothing but return the value.
value)
(defun edebug-run-slow ()
(defalias 'edebug-before 'edebug-slow-before)
(defalias 'edebug-after 'edebug-slow-after))
"Set up Edebug's normal behavior."
(setf (cdr (assq 'edebug edebug-behavior-alist))
'(edebug-default-enter edebug-slow-before edebug-slow-after)))
;; This is not used, yet.
(defun edebug-run-fast ()
(defalias 'edebug-before 'edebug-fast-before)
(defalias 'edebug-after 'edebug-fast-after))
(edebug-run-slow)
"Disable Edebug without de-instrumenting code."
(setf (cdr (assq 'edebug edebug-behavior-alist))
'(edebug-default-enter edebug-fast-before edebug-fast-after)))
(defalias 'edebug-before nil
"Function called by Edebug before a form is evaluated.
See `edebug-behavior-alist' for implementations.")
(defalias 'edebug-after nil
"Function called by Edebug after a form is evaluated.
See `edebug-behavior-alist' for implementations.")
(defun edebug--update-coverage (after-index value)
(let ((old-result (aref edebug-coverage after-index)))