extra/benchmark/benchmark.factor

   1 ! Copyright (C) 2007, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel vocabs vocabs.loader tools.time vocabs.hierarchy
   4 arrays assocs io.styles io help.markup prettyprint sequences
   5 continuations debugger math namespaces memory fry ;
   6 IN: benchmark
   7
   8 <PRIVATE
   9
  10 SYMBOL: timings
  11 SYMBOL: errors
  12
  13 PRIVATE>
  14
  15 : run-benchmark ( vocab -- time )
  16     [ 5 ] dip '[ gc [ _ run ] benchmark ] replicate infimum ;
  17
  18 <PRIVATE
  19
  20 : record-benchmark ( vocab -- )
  21     [ "=== " write print flush ] [
  22         [ [ require ] [ run-benchmark ] [ ] tri timings ]
  23         [ swap errors ]
  24         recover get set-at
  25     ] bi ;
  26
  27 PRIVATE>
  28
  29 : run-benchmarks ( -- timings errors )
  30     [
  31         V{ } clone timings set
  32         V{ } clone errors set
  33         "benchmark" child-vocab-names
  34         [ find-vocab-root ] filter
  35         [ record-benchmark ] each
  36         timings get
  37         errors get
  38     ] with-scope ;
  39
  40 : timings. ( assocs -- )
  41     standard-table-style [
  42         [
  43             [ "Benchmark" write ] with-cell
  44             [ "Time (seconds)" write ] with-cell
  45         ] with-row
  46         [
  47             [
  48                 [ [ 1array $vocab-link ] with-cell ]
  49                 [ 1,000,000,000 /f pprint-cell ]
  50                 bi*
  51             ] with-row
  52         ] assoc-each
  53     ] tabular-output nl ;
  54
  55 : benchmark-errors. ( errors -- )
  56     [
  57         [ "=== " write vocab-name print ]
  58         [ error. ]
  59         bi*
  60     ] assoc-each ;
  61
  62 : benchmarks ( -- )
  63     run-benchmarks [ timings. ] [ benchmark-errors. ] bi* ;
  64
  65 MAIN: benchmarks
  66