Converting benchmark suite to new benchmarking

benchmarks/benchmarking.lisp

@@ -17,7 +17,10 @@
    #:find-benchmark
    #:find-package-benchmarks
    #:run-benchmark
-   #:run-package-benchmarks))
+   #:run-package-benchmarks
+
+   #:import-benchmarks
+   #:reexport-benchmarks))
 
 (in-package #:coalton-benchmarking)
 
@@ -155,17 +158,24 @@
 
   (define (run-package-benchmarks name)
     "Runs all benchmarks for a package"
+    (let system = (benchmark-system-info))
+    (let sys-str = (as String system))
+    (when *verbose-benchmarking*
+      (print
+       (lisp String (name sys-str)
+         (cl:format cl:nil "Package '~a' Benchmark Results~%System:~a"
+                    name
+                    sys-str))))
     (let results = (vec:new))
     (for b in (find-package-benchmarks name)
+      (let res = (%run-benchmark b))
+      (when *verbose-benchmarking*
+        (print res))
       (vec:push! (%run-benchmark b) results))
-    (let package-results = (PackageBenchmarkResults
-                            name
-                            (benchmark-system-info)
-                            results))
-    (if *verbose-benchmarking*
-          (progn (print package-results)
-                 package-results)
-          package-results)))
+    (PackageBenchmarkResults
+     name
+     system
+     results)))
 
 ;;;
 ;;; Allow importing of benchmarks into other packages, for the sake of building package-per-file benchmark hierarchies.

benchmarks/big-float.lisp

@@ -2,7 +2,22 @@
 ;;;;
 ;;;; Benchmarks for arbitrary precision floats
 
-(cl:in-package #:coalton-benchmarks)
+(defpackage #:coalton-benchmarks/big-float
+  (:use
+   #:coalton
+   #:coalton-prelude
+   #:coalton-benchmarking
+   #:coalton-library/big-float)
+  (:local-nicknames
+   (#:math #:coalton-library/math))
+  (:export
+   #:big-trig
+   #:big-inv-trig
+   #:big-ln-exp
+   #:big-sqrt
+   #:big-mult-constants))
+
+(cl:in-package #:coalton-benchmarks/big-float)
 
 (cl:defvar *big-float-bench-precision*
   #-coalton-portable-bigfloat 10000
@@ -11,57 +26,19 @@
   #-coalton-portable-bigfloat 1000
   #+coalton-portable-bigfloat 10)
 
-(define-benchmark big-trig ()
-  "Benchmark at N precision big-float trigonometric functions."
-  (declare (optimize speed))
-  (loop :repeat  *big-float-bench-iterations*
-        :do (with-benchmark-sampling
-              (coalton-benchmarks/native::big-trig
-               *big-float-bench-precision*
-               (* (- (random 2)) (random 100.0d0)))))
-  (report trivial-benchmark::*current-timer*))
-
-(define-benchmark big-inv-trig ()
-  "Benchmark at N precision big-float inverse trigonometric functions."
-  (declare (optimize speed))
-  (loop :repeat *big-float-bench-iterations*
-        :do (with-benchmark-sampling
-              (coalton-benchmarks/native::big-inv-trig
-               *big-float-bench-precision*
-               (* (- (random 2)) (random 1.0d0)))))
-  (report trivial-benchmark::*current-timer*))
-
-(define-benchmark big-ln-exp ()
-  "Benchmark at N precision big-float ln and exp."
-  (declare (optimize speed))
-  (loop :repeat *big-float-bench-iterations*
-        :do (with-benchmark-sampling
-              (coalton-benchmarks/native::big-ln-exp
-               *big-float-bench-precision*
-               (* (- (random 2)) (random 100.0d0)))))
-  (report trivial-benchmark::*current-timer*))
-
-(define-benchmark big-sqrt ()
-  "Benchmark at N precision big-float square roots."
-  (declare (optimize speed))
-  (loop :repeat *big-float-bench-iterations*
-        :do (with-benchmark-sampling
-              (coalton-benchmarks/native::big-sqrt
-               *big-float-bench-precision*
-               (random 100.0d0))))
-  (report trivial-benchmark::*current-timer*))
-
-(define-benchmark big-mult-constants ()
-  "Benchmark at N precision big-float multiplication of pi and euler's number."
-  (declare (optimize speed))
-  (loop :repeat *big-float-bench-iterations*
-        :do (with-benchmark-sampling
-              (coalton-benchmarks/native::big-sqrt
-               *big-float-bench-precision*
-               (* (- (random 2)) (random 100.0d0)))))
-  (report trivial-benchmark::*current-timer*))
-
-(cl:in-package #:coalton-benchmarks/native)
+(coalton-toplevel
+  (define (big-float-bench-precision)
+    (lisp UFix ()
+      *big-float-bench-precision*))
+
+  (define (big-float-bench-iterations)
+    (lisp UFix ()
+      *big-float-bench-iterations*)))
+
+(coalton-toplevel
+  (define (random-double-float)
+    (lisp Double-Float ()
+      (cl:* (cl:- (cl:random 2)) (cl:random 100.0d0)))))
 
 (cl:declaim (cl:optimize (cl:speed 3) (cl:safety 1)))
 
@@ -98,4 +75,31 @@
     (with-precision n
       (fn ()
         (let x = (into x))
-        (* x (* pi ee))))))
+        (* x (* math:pi math:ee))))))
+
+(coalton-toplevel
+
+  (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))
+
+(coalton
+ (define-big-float-benchmark "big-inv-trig" big-inv-trig))
+
+(coalton
+ (define-big-float-benchmark "big-ln-exp" big-ln-exp))
+
+(coalton
+ (define-big-float-benchmark "big-sqrt" big-sqrt))
+
+(coalton
+ (define-big-float-benchmark "big-mult-constants" big-mult-constants))

benchmarks/fibonacci.lisp

@@ -2,75 +2,46 @@
 ;;;;
 ;;;; Benchmarks for different methods of generating fibonacci numbers
 
-(cl:in-package #:coalton-benchmarks)
-
-(define-benchmark recursive-fib ()
-  (declare (optimize speed))
-  (loop :repeat 1000
-        :do (with-benchmark-sampling
-              (coalton-benchmarks/native:fib 20)))
-  (report trivial-benchmark::*current-timer*))
-
-(define-benchmark recursive-fib-generic ()
-  (declare (optimize speed))
-  (loop :repeat 1000
-        :do (with-benchmark-sampling
-              (coalton-benchmarks/native:fib-generic-wrapped 20)))
-  (report trivial-benchmark::*current-timer*))
-
-(define-benchmark recursive-fib-lisp ()
-  (declare (optimize speed))
-  (loop :repeat 1000
-        :do (with-benchmark-sampling
-              (lisp-fib 20)))
-  (report trivial-benchmark::*current-timer*))
-
-
-(define-benchmark recursive-fib-monomorphized ()
-  (declare (optimize speed))
-  (loop :repeat 1000
-        :do (with-benchmark-sampling
-              (coalton-benchmarks/native:fib-monomorphized 20)))
-  (report trivial-benchmark::*current-timer*))
-
-;;
-;; Benchmarks on optional are disabled by default because they compute the 10th
-;; instead of the 20th fibonacci number. Computing the 20th was exhausting the heap.
-;;
-
-#+ignore
-(define-benchmark recursive-fib-generic-optional ()
-  (declare (optimize speed))
-  (loop :repeat 1000
-        :do (with-benchmark-sampling
-              (coalton-benchmarks/native:fib-generic-optional 10)))
-  (report trivial-benchmark::*current-timer*))
-
-#+ignore
-(define-benchmark recursive-fib-monomorphized-optional ()
-  (declare (optimize speed))
-  (loop :repeat 1000
-        :do (with-benchmark-sampling
-              (coalton-benchmarks/native:fib-monomorphized-optional 10)))
-  (report trivial-benchmark::*current-timer*))
-
-(defun lisp-fib (n)
-  (declare (type integer n)
-           (values integer)
-           (optimize (speed 3) (safety 0)))
-  (when (= n 0)
-    (return-from lisp-fib 0))
-
-  (when (= n 1)
-    (return-from lisp-fib 1))
-
-  (+ (lisp-fib (- n 1)) (lisp-fib (- n 2))))
-
-(cl:in-package #:coalton-benchmarks/native)
+(defpackage #:coalton-benchmarks/fibonacci
+  (:use
+   #:coalton
+   #:coalton-prelude
+   #:coalton-benchmarking)
+  (:export
+   #:lisp-fib
+   #:fib
+   #:fib-generic
+   #:fib-generic-wrapped
+   #:fib-monomorphized
+   #:fib-optional
+   #:fib-monomorphized-optional))
+
+(in-package #:coalton-benchmarks/fibonacci)
+
+;;;
+;;; Lisp fibonacci
+;;;
+
+(cl:defun lisp-fib (n)
+  (cl:declare (cl:type cl:integer n)
+              (cl:values cl:integer)
+              (cl:optimize (cl:speed 3) (cl:safety 0)))
+  (cl:when (cl:= n 0)
+    (cl:return-from lisp-fib 0))
+
+  (cl:when (cl:= n 1)
+    (cl:return-from lisp-fib 1))
+
+  (cl:+ (lisp-fib (cl:- n 1)) (lisp-fib (cl:- n 2))))
+
+;;;
+;;; Coalton fibonacci
+;;;
 
 (cl:declaim (cl:optimize (cl:speed 3) (cl:safety 0)))
 
 (coalton-toplevel
+
   (declare fib (Integer -> Integer))
   (define (fib n)
     (when (== n 0)
@@ -108,3 +79,54 @@
   (declare fib-monomorphized-optional (Integer -> Optional Integer))
   (define (fib-monomorphized-optional x)
     (fib-generic (Some x))))
+
+;;;
+;;; 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))))
+
+;;
+;; Benchmarks on optional are disabled by default because they compute the 10th
+;; instead of the 20th fibonacci number. Computing the 20th was exhausting the heap.
+;;
+
+#+ignore
+(define-benchmark recursive-fib-generic-optional ()
+  (declare (optimize speed))
+  (loop :repeat 1000
+        :do (with-benchmark-sampling
+              (coalton-benchmarks/native:fib-generic-optional 10)))
+  (report trivial-benchmark::*current-timer*))
+
+#+ignore
+(define-benchmark recursive-fib-monomorphized-optional ()
+  (declare (optimize speed))
+  (loop :repeat 1000
+        :do (with-benchmark-sampling
+              (coalton-benchmarks/native:fib-monomorphized-optional 10)))
+  (report trivial-benchmark::*current-timer*))

benchmarks/gabriel-benchmarks/package.lisp

@@ -0,0 +1,18 @@
+(uiop:define-package #:coalton-benchmarks/gabriel
+  (:use
+   #:coalton
+   #:coalton-prelude
+   #:coalton-benchmarking)
+  (:mix-reexport
+   #:coalton-benchmarks/gabriel/tak
+   #:coalton-benchmarks/gabriel/takr
+   #:coalton-benchmarks/gabriel/stak
+   #:coalton-benchmarks/gabriel/takl))
+
+(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")))