1 ! Copyright (C) 2007, 2009 Slava Pestov.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: arrays assocs command-line continuations debugger
4 formatting help.markup io io.styles kernel math memory
5 namespaces sequences tools.profiler.sampling tools.test
6 tools.time vocabs.hierarchy vocabs.loader ;
9 SYMBOL: benchmarks-disabled?
11 : run-timing-benchmark ( vocab -- time )
12 5 swap '[ gc [ _ run ] benchmark ] replicate minimum ;
14 : run-profile-benchmark ( vocab -- profile )
15 compact-gc '[ _ run ] profile most-recent-profile-data ;
17 : all-benchmark-vocabs ( -- seq )
18 "benchmark" disk-child-vocab-names [ find-vocab-root ] filter ;
20 : find-benchmark-vocabs ( -- seq )
21 benchmarks-disabled? get [
22 "benchmarks-disabled? is true, not benchmarking anything!" print
25 command-line get [ all-benchmark-vocabs ] when-empty
30 : write-header ( str -- )
33 : run-benchmark ( vocab quot: ( vocab -- res ) -- result ok? )
34 over write-header '[ _ @ t ] [
35 f f f <test-failure> f
40 : run-benchmarks ( benchmarks quot: ( vocab -- res ) -- results errors )
41 '[ dup _ run-benchmark 3array ] map
42 [ third ] partition [ [ 2 head ] map ] bi@ ; inline
44 : run-profile-benchmarks ( -- results errors )
45 find-benchmark-vocabs [ run-profile-benchmark ] run-benchmarks ;
47 : run-timing-benchmarks ( -- results errors )
48 find-benchmark-vocabs [ run-timing-benchmark ] run-benchmarks ;
50 : timings. ( assoc -- )
51 standard-table-style [
53 [ "Benchmark" write ] with-cell
54 [ "Time (seconds)" write ] with-cell
58 [ [ 1array $vocab-link ] with-cell ]
59 [ 1,000,000,000 /f [ "%.3f" printf ] with-cell ]
65 : benchmark-errors. ( assoc -- )
67 [ write-header ] [ error. ] bi*
70 : timing-benchmarks ( -- )
71 run-timing-benchmarks [ timings. ] [ benchmark-errors. ] bi* ;
73 MAIN: timing-benchmarks