(in-package "CL-USER")

;; code to test speed of short-listed entries

(defparameter *contestants*
  '(
    ;; keyword   filename             symbol-name     package
    (:edi        "edi-weitz"          test-edi        :puzzle)
    (:gabor      "gabor-melis"        solve-and-print :last-piece)
    (:michael    "michael-naunton"    solve)
    (:nils       "nils-goesche"       solve           :puzzle)
    (:pierpaolo  "pierpaolo-bernardi" fa              :contest)
    (:russ       "russ-ross"          test-russ)
    ))

(defparameter *where*
  (make-pathname :name nil :type nil :defaults (current-pathname)))

(defparameter *count* 10)

(defvar *write-results* nil)

(defun test (who throw-out &optional *write-results*)
  (destructuring-bind
      (filename symbol-name &optional (package *package*))
      (cdr (assoc who *contestants*))
    (let* ((path (merge-pathnames filename *where*))
           (compile-time (do-time (lambda ()
                                    (compile-file path
                                                  :print nil
                                                  :verbose nil))))
           (load-time (do-time (lambda ()
                                 (load path
                                       :print nil
                                       :verbose nil))))
           (run-time (let ((symbol (find-symbol (symbol-name symbol-name) package)))
                       (do-time (lambda ()
                                  (funcall symbol 
                                           throw-out))))))
      (format t "~&~@(~a~10t~6d ~6d ~6d ~6d~)~&"
              who
              compile-time load-time run-time
              (+ compile-time load-time run-time))))
  (values))


(defun do-time (function)
  (let ((total 0)
        (output nil))
    (dotimes (i *count*)
      (mark-and-sweep 2)
      (setf output
            (with-output-to-string (*standard-output*)
              (let ((start (get-internal-real-time)))
                (funcall function)
                (let* ((end (get-internal-real-time))
                       (duration (- end start)))
                  (incf total duration))))))
    (when (and *write-results* output)
      (write-string output))
    total))

;; $Id: //info.ravenbrook.com/user/ndl/lisp/contest/entries/timings/timings.lisp#2 $