my-profiler.el

my-profiler.el

;;; my-profiler.el --- My Profiling Tools            -*- lexical-binding: t; -*-

;; Copyright (C) 2022 AKIYAMA Kouhei

;; Author: AKIYAMA Kouhei <misohena@gmail.com>
;; Keywords: 

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; 

;;; Code:

(defvar my-profiler-output-message-buffer nil)

(defvar my-profiler-buffer nil)
(defvar my-profiler-start nil)
(defvar my-profiler-last nil)

(defun my-profiler-make-buffer ()
  (setq my-profiler-buffer (get-buffer-create "*My Profiler Log*"))
  (with-current-buffer my-profiler-buffer
    (erase-buffer)))

(defun my-profiler-log (format-string &rest args)
  (cond
   (my-profiler-output-message-buffer
    (apply #'message format-string args))
   (my-profiler-buffer
    (with-current-buffer my-profiler-buffer
      (insert (apply #'format format-string args) "\n")))))

(defun my-profiler-start ()
  (interactive)
  (my-profiler-make-buffer)
  (setq my-profiler-last
        (setq my-profiler-start (current-time))))

(defun my-profiler-stop ()
  (interactive)
  (setq my-profiler-start nil))

(defun my-profiler-subtract-ms (a b)
  (* 1000.0 (float-time (time-subtract a b))))

(defun my-profiler-pass (msg)
  (when my-profiler-start
    (let ((curr (current-time)))
      (my-profiler-log "TM\t%10.3f\t+%10.3f\t%s"
                      (my-profiler-subtract-ms curr my-profiler-start)
                      (my-profiler-subtract-ms curr my-profiler-last)
                      msg)
      (setq my-profiler-last curr))))

(defvar my-profiler-function-depth 0)

(defun my-profiler-function-wrapper (original-fun &rest args)
  (let* ((my-profiler-function-depth (1+ my-profiler-function-depth))
         (space (make-string my-profiler-function-depth ? ))
         (start-time (my-profiler-pass
                      (format "          \tEnter%s%s" space original-fun)))
         (result (apply original-fun args))
         (end-time (current-time)))
    (my-profiler-pass
     (format "%10.3f\tLeave%s%s"
             (my-profiler-subtract-ms end-time start-time)
             space
             original-fun))
    result))

(defun my-profiler-function-short (original-fun &rest args)
  (let* ((my-profiler-function-depth (1+ my-profiler-function-depth))
         (space (make-string my-profiler-function-depth ? ))
         (start-time (current-time))
         (result (apply original-fun args))
         (end-time (current-time)))
    (my-profiler-pass
     (format "%10.3f\tEval %s%s"
             (my-profiler-subtract-ms end-time start-time)
             space
             original-fun))
    result))

(defun my-profiler-function-start (original-fun &rest args)
  (my-profiler-start)
  (apply #'my-profiler-function-wrapper original-fun args))

(defun my-profiler-function-stop (original-fun &rest args)
  (apply #'my-profiler-function-wrapper original-fun args)
  (my-profiler-stop))

(defun my-profiler-function-start-stop (original-fun &rest args)
  (my-profiler-start)
  (apply #'my-profiler-function-wrapper original-fun args)
  (my-profiler-stop))

(defvar my-profiler-instrumented-functions nil)

(defun my-profiler-instrument (target)
  (interactive "aInstrument function: ")
  (when (called-interactively-p 'interactive)
    (setq target (cons target
                       (intern
                        (completing-read
                         "Start/Stop: "
                         '("nil" "start" "stop" "start-stop") nil t)))))
  (let ((target-symbol
         (if (consp target) (car target) target))
        (wrapper
         (if (consp target)
             (pcase (cdr target)
               ('start #'my-profiler-function-start)
               ('stop #'my-profiler-function-stop)
               ('start-stop #'my-profiler-function-start-stop)
               ('short #'my-profiler-function-short)
               (_ #'my-profiler-function-wrapper))
           #'my-profiler-function-wrapper)))
    (my-profiler-uninstrument target-symbol)
    (advice-add target-symbol :around wrapper)
    (push target-symbol my-profiler-instrumented-functions)))

(defun my-profiler-uninstrument (target-symbol)
  (interactive "aUninstrument function: ")
  (setq my-profiler-instrumented-functions
        (remq target-symbol my-profiler-instrumented-functions))
  (advice-remove target-symbol #'my-profiler-function-start)
  (advice-remove target-symbol #'my-profiler-function-stop)
  (advice-remove target-symbol #'my-profiler-function-short)
  (advice-remove target-symbol #'my-profiler-function-wrapper))

(defun my-profiler-uninstrument-all ()
  (interactive)
  (dolist (target-symbol my-profiler-instrumented-functions)
    (advice-remove target-symbol #'my-profiler-function-start)
    (advice-remove target-symbol #'my-profiler-function-stop)
    (advice-remove target-symbol #'my-profiler-function-short)
    (advice-remove target-symbol #'my-profiler-function-wrapper))
  (setq my-profiler-instrumented-functions nil))

(defun my-profiler-instrument-all (targets)
  (my-profiler-uninstrument-all)
  (mapc #'my-profiler-instrument
        targets))


(provide 'my-profiler)
;;; my-profiler.el ends here