Commits

Anonymous committed f0bf7a0

added benchmark facility

Comments (0)

Files changed (4)

benchmark/benchmark.import.scm

+;;;; benchmark.import.scm - GENERATED BY CHICKEN 4.8.4 -*- Scheme -*-
+
+(eval '(import chicken scheme foreign (only srfi-1 list-tabulate fold)))
+(##sys#register-compiled-module
+  'benchmark
+  (list)
+  '((benchmark-run . benchmark#benchmark-run)
+    (benchmark-measure . benchmark#benchmark-measure))
+  (list)
+  (list))
+
+;; END OF FILE

benchmark/benchmark.meta

+((egg "benchmark.egg")
+ (author "David Krentzlin")
+ (synopsis "Simple benchmarking")
+ (category misc)
+ (license "GPLv3")
+ (depends)
+ (test-depends))

benchmark/benchmark.scm

+(module benchmark
+  (benchmark-run benchmark-measure)
+  (import chicken scheme foreign)
+  (require-library srfi-1)
+  (import (only srfi-1 list-tabulate fold))
+
+  ;; get time in microsecond resolution
+  (define %clock-gettime/microsecs (foreign-lambda* unsigned-integer64 ()
+                                                    "struct timespec ts;
+                                         clock_gettime(CLOCK_MONOTONIC,&ts);
+                                         C_return((uint64_t)ts.tv_sec * 1000000LL + (uint64_t)ts.tv_nsec / 1000LL);"))
+
+  ;; get time in nanoseconds
+  (define %clock-gettime/nanosecs (foreign-lambda* unsigned-integer64 ()
+                                                   "struct timespec ts;
+                                         clock_gettime(CLOCK_MONOTONIC,&ts);
+                                         C_return((uint64_t)ts.tv_sec * 1000000000LL + (uint64_t)ts.tv_nsec);"))
+
+  (define (get-time)
+    (inexact->exact (%clock-gettime/microsecs)))
+
+  ;; return the runtime of the given procedure in microseconds
+  (define (benchmark-measure proc)
+    (let ((start  0)
+          (stop   0))
+      (set! start (get-time))
+      (proc)
+      (set! stop (get-time))
+      (- stop start)))
+
+  (define current-benchmark-rounds (make-parameter 100))
+
+  ;; run the given procedure n times and return statistics about the runtime
+  ;; returns a list with 3 values
+  ;; * 1 maximum runtime
+  ;; * 2 minimum runtime
+  ;; * 3 average runtime
+  (define benchmark-run
+    (case-lambda
+      ((proc) (benchmark-run proc (current-benchmark-rounds)))
+      ((proc rounds)
+       (let ((runtimes (list-tabulate rounds (lambda _ (benchmark-measure proc)))))
+         (list (apply max runtimes) (apply min runtimes) (/ (fold + 0 runtimes) (length runtimes)))))))
+
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Example with female-male-sequence ;;;;;;;;;;;;;;;;;;;;;;
+;; (define (m n)
+;;   (if (zero? n) 0 (- n (f (m (sub1 n))))))
+
+;; (define (f n)
+;;   (if (zero? n) 1 (- n (m (f (sub1 n))))))
+
+;; (print (benchmark-run (lambda () (m 100)) 20))
+
+;; ;; now build a memoized version
+;; (define (memoize f)
+;;   (let ((cache (make-hash-table =)))
+;;     (lambda (n)
+;;       (let ((v (hash-table-ref/default cache n #f)))
+;;         (if v v
+;;             (let ((v (f n)))
+;;               (hash-table-set! cache n v)
+;;               v))))))
+
+;; (define m (memoize m))
+;; (define f (memoize f))
+
+;; (print (benchmark-run (lambda () (m 100)) 20))
+
+  )

benchmark/benchmark.setup

+(compile -s -d0 -O3 -S benchmark.scm -j benchmark)
+(compile -s -d0 -O3 -S benchmark.import.scm)
+
+(install-extension
+ 'benchmark
+ '("benchmark.so" "benchmark.import.so")
+ '((version "0.0.1")))