Change Scheme benchmark to allow graphing by measuring time and looping

1 files changed, 58 insertions, 42 deletions

diff --git a/benchmarks/benchmark.scm b/benchmarks/benchmark.scm
index 1b42aa9..fd5f7e7 100644
--- a/benchmarks/benchmark.scm
+++ b/benchmarks/benchmark.scm
@@ -11,13 +11,13 @@
 
 (declare (disable-interrupts))
 
-(import (chicken fixnum) (chicken string) (chicken process-context) (only srfi-1 lset-difference) srfi-69 slsets)
+(import (chicken fixnum) (chicken string) (chicken process-context) (chicken time) (only srfi-1 lset-difference) srfi-69 slsets)
 
 (unless (= (length (command-line-arguments)) 2)
-  (error "Need impl name (one of lset, slset, symbolset or srfi-69) and set size"))
+  (error "Need impl name (one of lset, slset, (cached-)symbolset, (cached-)hash-table or (cached-)srfi-69) and set size (number or 'loop')"))
 
 (define impl (string->symbol (car (command-line-arguments))))
-(define size (string->number (cadr (command-line-arguments))))
+(define requested-size (string->number (cadr (command-line-arguments))))
 
 (define-inline (list-tabulate n fun)
   (let lp ((i 0)
@@ -27,9 +27,6 @@
         (lp (add1 i)
             (cons (fun i) res)))))
 
-(define lst1 (list-tabulate size (lambda (i) (string->symbol (conc "x" i)))))
-(define lst2 (list-tabulate size (lambda (i) (string->symbol (conc "y" i)))))
-
 ;; Super-hacky way to determine impact of caching the hash value in a symbol.
 ;; We abuse the symbol's toplevel value slot to store the hash.  A slightly
 ;; cleaner but slower implementation could use the plist to store it.
@@ -91,7 +88,7 @@
 		(loop (##sys#slot bucket 1)))))))
 
 (define (symbolset-difference ls . lss)
-  (let ((seen (make-my-hash-table size)))
+  (let ((seen (make-my-hash-table (length ls))))
     (for-each (lambda (lst)
                 (for-each (lambda (x) (my-hash-table-set! seen x #t)) lst))
               lss)
@@ -141,7 +138,7 @@
     (my-hash-table-walk ht2 (lambda (k v)
                               (my-hash-table-delete! result k)))
     result)
-  (let ((result (make-my-hash-table size)))
+  (let ((result (make-my-hash-table (##sys#size ht1))))
     (my-hash-table-walk ht2 (lambda (k v)
                               (when (my-hash-table-ref ht1 k)
                                 (my-hash-table-set! result k v))))))
@@ -157,39 +154,58 @@
 
 ;;;;;;;;;;;;
 
-(let lp ((i 10000))
-  (case impl
-    ((lset)
-     (lset-difference eq? lst1 lst2))
-    ((slset)
-     (slset-difference lst1 lst2))
-    ((symbolset cached-symbolset)
-     (when (eq? impl 'cached-symbolset)
-       (set! symbol-cache? #t))
-     (symbolset-difference lst1 lst2))
-    ((hash-table cached-hash-table)
-     (when (pair? lst1)
-       (when (eq? impl 'cached-hash-table)
+(print "# Benchmark run for " impl)
+(print "# set size\trun time(ms)")
+
+(let lp1 ((size (or requested-size 10))
+          (start-time (current-process-milliseconds)))
+  (define lst1 (list-tabulate size (lambda (i) (string->symbol (conc "x" i)))))
+  (define lst2 (list-tabulate size (lambda (i) (string->symbol (conc "y" i)))))
+
+  (let lp2 ((i 10000))
+    (case impl
+      ((lset)
+       (lset-difference eq? lst1 lst2))
+      ((slset)
+       (slset-difference lst1 lst2))
+      ((symbolset cached-symbolset)
+       (when (eq? impl 'cached-symbolset)
          (set! symbol-cache? #t))
-       (let ((ht1 (make-my-hash-table size))
-             (ht2 (make-my-hash-table size)))
-         (begin
-           (for-each (lambda (x) (my-hash-table-set! ht1 x #t)) lst1)
-           (for-each (lambda (x) (my-hash-table-set! ht2 x #t)) lst2)
+       (symbolset-difference lst1 lst2))
+      ((hash-table cached-hash-table)
+       (when (pair? lst1)
+         (when (eq? impl 'cached-hash-table)
+           (set! symbol-cache? #t))
+         (let ((ht1 (make-my-hash-table size))
+               (ht2 (make-my-hash-table size)))
+           (begin
+             (for-each (lambda (x) (my-hash-table-set! ht1 x #t)) lst1)
+             (for-each (lambda (x) (my-hash-table-set! ht2 x #t)) lst2)
+             (set! lst1 ht1)
+             (set! lst2 ht2))))
+       (my-hash-table-difference lst1 lst2))
+      ((srfi-69 cached-srfi-69)
+       (when (pair? lst1)
+         (when (eq? impl 'cached-srfi-69)
+           (set! symbol-cache? #t))
+         (let ((ht1 (make-hash-table eq? (if (eq? impl 'cached-srfi-69) hash-symbol symbol-hash) size))
+               (ht2 (make-hash-table eq? (if (eq? impl 'cached-srfi-69) hash-symbol symbol-hash) size)))
+           (for-each (lambda (x) (hash-table-set! ht1 x #t)) lst1)
+           (for-each (lambda (x) (hash-table-set! ht2 x #t)) lst2)
            (set! lst1 ht1)
-           (set! lst2 ht2))))
-     (my-hash-table-difference lst1 lst2))
-    ((srfi-69 cached-srfi-69)
-     (when (pair? lst1)
-       (when (eq? impl 'cached-srfi-69)
-         (set! symbol-cache? #t))
-       (let ((ht1 (make-hash-table eq? (if (eq? impl 'cached-srfi-69) hash-symbol symbol-hash) size))
-             (ht2 (make-hash-table eq? (if (eq? impl 'cached-srfi-69) hash-symbol symbol-hash) size)))
-         (for-each (lambda (x) (hash-table-set! ht1 x #t)) lst1)
-         (for-each (lambda (x) (hash-table-set! ht2 x #t)) lst2)
-         (set! lst1 ht1)
-         (set! lst2 ht2)))
-     (srfi-69-hash-table-difference lst1 lst2))
-    (else (error "Unknown impl" impl)))
-  (unless (zero? i)
-    (lp (sub1 i))))
+           (set! lst2 ht2)))
+       (srfi-69-hash-table-difference lst1 lst2))
+      (else (error "Unknown impl" impl)))
+    (unless (zero? i)
+      (lp2 (sub1 i))))
+
+  (let* ((end-time (current-process-milliseconds))
+         (total-ms (- end-time start-time)))
+    (print size "\t" total-ms)
+    (flush-output)
+    ;; Run up to 10s, or a set size of 3000, whichever comes first
+    (unless (or requested-size
+                (> total-ms 10000)
+                (> size 3000))
+      (lp1 (+ size 100)
+           (current-process-milliseconds)))))