diff options
Diffstat (limited to 'extra/guile/benchmark.scm')
-rw-r--r-- | extra/guile/benchmark.scm | 168 |
1 files changed, 168 insertions, 0 deletions
diff --git a/extra/guile/benchmark.scm b/extra/guile/benchmark.scm new file mode 100644 index 000000000000..463a8eb17d9e --- /dev/null +++ b/extra/guile/benchmark.scm @@ -0,0 +1,168 @@ +;; +;; immer: immutable data structures for C++ +;; Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +;; +;; This software is distributed under the Boost Software License, Version 1.0. +;; See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +;; + +(use-modules (immer) + (fector) ; https://wingolog.org/pub/fector.scm + (srfi srfi-1) + (srfi srfi-43) + (ice-9 vlist) + (ice-9 pretty-print) + (rnrs bytevectors)) + +(define-syntax display-eval + (syntax-rules () + ((_ expr) + (begin (pretty-print 'expr + #:max-expr-width 72) + expr)))) + +(display-eval (define bench-size 1000000)) +(display-eval (define bench-samples 10)) + +(define (average . ns) + (/ (apply + ns) (length ns))) + +(define (generate-n n fn) + (unfold (lambda (x) (= x n)) + (lambda (x) (fn)) + (lambda (x) (+ x 1)) + 0)) + +(define-syntax benchmark + (syntax-rules () + ((_ expr) + (begin + (display "; evaluating: ") (newline) + (pretty-print 'expr + #:max-expr-width 72 + #:per-line-prefix " ") + (let* ((sample (lambda () + (gc) + (let* ((t0 (get-internal-real-time)) + (r expr) + (t1 (get-internal-real-time))) + (/ (- t1 t0) internal-time-units-per-second)))) + (samples (generate-n bench-samples sample)) + (result (apply average samples))) + (display "; average time: ") + (display (exact->inexact result)) + (display " seconds") + (newline)))))) + +(display ";;;; benchmarking creation...") (newline) + +(display-eval + (define (fector . args) + (persistent-fector (fold (lambda (v fv) (fector-push! fv v)) + (transient-fector) + args)))) + +(benchmark (apply ivector (iota bench-size))) +(benchmark (apply ivector-u32 (iota bench-size))) +(benchmark (iota bench-size)) +(benchmark (apply vector (iota bench-size))) +(benchmark (apply u32vector (iota bench-size))) +(benchmark (list->vlist (iota bench-size))) +(benchmark (apply fector (iota bench-size))) + +(display ";;;; benchmarking iteration...") (newline) + +(display-eval (define bench-ivector (apply ivector (iota bench-size)))) +(display-eval (define bench-ivector-u32 (apply ivector-u32 (iota bench-size)))) +(display-eval (define bench-list (iota bench-size))) +(display-eval (define bench-vector (apply vector (iota bench-size)))) +(display-eval (define bench-u32vector (apply u32vector (iota bench-size)))) +(display-eval (define bench-vlist (list->vlist (iota bench-size)))) +(display-eval (define bench-fector (apply fector (iota bench-size)))) +(display-eval (define bench-bytevector-u32 + (uint-list->bytevector (iota bench-size) + (native-endianness) + 4))) + +(benchmark (ivector-fold + 0 bench-ivector)) +(benchmark (ivector-u32-fold + 0 bench-ivector-u32)) +(benchmark (fold + 0 bench-list)) +(benchmark (vector-fold + 0 bench-vector)) +(benchmark (vlist-fold + 0 bench-vlist)) +(benchmark (fector-fold + bench-fector 0)) + +(display ";;;; benchmarking iteration by index...") (newline) + +(display-eval + (define-syntax iteration-by-index + (syntax-rules () + ((_ *length *ref *vector *step) + (let ((len (*length *vector))) + (let iter ((i 0) (acc 0)) + (if (< i len) + (iter (+ i *step) + (+ acc (*ref *vector i))) + acc))))))) + +(display-eval + (define-syntax iteration-by-index-truncate + (syntax-rules () + ((_ *length *ref *vector *step) + (let ((len (*length *vector))) + (let iter ((i 0) (acc 0)) + (if (< i len) + (iter (+ i *step) + (logand #xffffffffFFFFFFFF + (+ acc (*ref *vector i)))) + acc))))))) + +(benchmark (iteration-by-index ivector-length + ivector-ref + bench-ivector 1)) +(benchmark (iteration-by-index ivector-u32-length + ivector-u32-ref + bench-ivector-u32 1)) +(benchmark (iteration-by-index vector-length + vector-ref + bench-vector 1)) +(benchmark (iteration-by-index u32vector-length + u32vector-ref + bench-u32vector 1)) +(benchmark (iteration-by-index vlist-length + vlist-ref + bench-vlist 1)) +(benchmark (iteration-by-index fector-length + fector-ref + bench-fector 1)) +(benchmark (iteration-by-index bytevector-length + bytevector-u32-native-ref + bench-bytevector-u32 4)) + +(benchmark (iteration-by-index-truncate ivector-length + ivector-ref + bench-ivector 1)) +(benchmark (iteration-by-index-truncate ivector-u32-length + ivector-u32-ref + bench-ivector-u32 1)) +(benchmark (iteration-by-index-truncate vector-length + vector-ref + bench-vector 1)) +(benchmark (iteration-by-index-truncate u32vector-length + u32vector-ref + bench-u32vector 1)) +(benchmark (iteration-by-index-truncate vlist-length + vlist-ref + bench-vlist 1)) +(benchmark (iteration-by-index-truncate fector-length + fector-ref + bench-fector 1)) +(benchmark (iteration-by-index-truncate bytevector-length + bytevector-u32-native-ref + bench-bytevector-u32 4)) + +(display ";;;; benchmarking concatenation...") (newline) +(benchmark (ivector-append bench-ivector bench-ivector)) +(benchmark (ivector-u32-append bench-ivector-u32 bench-ivector-u32)) +(benchmark (append bench-list bench-list)) +(benchmark (vector-append bench-vector bench-vector)) +(benchmark (vlist-append bench-vlist bench-vlist)) |