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 ;
   6 IN: benchmark
   7
   8 <PRIVATE
   9
  10 SYMBOL: timings
  11 SYMBOL: errors
  12
  13 PRIVATE>
  14
  15 : run-benchmark ( vocab -- )
  16     [ "=== " write print flush ] [
  17         [ [ require ] [ gc [ run ] benchmark ] [ ] tri timings ]
  18         [ swap errors ]
  19         recover get set-at
  20     ] bi ;
  21
  22 : run-benchmarks ( -- timings errors )
  23     [
  24         V{ } clone timings set
  25         V{ } clone errors set
  26         "benchmark" child-vocab-names
  27         [ run-benchmark ] each
  28         timings get
  29         errors get
  30     ] with-scope ;
  31
  32 : timings. ( assocs -- )
  33     standard-table-style [
  34         [
  35             [ "Benchmark" write ] with-cell
  36             [ "Time (seconds)" write ] with-cell
  37         ] with-row
  38         [
  39             [
  40                 [ [ 1array $vocab-link ] with-cell ]
  41                 [ 1000000 /f pprint-cell ]
  42                 bi*
  43             ] with-row
  44         ] assoc-each
  45     ] tabular-output nl ;
  46
  47 : benchmark-errors. ( errors -- )
  48     [
  49         [ "=== " write vocab-name print ]
  50         [ error. ]
  51         bi*
  52     ] assoc-each ;
  53
  54 : benchmarks ( -- )
  55     run-benchmarks [ timings. ] [ benchmark-errors. ] bi* ;
  56
  57 MAIN: benchmarks
  58