From 04900a7fa1aeb6f680fbfe23d98af586e49b1c2a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 6 Jul 2009 04:55:23 -0500 Subject: [PATCH] vocabs.hierarchy: more refactoring, update existing code for new API --- basis/editors/editors.factor | 5 +++-- basis/help/apropos/apropos.factor | 3 ++- basis/help/html/html.factor | 10 ---------- basis/help/lint/lint.factor | 3 ++- basis/help/vocabs/vocabs.factor | 6 ++++-- basis/present/present-tests.factor | 2 +- basis/tools/completion/completion.factor | 2 +- basis/vocabs/cache/cache.factor | 2 +- basis/vocabs/hierarchy/hierarchy-docs.factor | 3 +++ basis/vocabs/hierarchy/hierarchy.factor | 16 ++++++++++++++++ extra/benchmark/benchmark.factor | 4 ++-- extra/fuel/help/help.factor | 6 +++--- extra/fuel/xref/xref.factor | 2 +- 13 files changed, 39 insertions(+), 25 deletions(-) diff --git a/basis/editors/editors.factor b/basis/editors/editors.factor index f81490bcf2..da6a589031 100644 --- a/basis/editors/editors.factor +++ b/basis/editors/editors.factor @@ -3,8 +3,9 @@ USING: parser lexer kernel namespaces sequences definitions io.files io.backend io.pathnames io summary continuations tools.crossref vocabs.hierarchy prettyprint source-files -source-files.errors assocs vocabs vocabs.loader splitting +source-files.errors assocs vocabs.loader splitting accessors debugger help.topics ; +FROM: vocabs => vocab-name >vocab-link ; IN: editors TUPLE: no-edit-hook ; @@ -15,7 +16,7 @@ M: no-edit-hook summary SYMBOL: edit-hook : available-editors ( -- seq ) - "editors" all-child-vocabs-seq [ vocab-name ] map ; + "editors" child-vocabs no-roots no-prefixes [ vocab-name ] map ; : editor-restarts ( -- alist ) available-editors diff --git a/basis/help/apropos/apropos.factor b/basis/help/apropos/apropos.factor index 63cbcb3f1e..3bcc815191 100644 --- a/basis/help/apropos/apropos.factor +++ b/basis/help/apropos/apropos.factor @@ -42,7 +42,8 @@ M: more-completions article-content [ dup name>> >lower ] { } map>assoc ; : vocab-candidates ( -- candidates ) - all-vocabs-seq [ dup vocab-name >lower ] { } map>assoc ; + all-vocabs-recursive no-roots no-prefixes + [ dup vocab-name >lower ] { } map>assoc ; : help-candidates ( seq -- candidates ) [ [ >link ] [ article-title >lower ] bi ] { } map>assoc diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index c2f1ddf2c6..84f708a687 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -72,16 +72,6 @@ M: topic url-of topic>filename ; : generate-help-file ( topic -- ) dup topic>filename utf8 [ help>html write-xml ] with-file-writer ; -: remove-redundant-prefixes ( seq -- seq' ) - #! Hack. - [ vocab-prefix? ] partition - [ - [ vocab-name ] map unique - '[ name>> _ key? not ] filter - [ name>> vocab-link boa ] map - ] keep - append ; - : all-vocabs-really ( -- seq ) all-vocabs >hashtable f over delete-at no-roots remove-redundant-prefixes ; diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor index 1fb836427a..e0cea42b4f 100755 --- a/basis/help/lint/lint.factor +++ b/basis/help/lint/lint.factor @@ -5,6 +5,7 @@ help.topics io kernel namespaces parser sequences source-files.errors vocabs.hierarchy vocabs words classes locals tools.errors listener ; FROM: help.lint.checks => all-vocabs ; +FROM: vocabs => child-vocabs ; IN: help.lint SYMBOL: lint-failures @@ -79,7 +80,7 @@ PRIVATE> : help-lint ( prefix -- ) [ auto-use? off - all-vocabs-seq [ vocab-name ] map all-vocabs set + all-vocab-names all-vocabs set group-articles vocab-articles set child-vocabs [ check-vocab ] each diff --git a/basis/help/vocabs/vocabs.factor b/basis/help/vocabs/vocabs.factor index b23143e572..7d99493691 100644 --- a/basis/help/vocabs/vocabs.factor +++ b/basis/help/vocabs/vocabs.factor @@ -8,6 +8,7 @@ help.topics io io.files io.pathnames io.styles kernel macros make namespaces prettyprint sequences sets sorting summary vocabs vocabs.files vocabs.hierarchy vocabs.loader vocabs.metadata words words.symbol definitions.icons ; +FROM: vocabs.hierarchy => child-vocabs ; IN: help.vocabs : about ( vocab -- ) @@ -35,7 +36,7 @@ IN: help.vocabs $heading ; : $vocabs ( seq -- ) - [ vocab-row ] map vocab-headings prefix $table ; + convert-prefixes [ vocab-row ] map vocab-headings prefix $table ; : $vocab-roots ( assoc -- ) [ @@ -67,7 +68,8 @@ C: vocab-author ] unless-empty ; : describe-children ( vocab -- ) - vocab-name all-child-vocabs $vocab-roots ; + vocab-name child-vocabs + $vocab-roots ; : files. ( seq -- ) snippet-style get [ diff --git a/basis/present/present-tests.factor b/basis/present/present-tests.factor index e908fd8147..96aa7b24f2 100644 --- a/basis/present/present-tests.factor +++ b/basis/present/present-tests.factor @@ -5,4 +5,4 @@ USING: tools.test vocabs.hierarchy present math vocabs sequences kernel ; [ "Hi" ] [ "Hi" present ] unit-test [ "+" ] [ \ + present ] unit-test [ "kernel" ] [ "kernel" vocab present ] unit-test -[ ] [ all-vocabs-seq [ present ] map drop ] unit-test \ No newline at end of file +[ ] [ all-vocabs-recursive no-roots no-prefixes [ present ] map drop ] unit-test \ No newline at end of file diff --git a/basis/tools/completion/completion.factor b/basis/tools/completion/completion.factor index c8fd3a6658..fb664c495c 100644 --- a/basis/tools/completion/completion.factor +++ b/basis/tools/completion/completion.factor @@ -75,7 +75,7 @@ IN: tools.completion all-words name-completions ; : vocabs-matching ( str -- seq ) - all-vocabs-seq name-completions ; + all-vocabs-recursive no-roots no-prefixes name-completions ; : chars-matching ( str -- seq ) name-map keys dup zip completions ; diff --git a/basis/vocabs/cache/cache.factor b/basis/vocabs/cache/cache.factor index 63a8d6d292..24ccd391f1 100644 --- a/basis/vocabs/cache/cache.factor +++ b/basis/vocabs/cache/cache.factor @@ -7,7 +7,7 @@ IN: vocabs.cache : reset-cache ( -- ) root-cache get-global clear-assoc \ vocab-file-contents reset-memoized - \ all-vocabs-seq reset-memoized + \ all-vocabs-recursive reset-memoized \ all-authors reset-memoized \ all-tags reset-memoized ; diff --git a/basis/vocabs/hierarchy/hierarchy-docs.factor b/basis/vocabs/hierarchy/hierarchy-docs.factor index be719975c1..8eb39732c0 100644 --- a/basis/vocabs/hierarchy/hierarchy-docs.factor +++ b/basis/vocabs/hierarchy/hierarchy-docs.factor @@ -13,6 +13,9 @@ $nl "Getting all vocabularies from disk whose names which match a string prefix:" { $subsection child-vocabs } { $subsection child-vocabs-recursive } +"Words for modifying output:" +{ $subsection no-roots } +{ $subsection no-prefixes } "Getting " { $link "vocabs.metadata" } " for all vocabularies from disk:" { $subsection all-tags } { $subsection all-authors } ; diff --git a/basis/vocabs/hierarchy/hierarchy.factor b/basis/vocabs/hierarchy/hierarchy.factor index 6e6dc9cb7e..b9f9bb2e9b 100644 --- a/basis/vocabs/hierarchy/hierarchy.factor +++ b/basis/vocabs/hierarchy/hierarchy.factor @@ -58,6 +58,19 @@ PRIVATE> : no-prefixes ( seq -- seq' ) [ vocab-prefix? not ] filter ; +: convert-prefixes ( seq -- seq' ) + [ dup vocab-prefix? [ name>> vocab-link boa ] when ] map ; + +: remove-redundant-prefixes ( seq -- seq' ) + #! Hack. + [ vocab-prefix? ] partition + [ + [ vocab-name ] map unique + '[ name>> _ key? not ] filter + convert-prefixes + ] keep + append ; + : no-roots ( assoc -- seq ) values concat ; : child-vocabs ( prefix -- assoc ) @@ -79,6 +92,9 @@ MEMO: all-vocabs-recursive ( -- assoc ) : all-vocab-names ( -- seq ) all-vocabs-recursive no-roots no-prefixes [ vocab-name ] map ; +: child-vocab-names ( prefix -- seq ) + child-vocabs no-roots no-prefixes [ vocab-name ] map ; + : run-benchmark ( vocab -- ) - [ "=== " write vocab-name print flush ] [ + [ "=== " write print flush ] [ [ [ require ] [ gc [ run ] benchmark ] [ ] tri timings ] [ swap errors ] recover get set-at @@ -23,7 +23,7 @@ PRIVATE> [ V{ } clone timings set V{ } clone errors set - "benchmark" all-child-vocabs-seq + "benchmark" child-vocab-names [ run-benchmark ] each timings get errors get diff --git a/extra/fuel/help/help.factor b/extra/fuel/help/help.factor index f20e67f9bc..dcf5d69a74 100644 --- a/extra/fuel/help/help.factor +++ b/extra/fuel/help/help.factor @@ -6,7 +6,7 @@ help.markup help.topics io io.streams.string kernel make namespaces parser prettyprint sequences summary help.vocabs vocabs vocabs.loader vocabs.hierarchy vocabs.metadata words see listener ; - +FROM: vocabs.hierarchy => child-vocabs ; IN: fuel.help map [ ] filter ; + ] { } assoc>map sift ; : fuel-vocab-children-help ( name -- element ) - all-child-vocabs fuel-vocab-list ; inline + child-vocabs fuel-vocab-list ; inline : fuel-vocab-describe-words ( name -- element ) [ words. ] with-string-writer \ describe-words swap 2array ; inline diff --git a/extra/fuel/xref/xref.factor b/extra/fuel/xref/xref.factor index 608667bae7..86aa215e21 100644 --- a/extra/fuel/xref/xref.factor +++ b/extra/fuel/xref/xref.factor @@ -64,7 +64,7 @@ PRIVATE> : article-location ( name -- loc ) article loc>> get-loc ; -: get-vocabs ( -- seq ) all-vocabs-seq [ vocab-name ] map ; +: get-vocabs ( -- seq ) all-vocab-names ; : get-vocabs/prefix ( prefix -- seq ) get-vocabs swap filter-prefix ;