>From c0e8293a9b4919b22e3d409acddc9bde49021bc8 Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sat, 16 Sep 2017 14:23:35 -0700 Subject: [PATCH 1/2] 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. (edebug-default-enter): New name for edebug-enter. (edebug-enter): New function which changes behavior of Edebug based on symbol property 'edebug-behavior and edebug-behavior-alist. (edebug-run-slow, edebug-run-fast): Modify edebug-behavior-alist. --- lisp/emacs-lisp/edebug.el | 154 ++++++++++++++++++++++++++++++---------------- 1 file changed, 100 insertions(+), 54 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index dbc56e272f..ca1f55cb6a 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1065,6 +1065,29 @@ edebug-old-def-name (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 +1147,48 @@ edebug-read-and-maybe-wrap-form1 (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)))))) - - ;; 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))) - )) - + (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))) + + ;; 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? @@ -1330,10 +1354,7 @@ edebug-make-form-wrapper form-data-entry edebug-def-name ;; in case name is changed form-begin form-end)) - ;; (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. (setq edebug-offset-list (vconcat (nreverse edebug-offset-list))) @@ -1358,9 +1379,15 @@ edebug-make-form-wrapper 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 +2194,21 @@ edebug-signal ;;; 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 +2239,7 @@ edebug-enter 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 +2358,27 @@ edebug-slow-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))) -- 2.14.1