little benchmark facility added by certainty on Fri Mar 14 16:05:52 2014

(use (srfi 1 69))

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