(in-package #:profiler)

(defvar *profile-data* (make-hash-table))
(defvar *profile-funcs* (make-hash-table))

(defun profile (func)
 (let ((new-func (profiled-call func)))
  (unless (gethash func *profile-funcs*)
    (setf (gethash func *profile-funcs*) (symbol-function func)
          (symbol-function func) new-func
          (gethash func *profile-data*) (list 0 0)))))

(defun unprofile (func)
 (when (gethash func *profile-funcs*)
  (setf (symbol-function func) (gethash func *profile-funcs*))
  (remhash func *profile-funcs*)
  (remhash func *profile-data*)))

(defun clear ()
 (loop for fn being the hash-keys in *profile-data* 
  do (unprofile fn)))

(defun reset ()
 (loop for fn being the hash-keys in *profile-data*
  do (setf (gethash fn *profile-data*) (list 0 0))))

(defun profile-package (&optional (package *package*))
 (loop for sym being the present-symbols in package
  when (fboundp sym)
  do (profile sym)))

(defun show (&optional (how-many 10))
 (let ((results-list ()))
  (format t "Profiler data showing ~A~%" how-many)
  (loop for fn being the hash-keys in *profile-data* using (hash-value val)
   do (push (list fn val) results-list))
  (loop for (func (time calls)) in (sort results-list #'(lambda (l r) (> (first (second l)) (first (second r)))))
        for count upto how-many
   do (let ((secs (float (/ time internal-time-units-per-second))))
               (format t "~35A: ~,3F ~T~4A ~4A~%" func secs calls (if (= 0 secs) nil (/ calls secs)))))))

#|
(show)
(profile-package)
(profile-clear)
(profile 'test)
(profile 'test2)
(test "hi")
|#

(defun profiled-call (func)
 (let ((actual-func (symbol-function func)))
  (lambda (&rest args)
   (let ((start (get-internal-run-time))
         (time 0)
         (entry nil)
         (result nil))
    (setf result (apply actual-func args)
          time (- (get-internal-run-time) start)
          entry (gethash func *profile-data*))
    (incf (first entry) time)
    (incf (second entry))
    result))))