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

db4
Slava Pestov 2009-07-06 04:55:23 -05:00
parent bcdd94d50a
commit daed003f33
13 changed files with 39 additions and 25 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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' )

View File

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

View File

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

View File

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