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