7d50e61c7f
* Another big chunk of v4-require-isms * Allow `#lang framework/keybinding-lang' for keybinding files * Move hierlist sources into "mrlib/hierlist", leave stub behind svn: r10689
213 lines
8.2 KiB
Scheme
Executable File
213 lines
8.2 KiB
Scheme
Executable File
#!/bin/sh
|
|
#|
|
|
exec mzscheme -qu "$0" ${1+"$@"}
|
|
|#
|
|
|
|
(module tabulate mzscheme
|
|
(require mzlib/list
|
|
xml/xml
|
|
mzlib/cmdline)
|
|
|
|
(define base-link-filename (make-parameter #f))
|
|
(define full-page-mode (make-parameter #f))
|
|
(define include-links (make-parameter #f))
|
|
|
|
(command-line
|
|
"tabulate"
|
|
(current-command-line-arguments)
|
|
(once-each
|
|
[("--no-links") "suppress benchmark links to SVN"
|
|
(include-links #f)]
|
|
[("--multi") name "generate multiple pages for different views of data"
|
|
(base-link-filename name)]
|
|
[("--index") "generate full page with an index.html link"
|
|
(full-page-mode #t)]))
|
|
|
|
(define bm-table (make-hash-table))
|
|
(define impls (make-hash-table))
|
|
|
|
(let loop ()
|
|
(let ([l (read)])
|
|
(unless (eof-object? l)
|
|
(hash-table-put! impls (car l) #t)
|
|
(let ([t (hash-table-get bm-table (cadr l)
|
|
(lambda ()
|
|
(let ([t (make-hash-table)])
|
|
(hash-table-put! bm-table (cadr l) t)
|
|
t)))])
|
|
(hash-table-put! t (car l)
|
|
(cons (cddr l)
|
|
(hash-table-get t (car l) null))))
|
|
(loop))))
|
|
|
|
(define bm-runs (hash-table-map bm-table cons))
|
|
|
|
(define (average sel l)
|
|
(if (andmap sel l)
|
|
(round (/ (apply + (map sel l)) (length l)))
|
|
(if (ormap sel l)
|
|
(error 'tabulate "inconsistent average info")
|
|
#f)))
|
|
|
|
(define average-runs
|
|
(map (lambda (bm-run)
|
|
(cons
|
|
(car bm-run)
|
|
(map (lambda (runs)
|
|
(list (car runs)
|
|
(list (average caar (cdr runs))
|
|
(average cadar (cdr runs))
|
|
(average caddar (cdr runs)))
|
|
(cadadr runs)))
|
|
(hash-table-map (cdr bm-run) cons))))
|
|
bm-runs))
|
|
|
|
(define (symbol<? a b)
|
|
(string<? (symbol->string a)
|
|
(symbol->string b)))
|
|
|
|
(define sorted-runs
|
|
(sort average-runs (lambda (a b)
|
|
(symbol<? (car a) (car b)))))
|
|
|
|
(define sorted-impls
|
|
(sort (hash-table-map impls (lambda (k v) k)) symbol<?))
|
|
|
|
(define (ratio->string r)
|
|
(if (integer? r)
|
|
(number->string r)
|
|
(let ([s (format "~a00" (exact->inexact r))])
|
|
(car (regexp-match #rx"^[0-9]*[.].." s)))))
|
|
|
|
(define (small s)
|
|
`(font ((color "gray")
|
|
(size "-2"))
|
|
,s))
|
|
|
|
(define (lookup-color impl)
|
|
(let loop ([impls sorted-impls][odd? #f])
|
|
(if (eq? (car impls) impl)
|
|
(if odd?
|
|
"#EEEEFF"
|
|
"#DDFFDD")
|
|
(loop (cdr impls) (not odd?)))))
|
|
|
|
(define (wrap-page relative-to p)
|
|
(if (full-page-mode)
|
|
(let ([title (format "~a normalized to ~a"
|
|
(or (base-link-filename)
|
|
"results")
|
|
(or relative-to
|
|
"fastest"))])
|
|
`(html
|
|
(head (title ,title)
|
|
(body
|
|
(h1 ,title)
|
|
(p "See also " (a ((href "index.html"))
|
|
"about the benchmarks")
|
|
".")
|
|
(p ,p)))))
|
|
p))
|
|
|
|
(define forever 1000000000)
|
|
|
|
(define (generate-page relative-to)
|
|
(empty-tag-shorthand html-empty-tags)
|
|
(write-xml/content
|
|
(xexpr->xml
|
|
(wrap-page
|
|
relative-to
|
|
`(table
|
|
(tr (td nbsp)
|
|
(td ((colspan "2") (align "right"))
|
|
,(if (and (base-link-filename)
|
|
relative-to)
|
|
`(a ((href ,(format "~a.html" (base-link-filename))))
|
|
"fastest")
|
|
"fastest"))
|
|
,@(map (lambda (impl)
|
|
`(td ((colspan "2") (align "right"))
|
|
(b ,(let ([s (symbol->string impl)])
|
|
(if (and (base-link-filename)
|
|
(not (eq? impl relative-to)))
|
|
`(a ((href ,(format "~a-~a.html"
|
|
(base-link-filename)
|
|
impl)))
|
|
,s)
|
|
s)))
|
|
nbsp))
|
|
sorted-impls))
|
|
,@(map (lambda (bm-run)
|
|
(let ([fastest (apply min (map (lambda (run)
|
|
(or (caadr run) forever))
|
|
(cdr bm-run)))]
|
|
[c-fastest (apply min (map (lambda (run)
|
|
(let ([v (caddr run)])
|
|
(or (and v (positive? v) v)
|
|
forever)))
|
|
(cdr bm-run)))])
|
|
(let-values ([(base c-base)
|
|
(if relative-to
|
|
(let ([a (assq relative-to (cdr bm-run))])
|
|
(if a
|
|
(values (caadr a) (caddr a))
|
|
(values #f #f)))
|
|
(values fastest c-fastest))])
|
|
`(tr (td ,(if (include-links)
|
|
`(a ((href ,(format (string-append "http://svn.plt-scheme.org/plt/trunk/collects/"
|
|
"tests/mzscheme/benchmarks/common/~a.sch")
|
|
(car bm-run))))
|
|
,(symbol->string (car bm-run)))
|
|
(symbol->string (car bm-run))))
|
|
(td ((align "right"))
|
|
nbsp
|
|
,(small (if (= c-fastest forever)
|
|
" "
|
|
(number->string c-fastest)))
|
|
nbsp)
|
|
(td ((align "right"))
|
|
,(format "~a ms" fastest)
|
|
nbsp nbsp)
|
|
,@(apply
|
|
append
|
|
(map (lambda (impl)
|
|
(let* ([a (assq impl (cdr bm-run))]
|
|
[n (and a (caadr a))])
|
|
`(,(if (= c-fastest forever)
|
|
`(td)
|
|
`(td ((align "right")
|
|
(bgcolor ,(lookup-color impl)))
|
|
,(if (and (caddr a) c-base (positive? c-base))
|
|
(small (ratio->string (/ (caddr a) c-base)))
|
|
'"-")
|
|
nbsp))
|
|
(td ((bgcolor ,(lookup-color impl)))
|
|
,(if (and n base)
|
|
(let ([s (if (= n base)
|
|
"1"
|
|
(if (zero? base)
|
|
"*"
|
|
(ratio->string (/ n base))))])
|
|
(if (= n fastest)
|
|
`(font ((color "forestgreen")) (b ,s))
|
|
s))
|
|
"-")
|
|
nbsp))))
|
|
sorted-impls))))))
|
|
sorted-runs)))))
|
|
(newline))
|
|
|
|
(if (base-link-filename)
|
|
(for-each (lambda (impl)
|
|
(with-output-to-file (if impl
|
|
(format "~a-~a.html"
|
|
(base-link-filename)
|
|
impl)
|
|
(format "~a.html"
|
|
(base-link-filename)))
|
|
(lambda () (generate-page impl))
|
|
'truncate))
|
|
(cons #f sorted-impls))
|
|
(generate-page #f)))
|
|
|