vocabs.hierarchy: more refactoring, update existing code for new API

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

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

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 ;
 

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

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> 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 [

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
+[ ] [ all-vocabs-recursive no-roots no-prefixes [ present ] map drop ] unit-test

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 ;

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 ;
 

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 } ;

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 ;
+
 <PRIVATE
 
 : filter-unportable ( seq -- seq' )

extra/benchmark/benchmark.factor

@@ -13,7 +13,7 @@ SYMBOL: errors
 PRIVATE>
 
 : 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

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
 
 <PRIVATE
@@ -67,10 +67,10 @@ SYMBOL: describe-words
             [ fuel-vocab-help-table ] bi*
             [ 2array ] [ drop f ] if*
         ] if-empty
-    ] { } assoc>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

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 ;