Benchmark sanitization and minor additions

benchmarks/README.md

@@ -1,7 +1,9 @@
-# To run Coalton Benchmarks:
+# To load Coalton Benchmarks:
 
 `(ql:quickload :coalton/benchmarks)` or `(asdf:load-system :coalton/benchmarks)`
 
-`(in-package #:coalton-benchmarks)`
+## Current status:
 
-`(run-benchmarks)`
+Due to dependency issues, currently all benchmarks are packaged and run separately. 
+
+They are intended to be incorporated into a cohesive benchmark suite using a coalton benchmarking framework at a later date.

benchmarks/benchmarks-game/mandelbrot.lisp

@@ -0,0 +1,179 @@
+(defpackage #:coalton/benchmarks/benchmarks-game/mandelbrot
+  (:use #:coalton
+        #:coalton-prelude)
+  (:local-nicknames (#:math #:coalton-library/math)
+                    (#:vec #:coalton-library/vector)
+                    (#:cell #:coalton-library/cell)
+                    (#:file #:coalton-library/file)
+                    (#:iter #:coalton-library/iterator)
+                    (#:char #:coalton-library/char)
+                    (#:str #:coalton-library/string)
+                    (#:bits #:coalton-library/bits))
+  (:export
+   #:mandelbrot-main
+   #:mandelbrot-small))
+
+(in-package #:coalton/benchmarks/benchmarks-game/mandelbrot)
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:setf coalton-impl/settings:*coalton-heuristic-inlining* cl:t))
+
+(cl:declaim (cl:optimize (cl:speed 3)
+                         (cl:space 0)
+                         (cl:compilation-speed 0)
+                         (cl:safety 0)
+                         (cl:debug 0)))
+
+(coalton-toplevel
+
+  (declare mandelbrot-function ((Num (Complex :a))
+                                => (Complex :a)
+                                -> (Complex :a)
+                                -> (Complex :a)))
+  (define (mandelbrot-function c z)
+    (+ (^ z 2) c))
+
+  (declare mandelbrot-div? ((Ord :a) (Complex :a)
+                            => (Complex :a)
+                            -> Boolean))
+  (define (mandelbrot-div? z)
+    "Is Z guaranteed to diverge in the implementation of the mandelbrot function. True means it is guaranteed, False means it's unsure."
+    (> (math:square-magnitude z) 4))
+
+  (declare escapes? (Integer
+                     -> ((Complex :a) -> (Complex :a))
+                     -> ((Complex :a) -> Boolean)
+                     -> (Complex :a)
+                     -> Integer))
+  (define (escapes? limit fc div? z0)
+    "Returns the number of iterations of the function F "
+    (let count = (cell:new 0))
+    (let result = (cell:new z0))
+
+    (while :escape (< (cell:read count) limit)
+      (cell:update! fc result)
+      (if (div? (cell:read result))
+          (break :escape)
+          (progn (cell:increment! count) Unit)))
+    (if (== limit (cell:read count))
+        -1
+        (cell:read count)))
+
+  (declare sample ((Reciprocable :a) (Ord :a) (Complex :a)
+                   => (Complex :a)
+                   -> (Complex :a)
+                   -> Integer
+                   -> Integer
+                   -> ((Complex :a) -> (Complex :a) -> (Complex :a))
+                   -> ((Complex :a) -> Boolean)
+                   -> (Complex :a)
+                   -> (Vector Integer)))
+  (define (sample negbound posbound steps limit f div? z0)
+    (let v = (vec:new))
+    (let steps-num = (fromint steps))
+    (let width = (- (real-part posbound) (real-part negbound)))
+    (let height = (- (imag-part posbound) (imag-part negbound)))
+    (let real-offset = (real-part negbound))
+    (let imag-offset = (imag-part negbound))
+    (for bi in (iter:up-to steps-num)
+      (lisp Unit (bi)
+            (cl:when (cl:zerop (cl:mod bi 100))
+              (cl:format cl:t ";; ~D~%" bi))
+            Unit)
+      (for ai in (iter:up-to steps-num)
+        (let a = (+ real-offset (* width (/ ai steps-num)))
+          )
+        (let b = (+ imag-offset (* height (/ bi steps-num)))
+          )
+        (let c = (Complex a b))
+        (vec:push! (escapes? limit (f c) div? z0) v)
+        Unit))
+    v)
+
+  (define (mandelbrot negbound posbound steps limit)
+    (sample negbound posbound steps limit mandelbrot-function mandelbrot-div? 0)))
+
+;;;
+;;; Writing the header
+;;;
+
+(coalton-toplevel
+
+  (define magic-number
+    (map (fn (c)
+           (the U8 (unwrap (tryinto
+                            (char:char-code c)))))
+         (vec:make #\P #\4 #\Newline)))
+
+  (declare width-height-data (String -> (Vector U8)))
+  (define (width-height-data n)
+    (map (fn (c)
+           (unwrap (tryinto (char:char-code c))))
+         (as (Vector Char)
+             (as (List Char)
+                 (str:concat n
+                             (str:concat " "
+                                         (str:concat n
+                                                     (into (make-list #\Newline))))))))))
+
+(coalton-toplevel
+
+  (declare bit-vector ((Vector Integer) -> (Vector U8)))
+  (define (bit-vector iterated)
+    "Converts a list of Integers to a bit vector of U8's."
+    (let out = (vec:new))
+    (let current-byte = (cell:new (the U8 0)))
+    (let bitnum = (cell:new 0))
+    (for el in iterated
+
+      (when (== (cell:read bitnum) 8)
+        (vec:push! (cell:read current-byte) out)
+        (cell:write! bitnum 0)
+        (cell:write! current-byte 0)
+        Unit)
+
+      (cell:update! (bits:shift 1) current-byte)
+      (cell:increment! bitnum)
+      (when (== -1 el)
+        (cell:increment! current-byte)
+        Unit)
+      Unit)
+
+    (when (positive? (cell:read bitnum))
+      (vec:push! (cell:read current-byte) out)
+      Unit)
+
+    out))
+
+(coalton-toplevel
+
+  (monomorphize)
+  (declare benchmark-mandelbrot (Integer -> (Vector Integer)))
+  (define (benchmark-mandelbrot n)
+    (mandelbrot
+     (Complex -1.5d0 -1.0d0)
+     (Complex 0.5d0 1.0d0)
+     n
+     50))
+
+  (declare mandelbrot-benchmark ((Into :a file:Pathname) => :a -> String -> (Result file:FileError Unit)))
+  (define (mandelbrot-benchmark filename arg-n)
+    (file:with-open-file
+        (file:Output (into filename)
+                     file:Supersede)
+      (fn (stream)
+        ;; write the header
+        (file:write-vector stream magic-number)
+        (file:write-vector stream (width-height-data arg-n))
+        ;; write the raster
+        (file:write-vector stream (bit-vector
+                                   (benchmark-mandelbrot (unwrap (str:parse-int arg-n)))))
+        (Ok Unit)))))
+
+(coalton-toplevel
+
+  (define (mandelbrot-small)
+    (time (fn () (mandelbrot-benchmark "/dev/stdout" "1000"))))
+
+  (define (mandelbrot-main)
+    (time (fn () (mandelbrot-benchmark "/dev/stdout" "16000")))))

benchmarks/benchmarks-game/package.lisp

@@ -0,0 +1,4 @@
+(uiop:define-package #:coalton/benchmarks/benchmarks-game
+  (:mix-reexport
+   #:coalton/benchmarks/benchmarks-game/mandelbrot
+   #:coalton/benchmarks/benchmarks-game/too-simple))

benchmarks/benchmarks-game/too-simple.lisp

@@ -0,0 +1,41 @@
+(defpackage #:coalton/benchmarks/benchmarks-game/too-simple
+  (:use #:coalton
+        #:coalton-prelude)
+  (:local-nicknames (#:sys #:coalton-library/system)
+                    (#:iter #:coalton-library/iterator)
+                    (#:cell #:coalton-library/cell)
+                    (#:string #:coalton-library/string)
+                    (#:list #:coalton-library/list))
+  (:export
+   #:too-simple-main
+   #:too-simple-main2))
+
+(in-package #:coalton/benchmarks/benchmarks-game/too-simple)
+
+(cl:declaim (cl:optimize cl:speed (cl:safety 0) (cl:debug 0)))
+(coalton-toplevel
+
+  (define (too-simple-main n)
+    (time (fn ()
+            (let sum = (cell:new 0.0d0))
+            (let flip = (cell:new -1.0d0))
+            (for i in (map 1+ (iter:up-to n))
+              (cell:update! negate flip)
+              (cell:update! (fn (x) (+ x
+                                        (/ (cell:read flip)
+                                           (1- (* 2 i)))))
+                            sum))
+            (traceobject "Sum" (* (cell:read sum) 4)))))
+
+  (define (too-simple-main2 n)
+    (time (fn ()
+            (let ((declare run (Double-Float -> Double-Float -> Double-Float -> Double-Float))
+                  (run (fn (i sum flip)
+                         (if (< n i)
+                             (* 4 sum)
+                             (run (1+ i)
+                                  (+ sum
+                                      (/ flip
+                                         (1- (* 2 i))))
+                                  (negate flip))))))
+              (traceobject "Sum:" (run 1.0d0 0.0d0 1.0d0)))))))

benchmarks/big-float.lisp

@@ -1,17 +1,68 @@
 ;;;; big-float.lisp
 ;;;;
 ;;;; Benchmarks for arbitrary precision floats
+(defpackage #:coalton/benchmarks/big-float
+  (:use #:coalton
+        #:coalton-prelude
+        #:coalton-library/math
+        #:coalton-library/big-float)
+  (:export
+   #:big-trig
+   #:big-inv-trig
+   #:big-ln-exp
+   #:big-sqrt
+   #:big-mult-constants))
 
-(cl:in-package #:coalton-benchmarks)
+(cl:in-package #:coalton/benchmarks/big-float)
 
+(cl:declaim (cl:optimize (cl:speed 3) (cl:safety 1)))
+
+(coalton-toplevel
+  (declare big-trig (UFix -> Double-Float -> Big-Float))
+  (define (big-trig n x)
+    (with-precision n
+      (fn ()
+        (let x = (into x))
+        (tan (sin (cos x))))))
+
+  (declare big-inv-trig (UFix -> Double-Float -> Big-Float))
+  (define (big-inv-trig n x)
+    (with-precision n
+      (fn ()
+        (let x = (into x))
+        (atan (+ (asin x) (acos x))))))
+
+  (declare big-ln-exp (UFix -> Double-Float -> Big-Float))
+  (define (big-ln-exp n x)
+    (with-precision n
+      (fn ()
+        (let x = (into x))
+        (ln (exp x)))))
+
+  (declare big-sqrt (UFix -> Double-Float -> Big-Float))
+  (define (big-sqrt n x)
+    (with-precision n
+      (fn ()
+        (let x = (into x))
+        (sqrt x))))
+
+  (define (big-mult-constants n x)
+    (with-precision n
+      (fn ()
+        (let x = (into x))
+        (* x (* pi ee))))))
+
+;;(cl:in-package #:coalton-benchmarks)
+
+#+ig
 (cl:defvar *big-float-bench-precision*
   #-coalton-portable-bigfloat 10000
   #+coalton-portable-bigfloat 100)
-(cl:defvar *big-float-bench-iterations*
+#+ig(cl:defvar *big-float-bench-iterations*
   #-coalton-portable-bigfloat 1000
   #+coalton-portable-bigfloat 10)
 
-(define-benchmark big-trig ()
+#+ig(define-benchmark big-trig ()
   "Benchmark at N precision big-float trigonometric functions."
   (declare (optimize speed))
   (loop :repeat  *big-float-bench-iterations*
@@ -21,7 +72,7 @@
                (* (- (random 2)) (random 100.0d0)))))
   (report trivial-benchmark::*current-timer*))
 
-(define-benchmark big-inv-trig ()
+#+ig(define-benchmark big-inv-trig ()
   "Benchmark at N precision big-float inverse trigonometric functions."
   (declare (optimize speed))
   (loop :repeat *big-float-bench-iterations*
@@ -31,7 +82,7 @@
                (* (- (random 2)) (random 1.0d0)))))
   (report trivial-benchmark::*current-timer*))
 
-(define-benchmark big-ln-exp ()
+#+ig(define-benchmark big-ln-exp ()
   "Benchmark at N precision big-float ln and exp."
   (declare (optimize speed))
   (loop :repeat *big-float-bench-iterations*
@@ -41,7 +92,7 @@
                (* (- (random 2)) (random 100.0d0)))))
   (report trivial-benchmark::*current-timer*))
 
-(define-benchmark big-sqrt ()
+#+ig(define-benchmark big-sqrt ()
   "Benchmark at N precision big-float square roots."
   (declare (optimize speed))
   (loop :repeat *big-float-bench-iterations*
@@ -51,7 +102,7 @@
                (random 100.0d0))))
   (report trivial-benchmark::*current-timer*))
 
-(define-benchmark big-mult-constants ()
+#+ig(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*
@@ -60,42 +111,3 @@
                *big-float-bench-precision*
                (* (- (random 2)) (random 100.0d0)))))
   (report trivial-benchmark::*current-timer*))
-
-(cl:in-package #:coalton-benchmarks/native)
-
-(cl:declaim (cl:optimize (cl:speed 3) (cl:safety 1)))
-
-(coalton-toplevel
-  (declare big-trig (UFix -> Double-Float -> Big-Float))
-  (define (big-trig n x)
-    (with-precision n
-      (fn ()
-        (let x = (into x))
-        (tan (sin (cos x))))))
-
-  (declare big-inv-trig (UFix -> Double-Float -> Big-Float))
-  (define (big-inv-trig n x)
-    (with-precision n
-      (fn ()
-        (let x = (into x))
-        (atan (+ (asin x) (acos x))))))
-
-  (declare big-ln-exp (UFix -> Double-Float -> Big-Float))
-  (define (big-ln-exp n x)
-    (with-precision n
-      (fn ()
-        (let x = (into x))
-        (ln (exp x)))))
-
-  (declare big-sqrt (UFix -> Double-Float -> Big-Float))
-  (define (big-sqrt n x)
-    (with-precision n
-      (fn ()
-        (let x = (into x))
-        (sqrt x))))
-
-  (define (big-mult-constants n x)
-    (with-precision n
-      (fn ()
-        (let x = (into x))
-        (* x (* pi ee))))))