;;; -*- Mode:LISP; Base:10; Readtable:CL -*-

;;; dependencies: dj:jrm;custom

;;; Tools for benchmarking.

(defun measure-statistic (statistic-getter thunk statistics-receiver)
  (let ((temp (funcall statistic-getter)))
    (funcall thunk)
    (funcall statistics-receiver temp (funcall statistic-getter))))

(defstruct (tester (:conc-name "TESTER-")
		   (:constructor make-tester (init-control run-control init-test run-test report-test)))
  init-control
  run-control
  init-test
  run-test
  report-test)

(defun elapsed-time-tester (time-gatherer)
  (let ((control-time 0)
	(test-time 0))
    (labels (
	(run-timer (thunk receiver)
	  (measure-statistic
	    time-gatherer
	    thunk
	    receiver))
	(run-control (thunk)
	  (run-timer thunk #'(lambda (start end) (setq control-time (- end start)))))
	(run-test    (thunk)
	  (run-timer thunk #'(lambda (start end) (setq test-time    (- end start)))))
	(report (stream)
	  (format stream "~&Control took ~5,2F seconds.  Run took ~5,2F seconds."
		  (/ control-time 1000000.0)
		  (/ test-time    1000000.0))))
      (make-tester #'values
		   #'run-control
		   #'values
		   #'run-test
		   #'report))))

(defun make-total-time-tester (elapsed-time-tester #'time:microsecond-time))
(defun make-disk-time-tester  (elapsed-time-tester #'(lambda () (read-meter si:%disk-wait-time))))

(defun compare-tests (init-thunk control-thunk test-environment-setup test-thunk test-list iterations)
  (labels (
      (do-test (thunk)
	#'(lambda ()
	    (dotimes (count iterations)
	      (funcall thunk))))

      (initialize-testers (tester-init)
	(dolist (tester test-list)
	  (funcall (funcall tester-init tester))))

      (run-testers (tester-to-run tester-list thunk)
	(check-split-list tester-list
	  thunk
	  #'(lambda (tester more-testers)
	      (funcall (funcall tester-to-run tester)
		       #'(lambda ()
			   (run-testers tester-to-run more-testers thunk))))))

      (report ()
	(dolist (tester test-list)
	  (funcall (tester-report-test tester) terminal-io)))
      )
    (funcall init-thunk)

  ;;; First, run the control thunk to get a reasonable paging environment.
    (funcall (do-test control-thunk))

  ;;; Now, actually test it.
    (initialize-testers #'tester-init-control)
    (run-testers #'tester-run-control test-list (do-test control-thunk))
    (funcall test-environment-setup
      #'(lambda ()
	  (funcall init-thunk)
	  ;; Again, one go through to minimize effects of paging.
	  (funcall (do-test test-thunk))
	  ;; The actual test
	  (initialize-testers #'tester-init-test)
	  (run-testers #'tester-run-test test-list (do-test test-thunk))))
    (report)))

(defun thunkify-application (function arglist)
  #'(lambda () (apply function arglist)))