Adding benchmark macros, improving benchmark interface

benchmarks/benchmarking.lisp

@@ -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)))

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)

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

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")

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)))

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)))()

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))

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)))

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 ()