From ec5b34b9089d78158fbe0424bad1c81153da1c91 Mon Sep 17 00:00:00 2001 From: Izaak Walton Date: Fri, 4 Oct 2024 01:41:35 -0700 Subject: [PATCH] Adding benchmark macros, improving benchmark interface --- benchmarks/benchmarking.lisp | 29 ++++++++------ benchmarks/big-float.lisp | 38 +++++++++--------- benchmarks/fibonacci.lisp | 46 ++++++++++------------ benchmarks/gabriel-benchmarks/package.lisp | 10 ++--- benchmarks/gabriel-benchmarks/stak.lisp | 20 +++++----- benchmarks/gabriel-benchmarks/tak.lisp | 22 +++++------ benchmarks/gabriel-benchmarks/takl.lisp | 22 +++++------ benchmarks/gabriel-benchmarks/takr.lisp | 22 +++++------ benchmarks/package.lisp | 17 ++++---- 9 files changed, 106 insertions(+), 120 deletions(-) diff --git a/benchmarks/benchmarking.lisp b/benchmarks/benchmarking.lisp index 70f43e5f..20a3c8fc 100644 --- a/benchmarks/benchmarking.lisp +++ b/benchmarks/benchmarking.lisp @@ -55,7 +55,7 @@ (define-instance (Into BenchmarkResults String) (define (into (BenchmarkResults name iterations real-time)) (lisp String (name iterations real-time) - (cl:format cl:nil "~%Benchmark Results:~%Name: ~a~%Iterations: ~a~%Real-Time: ~a~%" + (cl:format cl:nil "~%Benchmark Results:~%Name: ~a~%Iterations: ~a~%Real-Time: ~a ms~%" name iterations real-time)))) @@ -108,8 +108,8 @@ (lisp String () (cl:package-name cl:*package*))) - (declare define-benchmark (String -> UFix -> (Unit -> Unit) -> Unit)) - (define (define-benchmark name iterations fn) + (declare %define-benchmark (String -> UFix -> (Unit -> Unit) -> Unit)) + (define (%define-benchmark name iterations fn) "Defines a Coalton benchmark, stored in *benchmark-environment*." (hash:set! *benchmark-environment* @@ -177,8 +177,14 @@ system results))) +(cl:defmacro define-benchmark (name iterations func) + "Defines a Coalton benchmark" + (cl:let ((name (cl:string name))) + `(coalton (%define-benchmark ,name ,iterations ,func)))) + ;;; -;;; Allow importing of benchmarks into other packages, for the sake of building package-per-file benchmark hierarchies. +;;; Allow importing of benchmarks into other packages, +;;; for the sake of building package-per-file benchmark hierarchies. ;;; (coalton-toplevel @@ -189,14 +195,13 @@ (vec:push! package-name (.packages benchmark)) Unit) - (declare import-benchmarks (String -> Unit)) - (define (import-benchmarks package) - "This imports benchmarks from another package, for instance for package-per-file hierarchy." + (declare %reexport-package-benchmarks (String -> Unit)) + (define (%reexport-package-benchmarks package) (for bmark in (find-package-benchmarks package) (%add-package (current-package) bmark) - Unit)) + Unit))) - (declare reexport-benchmarks ((List String) -> Unit)) - (define (reexport-benchmarks packages) - (for pkg in packages - (import-benchmarks pkg)))) +(cl:defun reexport-benchmarks (cl:&rest packages) + "This imports and reexports benchmarks from another package, for package-per-file hierarchy." + (cl:loop :for pkg :in packages + :do (%reexport-package-benchmarks pkg))) diff --git a/benchmarks/big-float.lisp b/benchmarks/big-float.lisp index c5392fb3..8a4eef65 100644 --- a/benchmarks/big-float.lisp +++ b/benchmarks/big-float.lisp @@ -11,6 +11,8 @@ (:local-nicknames (#:math #:coalton-library/math)) (:export + #:*big-float-bench-precision* + #:*big-float-bench-iterations* #:big-trig #:big-inv-trig #:big-ln-exp @@ -77,29 +79,25 @@ (let x = (into x)) (* x (* math:pi math:ee)))))) -(coalton-toplevel +(cl:defmacro define-big-float-benchmark (name) + (cl:let ((func name) + (name (cl:string name)) + ;(iterations '*big-float-bench-iterations*) + ;(precision (coalton (big-float-bench-precision))) + (rand (cl:* (cl:- (cl:random 2)) (cl:random 100.0d0)))) + `(coalton (coalton-benchmarking::%define-benchmark ,name 1000 + (fn () + (,func 10000 + ,rand) + Unit))))) - (declare define-big-float-benchmark (String - -> (UFix -> Double-Float -> Big-Float) - -> Unit)) - (define (define-big-float-benchmark name f) - (define-benchmark name (big-float-bench-iterations) - (fn () - (f (big-float-bench-precision) - (random-double-float)) - Unit)))) -(coalton - (define-big-float-benchmark "big-trig" big-trig)) +(define-big-float-benchmark big-trig) -(coalton - (define-big-float-benchmark "big-inv-trig" big-inv-trig)) +(define-big-float-benchmark big-inv-trig) -(coalton - (define-big-float-benchmark "big-ln-exp" big-ln-exp)) +(define-big-float-benchmark big-ln-exp) -(coalton - (define-big-float-benchmark "big-sqrt" big-sqrt)) +(define-big-float-benchmark big-sqrt) -(coalton - (define-big-float-benchmark "big-mult-constants" big-mult-constants)) +(define-big-float-benchmark big-mult-constants) diff --git a/benchmarks/fibonacci.lisp b/benchmarks/fibonacci.lisp index 67875d1d..764103fa 100644 --- a/benchmarks/fibonacci.lisp +++ b/benchmarks/fibonacci.lisp @@ -84,31 +84,27 @@ ;;; Benchmarks ;;; -(coalton - (define-benchmark "recursive-fib" 1000 - (fn () - (fib 20) - Unit))) - -(coalton - (define-benchmark "recursive-fib-generic" 1000 - (fn () - (fib-generic-wrapped 20) - Unit))) - -(coalton - (define-benchmark "recursive-fib-lisp" 1000 - (fn () - (lisp Unit () - (lisp-fib 20) - Unit)))) - -(coalton - (define-benchmark "recursive-fib-monomorphized" 1000 - (fn () - (lisp Unit () - (fib-monomorphized 20) - Unit)))) +(define-benchmark recursive-fib 1000 + (fn () + (fib 20) + Unit)) + +(define-benchmark recursive-fib-generic 1000 + (fn () + (fib-generic-wrapped 20) + Unit)) + +(define-benchmark recursive-fib-lisp 1000 + (fn () + (lisp Unit () + (lisp-fib 20) + Unit))) + +(define-benchmark recursive-fib-monomorphized 1000 + (fn () + (lisp Unit () + (fib-monomorphized 20) + Unit))) ;; ;; Benchmarks on optional are disabled by default because they compute the 10th diff --git a/benchmarks/gabriel-benchmarks/package.lisp b/benchmarks/gabriel-benchmarks/package.lisp index 9f7d1bf5..ba7b99f0 100644 --- a/benchmarks/gabriel-benchmarks/package.lisp +++ b/benchmarks/gabriel-benchmarks/package.lisp @@ -11,8 +11,8 @@ (in-package #:coalton-benchmarks/gabriel) -(coalton (reexport-benchmarks - (make-list "coalton-benchmarks/gabriel/tak" - "coalton-benchmarks/gabriel/takr" - "coalton-benchmarks/gabriel/stak" - "coalton-benchmarks/gabriel/takl"))) +(reexport-benchmarks + "coalton-benchmarks/gabriel/tak" + "coalton-benchmarks/gabriel/takr" + "coalton-benchmarks/gabriel/stak" + "coalton-benchmarks/gabriel/takl") diff --git a/benchmarks/gabriel-benchmarks/stak.lisp b/benchmarks/gabriel-benchmarks/stak.lisp index 63d518b1..9e158eb7 100644 --- a/benchmarks/gabriel-benchmarks/stak.lisp +++ b/benchmarks/gabriel-benchmarks/stak.lisp @@ -70,16 +70,14 @@ (stak x1 y1 z1))))) ;; Defining the Coalton benchmark -(coalton - (define-benchmark "stak" 1000 - (fn () - (stak 18 12 6) - Unit))) +(define-benchmark stak 1000 + (fn () + (stak 18 12 6) + Unit)) ;; Defining the Lisp Benchmark -(coalton - (define-benchmark "lisp-stak" 1000 - (fn () - (lisp Unit () - (lisp-stak 18 12 6) - Unit)))) +(define-benchmark lisp-stak 1000 + (fn () + (lisp Unit () + (lisp-stak 18 12 6) + Unit))) diff --git a/benchmarks/gabriel-benchmarks/tak.lisp b/benchmarks/gabriel-benchmarks/tak.lisp index 59716924..339b3b36 100644 --- a/benchmarks/gabriel-benchmarks/tak.lisp +++ b/benchmarks/gabriel-benchmarks/tak.lisp @@ -34,18 +34,14 @@ (tak (1- z) x y))))) ;; Defining the Coalton benchmark -(coalton - - (define-benchmark "tak" 1000 - (fn () - (tak 18 12 6) - Unit))) +(define-benchmark tak 1000 + (fn () + (tak 18 12 6) + Unit)) ;; Defining the Lisp Benchmark -(coalton - - (define-benchmark "lisp-tak" 1000 - (fn () - (lisp Unit () - (lisp-tak 18 12 6) - Unit)))) +(define-benchmark lisp-tak 1000 + (fn () + (lisp Unit () + (lisp-tak 18 12 6) + Unit)))() diff --git a/benchmarks/gabriel-benchmarks/takl.lisp b/benchmarks/gabriel-benchmarks/takl.lisp index 28f57131..2a5508e7 100644 --- a/benchmarks/gabriel-benchmarks/takl.lisp +++ b/benchmarks/gabriel-benchmarks/takl.lisp @@ -76,16 +76,12 @@ (define (takl x y z) (mas (listn x) (listn y) (listn z)))) -(coalton - - (define-benchmark "takl" 2000 - (fn () - (takl 18 12 6) - Unit))) - -(coalton - - (define-benchmark "lisp-takl" 2000 - (fn () - (takl 18 12 6) - Unit))) +(define-benchmark takl 2000 + (fn () + (takl 18 12 6) + Unit)) + +(define-benchmark lisp-takl 2000 + (fn () + (takl 18 12 6) + Unit)) diff --git a/benchmarks/gabriel-benchmarks/takr.lisp b/benchmarks/gabriel-benchmarks/takr.lisp index 4102a522..a3d5e439 100644 --- a/benchmarks/gabriel-benchmarks/takr.lisp +++ b/benchmarks/gabriel-benchmarks/takr.lisp @@ -1433,18 +1433,14 @@ (takr (- z 1) x y)))))) ;; Defining the Coalton benchmark -(coalton - - (define-benchmark "takr" 1000 - (fn () - (takr 18 12 6) - Unit))) +(define-benchmark takr 1000 + (fn () + (takr 18 12 6) + Unit)) ;; Defining the Lisp Benchmark -(coalton - - (define-benchmark "lisp-takr" 1000 - (fn () - (lisp Unit () - (lisp-takr 18 12 6) - Unit)))) +(define-benchmark lisp-takr 1000 + (fn () + (lisp Unit () + (lisp-takr 18 12 6) + Unit))) diff --git a/benchmarks/package.lisp b/benchmarks/package.lisp index dcebcd21..101b987a 100644 --- a/benchmarks/package.lisp +++ b/benchmarks/package.lisp @@ -9,18 +9,19 @@ (:mix-reexport #:coalton-benchmarks/fibonacci #:coalton-benchmarks/big-float - #:coalton-benchmarks/gabriel)) + #:coalton-benchmarks/gabriel) + (:export + #:run-coalton-benchmarks)) (in-package #:coalton-benchmarks) -(coalton (reexport-benchmarks - (make-list "coalton-benchmarks/fibonacci" - "coalton-benchmarks/big-float" - "coalton-benchmarks/gabriel"))) -(coalton-toplevel +(reexport-benchmarks + "coalton-benchmarks/fibonacci" + "coalton-benchmarks/big-float" + "coalton-benchmarks/gabriel") - (define (run-benchmarks) - (run-package-benchmarks "coalton-benchmarks"))) +(cl:defun run-coalton-benchmarks () + (coalton (run-package-benchmarks "coalton-benchmarks"))) #+ig (defun run-benchmarks-ci ()