Clean up tools.vocabs a bit

db4
Slava Pestov 2008-03-13 03:35:54 -05:00
parent b891555472
commit f341b2a02c
3 changed files with 13 additions and 14 deletions

View File

@ -2,27 +2,27 @@
! 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 tools.vocabs USING: kernel vocabs vocabs.loader tools.time tools.vocabs
arrays assocs io.styles io help.markup prettyprint sequences arrays assocs io.styles io help.markup prettyprint sequences
continuations debugger ; continuations debugger combinators.cleave ;
IN: benchmark IN: benchmark
: run-benchmark ( vocab -- result ) : run-benchmark ( vocab -- result )
[ dup require [ run ] benchmark ] [ error. drop f f ] recover 2array ; [ [ require ] [ [ run ] benchmark nip ] bi ] curry
[ error. f ] recover ;
: run-benchmarks ( -- assoc ) : run-benchmarks ( -- assoc )
"benchmark" all-child-vocabs values concat [ vocab-name ] map "benchmark" all-child-vocabs-seq
[ dup run-benchmark ] { } map>assoc ; [ dup run-benchmark ] { } map>assoc ;
: benchmarks. ( assoc -- ) : benchmarks. ( assoc -- )
standard-table-style [ standard-table-style [
[ [
[ "Benchmark" write ] with-cell [ "Benchmark" write ] with-cell
[ "Run time (ms)" write ] with-cell [ "Time (ms)" write ] with-cell
[ "GC time (ms)" write ] with-cell
] with-row ] with-row
[ [
[ [
swap [ dup ($vocab-link) ] with-cell [ [ 1array $vocab-link ] with-cell ]
first2 pprint-cell pprint-cell [ pprint-cell ] bi*
] with-row ] with-row
] assoc-each ] assoc-each
] tabular-output ; ] tabular-output ;

View File

@ -13,8 +13,7 @@ M: no-edit-hook summary
SYMBOL: edit-hook SYMBOL: edit-hook
: available-editors ( -- seq ) : available-editors ( -- seq )
"editors" all-child-vocabs "editors" all-child-vocabs-seq [ vocab-name ] map ;
values concat [ vocab-name ] map ;
: editor-restarts ( -- alist ) : editor-restarts ( -- alist )
available-editors available-editors

View File

@ -210,11 +210,11 @@ MEMO: all-vocabs-seq ( -- seq )
] { } map>assoc ] { } map>assoc
f rot unrooted-child-vocabs 2array add ; f rot unrooted-child-vocabs 2array add ;
: load-children ( prefix -- ) : all-child-vocabs-seq ( prefix -- assoc )
all-child-vocabs values concat vocab-roots get swap [
filter-dangerous dupd (all-child-vocabs)
require-all [ vocab-dir? ] with subset
load-failures. ; ] curry map concat ;
: map>set ( seq quot -- ) : map>set ( seq quot -- )
map concat prune natural-sort ; inline map concat prune natural-sort ; inline