(Arne Babenhauserheide)
2017-08-21: implement evaluation for the r7rs benchmarks implement evaluation for the r7rs benchmarks
diff --git a/examples/evaluate-r7rs-benchmark.w b/examples/evaluate-r7rs-benchmark.w new file mode 100755 --- /dev/null +++ b/examples/evaluate-r7rs-benchmark.w @@ -0,0 +1,105 @@ +#!/bin/sh +# -*- wisp -*- +exec guile -L ~/wisp --language=wisp -s $0 "$@" +!# + +;; Evaluate the benchmarks from ecraven at http://ecraven.github.io/r7rs-benchmarks/benchmark.html +;; Uses data from http://ecraven.github.io/r7rs-benchmarks/all.csv + +import : ice-9 rdelim + srfi srfi-1 + ice-9 pretty-print + ice-9 optargs + ice-9 i18n + +define : read-csv port + let loop : : lines '() + if : eof-object? : peek-char port + reverse : map (λ (x) (string-split x #\,)) lines + loop : cons (read-line port) lines + +define : min-alist-by-test data-by-project + let lp + : min-data '() + data-by-project data-by-project + if : null? data-by-project + . min-data + let* + : proj : car : car data-by-project + test : car : cdr : car data-by-project + time : string->number : car : cdr : cdr : car data-by-project + best : assoc-ref min-data test + lp + if : and time : or (not best) : < time best + assoc-set! min-data test time + . min-data + cdr data-by-project + +define : select-project-data data-by-project project + define : notproj? datapoint + not : string-prefix? project : car datapoint + define : only-project data + remove notproj? data + map cdr : only-project data-by-project + +define : get-multiples guile-data data-min-by-test + let lp + : gd guile-data + multiples-of-best '() + if : null? gd + remove (λ(x) (equal? #f x)) multiples-of-best + let* + : guile : string->number : car : cdr : car gd + test : car : car gd + multiple + if : not guile + . guile + / guile + or (assoc-ref data-min-by-test test) guile + lp : cdr gd + if multiple + cons multiple multiples-of-best + . multiples-of-best + + +define : help args + format #t "Usage: ~a csv-file [project-prefix]\n" (car args) + +define args : program-arguments + +when : null? : cdr args + help args + exit 1 + +define csv-file + car : cdr args + +define project-prefix + if : null? : cdr : cdr args + . "guile" + car : cdr : cdr args + +let* + : port : open-input-file csv-file + data-by-project : read-csv port + data-min-by-test : min-alist-by-test data-by-project + guile-data : select-project-data data-by-project project-prefix + display "=== Best times ===" + newline + pretty-print : sort data-min-by-test (λ (x y) (string<? (car x) (car y))) + newline + format #t "=== ~a times ===\n" : string-locale-titlecase project-prefix + newline + pretty-print : sort guile-data (λ (x y) (string<? (car x) (car y))) + newline + format #t "=== ~a slowdown ===\n" : string-locale-titlecase project-prefix + newline + pretty-print : get-multiples guile-data data-min-by-test + newline + format #t "=== ~a Geometric Mean slowdown ===\n" : string-locale-titlecase project-prefix + newline + pretty-print + expt + apply * : get-multiples guile-data data-min-by-test + / 1 : length : get-multiples guile-data data-min-by-test + newline