steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

benchmark: Add a way to run a profile for each benchmark vocabulary.

db4
Doug Coleman 2011-11-21 13:42:49 -08:00
parent 9b73ecdf70
commit 857fc50fff
2 changed files with 43 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
extra/benchmark/benchmark.factor
View File

@ -1,41 +1,58 @@
! Copyright (C) 2007, 2009 Slava Pestov. ! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel vocabs vocabs.loader tools.time vocabs.hierarchy USING: arrays assocs continuations debugger fry help.markup io
arrays assocs io.styles io help.markup prettyprint sequences io.styles kernel math memory namespaces prettyprint sequences
continuations debugger math namespaces memory fry ; tools.profiler.sampling tools.time vocabs vocabs.hierarchy
vocabs.loader ;
IN: benchmark IN: benchmark
<PRIVATE <PRIVATE
SYMBOL: timings SYMBOL: results
SYMBOL: errors SYMBOL: errors
PRIVATE> PRIVATE>
: run-benchmark ( vocab -- time ) : run-timing-benchmark ( vocab -- time )
[ 5 ] dip '[ gc [ _ run ] benchmark ] replicate infimum ; [ 5 ] dip '[ gc [ _ run ] benchmark ] replicate infimum ;
: run-profile-benchmark ( vocab -- profile )
compact-gc '[ _ run ] profile most-recent-profile-data ;
: find-benchmark-vocabs ( -- seq )
"benchmark" child-vocab-names
[ find-vocab-root ] filter randomize 2 head ;
<PRIVATE <PRIVATE
: record-benchmark ( vocab -- ) : print-record-header ( vocab -- )
[ "=== " write print flush ] [ "=== " write print flush ;
[ [ require ] [ run-benchmark ] [ ] tri timings ]
: run-benchmark ( vocab quot -- )
[ drop print-record-header ] [
'[
_ [ [ require ] _ [ ] tri results ]
[ swap errors ] [ swap errors ]
recover get set-at recover get set-at
] bi ; ] call
] 2bi ; inline
: run-benchmarks ( quot -- results errors )
'[
results errors
[ [ V{ } clone swap set ] bi@ ]
[ 2drop find-benchmark-vocabs [ _ run-benchmark ] each ]
[ [ get ] bi@ ]
2tri
] with-scope ; inline
PRIVATE> PRIVATE>
: run-benchmarks ( -- timings errors ) : run-timing-benchmarks ( -- results errors )
[ [ run-timing-benchmark ] run-benchmarks ;
V{ } clone timings set
V{ } clone errors set : run-profile-benchmarks ( -- results errors )
"benchmark" child-vocab-names [ run-profile-benchmark ] run-benchmarks ;
[ find-vocab-root ] filter
[ record-benchmark ] each
timings get
errors get
] with-scope ;
: timings. ( assocs -- ) : timings. ( assocs -- )
standard-table-style [ standard-table-style [
@ -59,8 +76,8 @@ PRIVATE>
bi* bi*
] assoc-each ; ] assoc-each ;
: benchmarks ( -- ) : timing-benchmarks ( -- )
run-benchmarks [ timings. ] [ benchmark-errors. ] bi* ; run-timing-benchmarks
[ timings. ] [ benchmark-errors. ] bi* ;
MAIN: benchmarks
MAIN: timing-benchmarks

2
extra/mason/test/test.factor
View File

@ -40,7 +40,7 @@ M: method word-vocabulary "method-generic" word-prop word-vocabulary ;
do-step ; do-step ;
: do-benchmarks ( -- ) : do-benchmarks ( -- )
run-benchmarks run-timing-benchmarks
[ benchmarks-file to-file ] [ [ benchmarks-file to-file ] [
[ keys benchmark-error-vocabs-file to-file ] [ keys benchmark-error-vocabs-file to-file ]
[ benchmark-error-messages-file utf8 [ benchmark-errors. ] with-file-writer ] bi [ benchmark-error-messages-file utf8 [ benchmark-errors. ] with-file-writer ] bi