comparison lisp/emacs-lisp/elp.el @ 41177:830a17080380

(elp-not-profilable): New var. (elp-not-profilable-p): New function. (elp-instrument-function): Use it. Use backquotes and push.

41176:2d63191afacd

  "Controls whether functions should record times or not.
This variable is set by the master function.")

(defvar elp-master nil
  "Master function symbol.")


;;;###autoload
(defun elp-instrument-function (funsym)
  "Instrument FUNSYM for profiling.

  ;; definition.
  (elp-restore-function funsym)
  (let* ((funguts (symbol-function funsym))
	 (infovec (vector 0 0 funguts))
	 (newguts '(lambda (&rest args))))
    ;; we cannot profile macros
    (and (eq (car-safe funguts) 'macro)
	 (error "ELP cannot profile macro: %s" funsym))
    ;; TBD: at some point it might be better to load the autoloaded
    ;; function instead of throwing an error.  if we do this, then we

    (and (eq (car-safe funguts) 'autoload)
	 (error "ELP cannot profile autoloaded function: %s" funsym))
    ;; put rest of newguts together
    (if (commandp funsym)
	(setq newguts (append newguts '((interactive)))))
    (setq newguts (append newguts (list
				   (list 'elp-wrapper
					 (list 'quote funsym)
					 (list 'and
					       '(interactive-p)
					       (not (not (commandp funsym))))
					 'args))))
    ;; to record profiling times, we set the symbol's function
    ;; definition so that it runs the elp-wrapper function with the
    ;; function symbol as an argument.  We place the old function
    ;; definition on the info vector.
    ;;

	    (fset funsym newguts)
	    (put funsym 'ad-advice-info advice-info))
	(fset funsym newguts)))

    ;; add this function to the instrumentation list
    (or (memq funsym elp-all-instrumented-list)
	(setq elp-all-instrumented-list
	      (cons funsym elp-all-instrumented-list)))))

(defun elp-restore-function (funsym)
  "Restore an instrumented function to its original definition.
Argument FUNSYM is the symbol of a defined function."
  (interactive "aFunction to restore: ")

  (elp-instrument-list
   (mapcar
    'intern
    (all-completions
     prefix obarray
     (function
      (lambda (sym)
	(and (fboundp sym)
	     (not (memq (car-safe (symbol-function sym)) '(autoload macro))))
	))
     ))))

(defun elp-restore-list (&optional list)
  "Restore the original definitions for all functions in `elp-function-list'.
Use optional LIST if provided instead."
  (interactive "PList of functions to restore: ")

41177:830a17080380

  "Controls whether functions should record times or not.
This variable is set by the master function.")

(defvar elp-master nil
  "Master function symbol.")

(defvar elp-not-profilable
  '(elp-wrapper elp-elapsed-time error call-interactively apply current-time interactive-p)
  "List of functions that cannot be profiled.
Those functions are used internally by the profiling code and profiling
them would thus lead to infinite recursion.")

(defun elp-not-profilable-p (fun)
  (or (memq fun elp-not-profilable)
      (keymapp fun)
      (condition-case nil
	  (when (subrp (symbol-function fun))
	    (eq 'unevalled (cdr (subr-arity (symbol-function fun)))))
	(error nil))))


;;;###autoload
(defun elp-instrument-function (funsym)
  "Instrument FUNSYM for profiling.

  ;; definition.
  (elp-restore-function funsym)
  (let* ((funguts (symbol-function funsym))
	 (infovec (vector 0 0 funguts))
	 (newguts '(lambda (&rest args))))
    ;; We cannot profile functions used internally during profiling.
    (when (elp-not-profilable-p funsym)
      (error "ELP cannot profile the function: %s" funsym))
    ;; we cannot profile macros
    (and (eq (car-safe funguts) 'macro)
	 (error "ELP cannot profile macro: %s" funsym))
    ;; TBD: at some point it might be better to load the autoloaded
    ;; function instead of throwing an error.  if we do this, then we

    (and (eq (car-safe funguts) 'autoload)
	 (error "ELP cannot profile autoloaded function: %s" funsym))
    ;; put rest of newguts together
    (if (commandp funsym)
	(setq newguts (append newguts '((interactive)))))
    (setq newguts (append newguts `((elp-wrapper
				     (quote ,funsym)
				     ,(when (commandp funsym)
					'(interactive-p))
				     args))))
    ;; to record profiling times, we set the symbol's function
    ;; definition so that it runs the elp-wrapper function with the
    ;; function symbol as an argument.  We place the old function
    ;; definition on the info vector.
    ;;

	    (fset funsym newguts)
	    (put funsym 'ad-advice-info advice-info))
	(fset funsym newguts)))

    ;; add this function to the instrumentation list
    (unless (memq funsym elp-all-instrumented-list)
      (push funsym elp-all-instrumented-list))))

(defun elp-restore-function (funsym)
  "Restore an instrumented function to its original definition.
Argument FUNSYM is the symbol of a defined function."
  (interactive "aFunction to restore: ")

  (elp-instrument-list
   (mapcar
    'intern
    (all-completions
     prefix obarray
     (lambda (sym)
       (and (fboundp sym)
	    (not (or (memq (car-safe (symbol-function sym)) '(autoload macro))
		     (elp-not-profilable-p sym)))))))))

(defun elp-restore-list (&optional list)
  "Restore the original definitions for all functions in `elp-function-list'.
Use optional LIST if provided instead."
  (interactive "PList of functions to restore: ")