1.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2+++ b/lisp/lib/rt/bench.lisp	Sun Dec 17 18:07:46 2023 -0500
     1.3@@ -0,0 +1,41 @@
     1.4+;;; lib/rt/bench.lisp --- Benchmarking Framework
     1.5+
     1.6+;; This package provides an interface for benchmarking Lisp code.
     1.7+
     1.8+;;; Code:
     1.9+(in-package :rt/bench)
    1.10+
    1.11+(defvar *bench-count* 100 "Default number of iterations to repeat a bench test for. This value is
    1.12+used when the slot value of :BENCH is t.")
    1.13+
    1.14+(defmacro bench (iter &body body)
    1.15+  `(loop for i from 1 to ,iter
    1.16+	 do ,@body))
    1.17+
    1.18+(defmethod do-bench ((self test) &optional fx)
    1.19+  (declare (ignorable fx))
    1.20+  (with-test-env self
    1.21+    (flet ((%do ()
    1.22+	     (if-let ((opt *compile-tests*))
    1.23+	       (progn 
    1.24+		 (when (eq opt t) (setq opt *default-test-opts*))
    1.25+		 ;; TODO 2023-09-21: handle failures here
    1.26+		 (let ((fn (compile-test self :declare opt)))
    1.27+		   (bench *bench-count* (funcall fn)))
    1.28+		 (setf %test-result (make-test-result :pass (test-fn self))))
    1.29+	       (progn
    1.30+		 (bench *bench-count* (eval-test self))
    1.31+		 (setf %test-result (make-test-result :pass (test-name self)))))))
    1.32+      (if *catch-test-errors*
    1.33+	  (handler-bind
    1.34+	      ((style-warning #'muffle-warning)
    1.35+	       (error 
    1.36+		 #'(lambda (c)
    1.37+		     (setf %test-bail t)
    1.38+		     (setf %test-result (make-test-result :fail c))
    1.39+		     (return-from %test-bail %test-result))))
    1.40+	    (%do))
    1.41+	  (%do)))))
    1.42+
    1.43+
    1.44+(defmacro defbench ())