core/basis: Rename words dealing with vocabs to loaded-vocabs or disk-vocabs because it's too confusing otherwise.

db4
Doug Coleman 2015-06-08 12:02:25 -07:00
parent a318ec1eb0
commit a4c5a748ad
40 changed files with 146 additions and 163 deletions

View File

@ -124,7 +124,7 @@ gc
"." write flush "." write flush
vocabs [ words compile-unoptimized "." write flush ] each loaded-vocab-names [ vocab-words compile-unoptimized "." write flush ] each
" done" print flush " done" print flush

View File

@ -16,7 +16,7 @@ SYMBOL: bootstrap-time
P" resource:core/io/encodings/utf16/utf16.factor" P" resource:core/io/encodings/utf16/utf16.factor"
P" resource:core/io/encodings/utf16n/utf16n.factor" [ forget ] bi@ P" resource:core/io/encodings/utf16n/utf16n.factor" [ forget ] bi@
"io.encodings.utf16" "io.encodings.utf16"
"io.encodings.utf16n" [ child-vocabs [ forget-vocab ] each ] bi@ "io.encodings.utf16n" [ loaded-child-vocab-names [ forget-vocab ] each ] bi@
] with-compilation-unit ] with-compilation-unit
] when ; ] when ;

View File

@ -12,7 +12,7 @@ IN: editors
SYMBOL: editor-class SYMBOL: editor-class
: available-editors ( -- seq ) : available-editors ( -- seq )
"editors" child-vocab-names ; "editors" loaded-child-vocab-names ;
: editor-restarts ( -- alist ) : editor-restarts ( -- alist )
available-editors available-editors

View File

@ -98,7 +98,7 @@ M: pathname url-of
dup topic>filename utf8 [ help>html write-xml ] with-file-writer ; dup topic>filename utf8 [ help>html write-xml ] with-file-writer ;
: all-vocabs-really ( -- seq ) : all-vocabs-really ( -- seq )
all-vocabs-recursive no-roots remove-redundant-prefixes all-disk-vocabs-recursive no-roots remove-redundant-prefixes
[ vocab-name "scratchpad" = ] reject ; [ vocab-name "scratchpad" = ] reject ;
: all-topics ( -- topics ) : all-topics ( -- topics )

View File

@ -17,7 +17,7 @@ M: simple-lint-error summary message>> ;
M: simple-lint-error error. summary print ; M: simple-lint-error error. summary print ;
SYMBOL: vocabs-quot SYMBOL: vocabs-quot
SYMBOL: all-vocabs SYMBOL: all-vocabs-list
SYMBOL: vocab-articles SYMBOL: vocab-articles
: check-example ( element -- ) : check-example ( element -- )
@ -110,7 +110,7 @@ SYMBOL: vocab-articles
[ "$see-also are not unique" simple-lint-error ] unless ; [ "$see-also are not unique" simple-lint-error ] unless ;
: vocab-exists? ( name -- ? ) : vocab-exists? ( name -- ? )
[ lookup-vocab ] [ all-vocabs get member? ] bi or ; [ lookup-vocab ] [ all-vocabs-list get member? ] bi or ;
: check-modules ( element -- ) : check-modules ( element -- )
\ $vocab-link swap elements [ \ $vocab-link swap elements [
@ -199,7 +199,7 @@ SYMBOL: vocab-articles
} cleave ; } cleave ;
: files>vocabs ( -- assoc ) : files>vocabs ( -- assoc )
vocabs loaded-vocab-names
[ [ [ vocab-docs-path ] keep ] H{ } map>assoc ] [ [ [ vocab-docs-path ] keep ] H{ } map>assoc ]
[ [ [ vocab-source-path ] keep ] H{ } map>assoc ] [ [ [ vocab-source-path ] keep ] H{ } map>assoc ]
bi assoc-union ; bi assoc-union ;

View File

@ -4,8 +4,6 @@ USING: assocs combinators continuations fry help
help.lint.checks help.topics io kernel namespaces parser help.lint.checks help.topics io kernel namespaces parser
sequences source-files.errors vocabs.hierarchy vocabs words sequences source-files.errors vocabs.hierarchy vocabs words
classes locals tools.errors listener ; classes locals tools.errors listener ;
FROM: help.lint.checks => all-vocabs ;
FROM: vocabs => child-vocabs ;
IN: help.lint IN: help.lint
SYMBOL: lint-failures SYMBOL: lint-failures
@ -73,7 +71,7 @@ PRIVATE>
: check-vocab ( vocab -- ) : check-vocab ( vocab -- )
"Checking " write dup write "..." print flush "Checking " write dup write "..." print flush
[ check-about ] [ check-about ]
[ words [ check-word ] each ] [ vocab-words [ check-word ] each ]
[ vocab-articles get at [ check-article ] each ] [ vocab-articles get at [ check-article ] each ]
tri ; tri ;
@ -82,9 +80,9 @@ PRIVATE>
: help-lint ( prefix -- ) : help-lint ( prefix -- )
[ [
auto-use? off auto-use? off
all-vocab-names all-vocabs set all-disk-vocab-names all-vocabs-list set
group-articles vocab-articles set group-articles vocab-articles set
child-vocabs loaded-child-vocab-names
[ check-vocab ] each [ check-vocab ] each
] with-scope ; ] with-scope ;
@ -93,7 +91,7 @@ PRIVATE>
: :lint-failures ( -- ) lint-failures get values errors. ; : :lint-failures ( -- ) lint-failures get values errors. ;
: unlinked-words ( vocab -- seq ) : unlinked-words ( vocab -- seq )
words all-word-help [ article-parent ] reject ; vocab-words all-word-help [ article-parent ] reject ;
: linked-undocumented-words ( -- seq ) : linked-undocumented-words ( -- seq )
all-words all-words

View File

@ -8,7 +8,6 @@ help.topics io io.pathnames io.styles kernel macros make
namespaces sequences sorting summary vocabs vocabs.files namespaces sequences sorting summary vocabs vocabs.files
vocabs.hierarchy vocabs.loader vocabs.metadata words vocabs.hierarchy vocabs.loader vocabs.metadata words
words.symbol ; words.symbol ;
FROM: vocabs.hierarchy => child-vocabs ;
IN: help.vocabs IN: help.vocabs
: about ( vocab -- ) : about ( vocab -- )
@ -60,7 +59,7 @@ C: <vocab-author> vocab-author
] unless-empty ; ] unless-empty ;
: describe-children ( vocab -- ) : describe-children ( vocab -- )
vocab-name child-vocabs vocab-name disk-vocabs-for-prefix
$vocab-roots ; $vocab-roots ;
: files. ( seq -- ) : files. ( seq -- )
@ -226,14 +225,14 @@ C: <vocab-author> vocab-author
: describe-words ( vocab -- ) : describe-words ( vocab -- )
{ {
{ [ dup lookup-vocab ] [ words $words ] } { [ dup lookup-vocab ] [ vocab-words $words ] }
{ [ dup find-vocab-root ] [ vocab-is-not-loaded ] } { [ dup find-vocab-root ] [ vocab-is-not-loaded ] }
[ drop ] [ drop ]
} cond ; } cond ;
: words. ( vocab -- ) : words. ( vocab -- )
last-element off last-element off
[ require ] [ words $words ] bi nl ; [ require ] [ vocab-words $words ] bi nl ;
: describe-metadata ( vocab -- ) : describe-metadata ( vocab -- )
[ [
@ -254,7 +253,7 @@ C: <vocab-author> vocab-author
} cleave ; } cleave ;
: keyed-vocabs ( str quot -- seq ) : keyed-vocabs ( str quot -- seq )
[ all-vocabs-recursive ] 2dip '[ [ all-disk-vocabs-recursive ] 2dip '[
[ _ swap @ member? ] filter no-prefixes [ _ swap @ member? ] filter no-prefixes
[ name>> ] sort-with [ name>> ] sort-with
] assoc-map ; inline ] assoc-map ; inline

View File

@ -1,18 +1,10 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences combinators fry USING: accessors assocs html.components html.forms
namespaces make classes.tuple assocs splitting words arrays io html.templates html.templates.chloe.compiler
io.files io.files.info io.encodings.utf8 io.streams.string html.templates.chloe.components html.templates.chloe.syntax
unicode.case mirrors math urls present multiline quotations xml io.encodings.utf8 io.files io.files.info kernel logging make
logging math namespaces sequences splitting words xml xml.syntax ;
xml.writer xml.syntax strings
html.forms
html
html.components
html.templates
html.templates.chloe.compiler
html.templates.chloe.components
html.templates.chloe.syntax ;
IN: html.templates.chloe IN: html.templates.chloe
TUPLE: chloe path ; TUPLE: chloe path ;

View File

@ -25,7 +25,7 @@ gl-error-log [ V{ } clone ] initialize
name>> { [ "glGetError" = not ] [ "gl" head? ] [ third LETTER? ] } 1&& ; name>> { [ "glGetError" = not ] [ "gl" head? ] [ third LETTER? ] } 1&& ;
: gl-functions ( -- words ) : gl-functions ( -- words )
"opengl.gl" lookup-vocab words [ gl-function? ] filter ; "opengl.gl" lookup-vocab vocab-words [ gl-function? ] filter ;
: annotate-gl-functions ( quot -- ) : annotate-gl-functions ( quot -- )
[ [

View File

@ -6,7 +6,7 @@ vocabs.hierarchy ;
{ "Hi" } [ "Hi" present ] unit-test { "Hi" } [ "Hi" present ] unit-test
{ "+" } [ \ + present ] unit-test { "+" } [ \ + present ] unit-test
{ "kernel" } [ "kernel" lookup-vocab present ] unit-test { "kernel" } [ "kernel" lookup-vocab present ] unit-test
{ } [ all-vocabs-recursive filter-vocabs [ present ] map drop ] unit-test { } [ disk-vocabs-recursive filter-vocabs [ present ] map drop ] unit-test
{ "1+1j" } [ C{ 1 1 } present ] unit-test { "1+1j" } [ C{ 1 1 } present ] unit-test
{ "1-1j" } [ C{ 1 -1 } present ] unit-test { "1-1j" } [ C{ 1 -1 } present ] unit-test

View File

@ -99,7 +99,7 @@ PRIVATE>
all-words name-completions ; all-words name-completions ;
: vocabs-matching ( str -- seq ) : vocabs-matching ( str -- seq )
all-vocabs-recursive filter-vocabs name-completions ; all-disk-vocabs-recursive filter-vocabs name-completions ;
: chars-matching ( str -- seq ) : chars-matching ( str -- seq )
name-map keys dup zip completions ; name-map keys dup zip completions ;

View File

@ -1,10 +1,10 @@
! Copyright (C) 2011 Doug Coleman. ! Copyright (C) 2011 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes combinators USING: accessors arrays assocs classes combinators.short-circuit
combinators.short-circuit continuations fry io kernel math continuations fry io kernel math namespaces prettyprint
namespaces prettyprint quotations sequences sequences.deep quotations sequences sequences.deep splitting strings
splitting strings tools.annotations tools.test tools.annotations tools.test.private vocabs vocabs.hierarchy
tools.test.private vocabs words words.symbol ; words words.symbol ;
IN: tools.coverage IN: tools.coverage
TUPLE: coverage-state < identity-tuple executed? ; TUPLE: coverage-state < identity-tuple executed? ;
@ -32,7 +32,7 @@ GENERIC: reset-coverage ( object -- )
".private" ?tail drop ".private" append ; ".private" ?tail drop ".private" append ;
: coverage-words ( string -- words ) : coverage-words ( string -- words )
words [ { [ primitive? not ] [ symbol? not ] [ predicate? not ] } 1&& ] filter ; vocab-words [ { [ primitive? not ] [ symbol? not ] [ predicate? not ] } 1&& ] filter ;
PRIVATE> PRIVATE>
@ -131,7 +131,7 @@ PRIVATE>
{ [ ".private" tail? ] [ ".tests" tail? ] } 1|| not ; { [ ".private" tail? ] [ ".tests" tail? ] } 1|| not ;
: test-coverage-recursively ( prefix -- assoc ) : test-coverage-recursively ( prefix -- assoc )
child-vocabs [ coverage-vocab? ] filter disk-vocabs-for-prefix [ coverage-vocab? ] filter
[ dup test-coverage ] { } map>assoc ; [ dup test-coverage ] { } map>assoc ;
: %coverage ( string -- x ) : %coverage ( string -- x )

View File

@ -115,7 +115,7 @@ M: f smart-usage drop \ f smart-usage ;
[ "No usages." print ] [ sorted-definitions. ] if-empty ; [ "No usages." print ] [ sorted-definitions. ] if-empty ;
: vocab-xref ( vocab quot: ( defspec -- seq ) -- vocabs ) : vocab-xref ( vocab quot: ( defspec -- seq ) -- vocabs )
[ [ vocab-name ] [ words [ generic? ] reject ] bi ] dip map [ [ vocab-name ] [ vocab-words [ generic? ] reject ] bi ] dip map
[ [
[ [ word? ] [ generic? not ] bi and ] filter [ [ [ word? ] [ generic? not ] bi and ] filter [
dup method? dup method?

View File

@ -245,7 +245,7 @@ IN: tools.deploy.shaker
: compiler-classes ( -- seq ) : compiler-classes ( -- seq )
{ "compiler" "stack-checker" } { "compiler" "stack-checker" }
[ child-vocabs [ words ] map concat [ class? ] filter ] [ loaded-child-vocab-names [ vocab-words ] map concat [ class? ] filter ]
map concat unique ; map concat unique ;
: prune-decision-tree ( tree classes -- ) : prune-decision-tree ( tree classes -- )
@ -304,7 +304,7 @@ IN: tools.deploy.shaker
] when ; ] when ;
: vocab-tree-globals ( except names -- words ) : vocab-tree-globals ( except names -- words )
[ child-vocabs [ words ] map concat ] map concat [ loaded-child-vocab-names [ vocab-words ] map concat ] map concat
swap [ first2 lookup-word ] map sift diff ; swap [ first2 lookup-word ] map sift diff ;
: stripped-globals ( -- seq ) : stripped-globals ( -- seq )
@ -552,7 +552,7 @@ SYMBOL: deploy-vocab
: write-vocab-manifest ( vocab-manifest-out -- ) : write-vocab-manifest ( vocab-manifest-out -- )
"Writing vocabulary manifest to " write dup print flush "Writing vocabulary manifest to " write dup print flush
vocabs "VOCABS:" prefix loaded-vocab-names "VOCABS:" prefix
deploy-libraries get [ lookup-library path>> ] map members deploy-libraries get [ lookup-library path>> ] map members
"LIBRARIES:" prefix append "LIBRARIES:" prefix append
swap utf8 set-file-lines ; swap utf8 set-file-lines ;

View File

@ -28,7 +28,7 @@ ERROR: vocab-name-contains-dot path ;
: contains-separator? ( string -- ? ) [ path-separator? ] any? ; : contains-separator? ( string -- ? ) [ path-separator? ] any? ;
: ensure-vocab-exists ( string -- string ) : ensure-vocab-exists ( string -- string )
dup vocabs member? [ no-vocab ] unless ; dup loaded-vocab-names member? [ no-vocab ] unless ;
: check-vocab-name ( string -- string ) : check-vocab-name ( string -- string )
[ ] [ ]
@ -215,7 +215,7 @@ M: object add-using ( object -- )
[ docs-header. ] [ docs-body. ] bi ; [ docs-header. ] [ docs-body. ] bi ;
: interesting-words ( vocab -- array ) : interesting-words ( vocab -- array )
words vocab-words
[ { [ "help" word-prop ] [ predicate? ] } 1|| ] reject [ { [ "help" word-prop ] [ predicate? ] } 1|| ] reject
natural-sort ; natural-sort ;

View File

@ -166,9 +166,9 @@ M: test-failure error. ( error -- )
: :test-failures ( -- ) test-failures get errors. ; : :test-failures ( -- ) test-failures get errors. ;
: test ( prefix -- ) child-vocabs test-vocabs ; : test ( prefix -- ) loaded-child-vocab-names test-vocabs ;
: test-all ( -- ) vocabs filter-don't-test test-vocabs ; : test-all ( -- ) loaded-vocab-names filter-don't-test test-vocabs ;
: test-main ( -- ) : test-main ( -- )
command-line get [ [ load ] [ test ] bi ] each ; command-line get [ [ load ] [ test ] bi ] each ;

View File

@ -6,7 +6,7 @@ IN: ui.pixel-formats
<< <<
"ui.gadgets.worlds" create-vocab drop "ui.gadgets.worlds" create-vocab drop
"world" "ui.gadgets.worlds" create drop "world" "ui.gadgets.worlds" create drop
"ui.gadgets.worlds" vocab-words use-words "ui.gadgets.worlds" vocab-words-assoc use-words
>> >>
ARTICLE: "ui.pixel-formats-attributes" "Pixel format attributes" ARTICLE: "ui.pixel-formats-attributes" "Pixel format attributes"

View File

@ -12,7 +12,7 @@ IN: vocabs.cache
\ vocab-file-contents "memoize" word-prop swap \ vocab-file-contents "memoize" word-prop swap
'[ drop first vocab-name _ = ] assoc-reject! drop '[ drop first vocab-name _ = ] assoc-reject! drop
] bi ] bi
\ all-vocabs-recursive reset-memoized \ all-disk-vocabs-recursive reset-memoized
\ all-authors reset-memoized \ all-authors reset-memoized
\ all-tags reset-memoized ; \ all-tags reset-memoized ;

View File

@ -14,13 +14,13 @@ $nl
} }
"Getting all vocabularies from disk:" "Getting all vocabularies from disk:"
{ $subsections { $subsections
all-vocabs all-disk-vocabs-by-root
all-vocabs-recursive all-disk-vocabs-recursive
} }
"Getting all vocabularies from disk whose names which match a string prefix:" "Getting all vocabularies from disk whose names which match a string prefix:"
{ $subsections { $subsections
child-vocabs disk-vocabs-for-prefix
child-vocabs-recursive disk-vocabs-recursive-for-prefix
} }
"Words for modifying output:" "Words for modifying output:"
{ $subsections { $subsections

View File

@ -4,7 +4,6 @@ USING: accessors arrays assocs combinators.short-circuit fry
io.directories io.files io.files.types io.pathnames kernel make io.directories io.files io.files.types io.pathnames kernel make
memoize namespaces sequences sorting splitting vocabs sets memoize namespaces sequences sorting splitting vocabs sets
vocabs.loader vocabs.metadata vocabs.errors ; vocabs.loader vocabs.metadata vocabs.errors ;
RENAME: child-vocabs vocabs => vocabs:child-vocabs
IN: vocabs.hierarchy IN: vocabs.hierarchy
TUPLE: vocab-prefix name ; TUPLE: vocab-prefix name ;
@ -40,33 +39,33 @@ ERROR: vocab-root-required root ;
: ensure-vocab-root/prefix ( root prefix -- root prefix ) : ensure-vocab-root/prefix ( root prefix -- root prefix )
[ ensure-vocab-root ] [ check-vocab-name ] bi* ; [ ensure-vocab-root ] [ check-vocab-name ] bi* ;
: (child-vocabs) ( root prefix -- vocabs ) : (disk-vocab-children) ( root prefix -- vocabs )
check-vocab-name check-vocab-name
[ vocab-dir append-path dup exists? [ vocab-subdirs ] [ drop { } ] if ] [ vocab-dir append-path dup exists? [ vocab-subdirs ] [ drop { } ] if ]
[ nip [ "." append '[ _ prepend ] map! ] unless-empty ] [ nip [ "." append '[ _ prepend ] map! ] unless-empty ]
[ drop '[ _ over vocab-dir? [ >vocab-link ] [ <vocab-prefix> ] if ] map! ] [ drop '[ _ over vocab-dir? [ >vocab-link ] [ <vocab-prefix> ] if ] map! ]
2tri ; 2tri ;
: ((child-vocabs-recursive)) ( root prefix -- ) : ((disk-vocabs-recursive)) ( root prefix -- )
dupd vocab-name (child-vocabs) [ % ] keep dupd vocab-name (disk-vocab-children) [ % ] keep
[ ((child-vocabs-recursive)) ] with each ; [ ((disk-vocabs-recursive)) ] with each ;
: (child-vocabs-recursive) ( root prefix -- seq ) : (disk-vocabs-recursive) ( root prefix -- seq )
[ ensure-vocab-root ] dip [ ensure-vocab-root ] dip
[ ((child-vocabs-recursive)) ] { } make ; [ ((disk-vocabs-recursive)) ] { } make ;
: no-rooted ( seq -- seq' ) [ find-vocab-root ] reject ; : no-rooted ( seq -- seq' ) [ find-vocab-root ] reject ;
: one-level-only? ( name prefix -- ? ) : one-level-only? ( name prefix -- ? )
?head [ "." split1 nip not ] [ drop f ] if ; ?head [ "." split1 nip not ] [ drop f ] if ;
: unrooted-child-vocabs ( prefix -- seq ) : unrooted-disk-vocabs ( prefix -- seq )
[ vocabs no-rooted ] dip [ loaded-vocab-names no-rooted ] dip
dup empty? [ CHAR: . suffix ] unless dup empty? [ CHAR: . suffix ] unless
'[ vocab-name _ one-level-only? ] filter ; '[ vocab-name _ one-level-only? ] filter ;
: unrooted-child-vocabs-recursive ( prefix -- seq ) : unrooted-disk-vocabs-recursive ( prefix -- seq )
vocabs:child-vocabs no-rooted ; loaded-child-vocab-names no-rooted ;
PRIVATE> PRIVATE>
@ -90,32 +89,32 @@ PRIVATE>
: filter-vocabs ( assoc -- seq ) : filter-vocabs ( assoc -- seq )
no-roots no-prefixes members ; no-roots no-prefixes members ;
: child-vocabs ( prefix -- assoc ) : disk-vocabs-for-prefix ( prefix -- assoc )
[ [ vocab-roots get ] dip '[ dup _ (child-vocabs) ] { } map>assoc ] [ [ vocab-roots get ] dip '[ dup _ (disk-vocab-children) ] { } map>assoc ]
[ unrooted-child-vocabs [ lookup-vocab ] map! f swap 2array ] [ unrooted-disk-vocabs [ lookup-vocab ] map! f swap 2array ]
bi suffix ; bi suffix ;
: all-vocabs ( -- assoc ) : all-disk-vocabs-by-root ( -- assoc )
"" child-vocabs ; "" disk-vocabs-for-prefix ;
: child-vocabs-recursive ( prefix -- assoc ) : disk-vocabs-recursive-for-prefix ( prefix -- assoc )
[ [ vocab-roots get ] dip '[ dup _ (child-vocabs-recursive) ] { } map>assoc ] [ [ vocab-roots get ] dip '[ dup _ (disk-vocabs-recursive) ] { } map>assoc ]
[ unrooted-child-vocabs-recursive [ lookup-vocab ] map! f swap 2array ] [ unrooted-disk-vocabs-recursive [ lookup-vocab ] map! f swap 2array ]
bi suffix ; bi suffix ;
MEMO: all-vocabs-recursive ( -- assoc ) MEMO: all-disk-vocabs-recursive ( -- assoc )
"" child-vocabs-recursive ; "" disk-vocabs-recursive-for-prefix ;
: all-vocab-names ( -- seq ) : all-disk-vocab-names ( -- seq )
all-vocabs-recursive filter-vocabs [ vocab-name ] map! ; all-disk-vocabs-recursive filter-vocabs [ vocab-name ] map! ;
: child-vocab-names ( prefix -- seq ) : disk-child-vocab-names ( prefix -- seq )
child-vocabs filter-vocabs [ vocab-name ] map! ; disk-vocabs-for-prefix filter-vocabs [ vocab-name ] map! ;
<PRIVATE <PRIVATE
: collect-vocabs ( quot -- seq ) : collect-vocabs ( quot -- seq )
[ all-vocabs-recursive filter-vocabs ] dip [ all-disk-vocabs-recursive filter-vocabs ] dip
gather natural-sort ; inline gather natural-sort ; inline
: maybe-include-root/prefix ( root prefix -- vocab-link/f ) : maybe-include-root/prefix ( root prefix -- vocab-link/f )
@ -127,15 +126,15 @@ MEMO: all-vocabs-recursive ( -- assoc )
PRIVATE> PRIVATE>
: vocabs-in-root/prefix ( root prefix -- seq ) : disk-vocabs-in-root/prefix ( root prefix -- seq )
[ (child-vocabs-recursive) ] [ (disk-vocabs-recursive) ]
[ maybe-include-root/prefix [ prefix ] when* ] 2bi ; [ maybe-include-root/prefix [ prefix ] when* ] 2bi ;
: vocabs-in-root ( root -- seq ) : disk-vocabs-in-root ( root -- seq )
"" vocabs-in-root/prefix ; "" disk-vocabs-in-root/prefix ;
: (load-from-root) ( root prefix -- failures ) : (load-from-root) ( root prefix -- failures )
vocabs-in-root/prefix disk-vocabs-in-root/prefix
[ don't-load? ] reject no-prefixes [ don't-load? ] reject no-prefixes
require-all ; require-all ;

View File

@ -49,7 +49,7 @@ TR: convert-separators "/\\" ".." ;
: init-vocab-monitor ( -- ) : init-vocab-monitor ( -- )
H{ } clone changed-vocabs set-global H{ } clone changed-vocabs set-global
vocabs [ changed-vocab ] each ; loaded-vocab-names [ changed-vocab ] each ;
[ [
"-no-monitors" (command-line) member? [ "-no-monitors" (command-line) member? [

View File

@ -55,7 +55,7 @@ SYMBOL: changed-vocabs
[ vocab-docs-path ] tri (to-refresh) ; [ vocab-docs-path ] tri (to-refresh) ;
: to-refresh ( prefix -- modified-sources modified-docs unchanged ) : to-refresh ( prefix -- modified-sources modified-docs unchanged )
child-vocabs [ ".private" tail? ] reject loaded-child-vocab-names [ ".private" tail? ] reject
[ [
[ [ vocab-source-modified? ] filter ] [ [ vocab-source-modified? ] filter ]
[ [ vocab-docs-modified? ] filter ] bi [ [ vocab-docs-modified? ] filter ] bi

View File

@ -27,7 +27,7 @@ architecture get asm-file parse-file
! Now we have ( syntax-quot arch-quot layouts-quot ) on the stack ! Now we have ( syntax-quot arch-quot layouts-quot ) on the stack
! Bring up a bare cross-compiling vocabulary. ! Bring up a bare cross-compiling vocabulary.
"syntax" lookup-vocab vocab-words bootstrap-syntax set "syntax" lookup-vocab vocab-words-assoc bootstrap-syntax set
H{ } clone dictionary set H{ } clone dictionary set
H{ } clone root-cache set H{ } clone root-cache set
@ -149,7 +149,7 @@ call( -- ) ! syntax-quot
"f" "syntax" lookup-word { } define-builtin "f" "syntax" lookup-word { } define-builtin
"f" "syntax" create [ not ] "predicate" set-word-prop "f" "syntax" create [ not ] "predicate" set-word-prop
"f?" "syntax" vocab-words delete-at "f?" "syntax" vocab-words-assoc delete-at
"t" "syntax" lookup-word define-singleton-class "t" "syntax" lookup-word define-singleton-class
@ -180,7 +180,7 @@ define-predicate-class
[ [ drop t ] "predicate" set-word-prop ] [ [ drop t ] "predicate" set-word-prop ]
bi bi
"object?" "kernel" vocab-words delete-at "object?" "kernel" vocab-words-assoc delete-at
! Empty class with no instances ! Empty class with no instances
"null" "kernel" create "null" "kernel" create
@ -188,7 +188,7 @@ bi
[ [ drop f ] "predicate" set-word-prop ] [ [ drop f ] "predicate" set-word-prop ]
bi bi
"null?" "kernel" vocab-words delete-at "null?" "kernel" vocab-words-assoc delete-at
"fixnum" "math" create { } define-builtin "fixnum" "math" create { } define-builtin
"fixnum" "math" create "integer>fixnum-strict" "math" create 1quotation "coercer" set-word-prop "fixnum" "math" create "integer>fixnum-strict" "math" create 1quotation "coercer" set-word-prop

View File

@ -187,7 +187,7 @@ forget-junk
[ f ] [ "vocabs.loader.test.p" lookup-vocab ] unit-test [ f ] [ "vocabs.loader.test.p" lookup-vocab ] unit-test
[ ] [ "vocabs.loader.test.p.private" require ] unit-test [ ] [ "vocabs.loader.test.p.private" require ] unit-test
[ { "foo" } ] [ "vocabs.loader.test.p" words [ name>> ] map ] unit-test [ { "foo" } ] [ "vocabs.loader.test.p" vocab-words [ name>> ] map ] unit-test
[ [
"mnop" [ "vocabs.loader.test." swap suffix forget-vocab ] each "mnop" [ "vocabs.loader.test." swap suffix forget-vocab ] each

View File

@ -1,5 +1,5 @@
USING: help.markup help.syntax strings words compiler.units USING: help.markup help.syntax strings words compiler.units
vocabs.loader ; vocabs.loader assocs ;
IN: vocabs IN: vocabs
ARTICLE: "vocabularies" "Vocabularies" ARTICLE: "vocabularies" "Vocabularies"
@ -28,13 +28,13 @@ $nl
"Looking up existing vocabularies and creating new vocabularies:" "Looking up existing vocabularies and creating new vocabularies:"
{ $subsections { $subsections
lookup-vocab lookup-vocab
child-vocabs loaded-child-vocab-names
create-vocab create-vocab
} }
"Getting words from a vocabulary:" "Getting words from a vocabulary:"
{ $subsections { $subsections
vocab-words-assoc
vocab-words vocab-words
words
all-words all-words
words-named words-named
} }
@ -47,7 +47,7 @@ ABOUT: "vocabularies"
HELP: dictionary HELP: dictionary
{ $var-description "Holds a hashtable mapping vocabulary names to vocabularies." } ; { $var-description "Holds a hashtable mapping vocabulary names to vocabularies." } ;
HELP: vocabs HELP: loaded-vocab-names
{ $values { "seq" "a sequence of strings" } } { $values { "seq" "a sequence of strings" } }
{ $description "Outputs a sequence of all defined vocabulary names." } ; { $description "Outputs a sequence of all defined vocabulary names." } ;
@ -62,12 +62,12 @@ HELP: vocab-name
{ $values { "vocab-spec" "a vocabulary specifier" } { "name" string } } { $values { "vocab-spec" "a vocabulary specifier" } { "name" string } }
{ $description "Outputs the name of a vocabulary." } ; { $description "Outputs the name of a vocabulary." } ;
HELP: vocab-words HELP: vocab-words-assoc
{ $values { "vocab-spec" "a vocabulary specifier" } { "words" "an assoc mapping strings to words" } } { $values { "vocab-spec" "a vocabulary specifier" } { "assoc/f" { $maybe assoc } } }
{ $description "Outputs the words defined in a vocabulary." } ; { $description "Outputs the words defined in a vocabulary." } ;
HELP: words HELP: vocab-words
{ $values { "vocab" string } { "seq" "a sequence of words" } } { $values { "vocab-spec" vocab-spec } { "seq" "a sequence of words" } }
{ $description "Outputs a sequence of words defined in the vocabulary, or " { $link f } " if no vocabulary with this name exists." } ; { $description "Outputs a sequence of words defined in the vocabulary, or " { $link f } " if no vocabulary with this name exists." } ;
HELP: all-words HELP: all-words
@ -95,12 +95,12 @@ HELP: create-vocab
{ $values { "name" string } { "vocab" vocab } } { $values { "name" string } { "vocab" vocab } }
{ $description "Creates a new vocabulary if one does not exist with the given name, otherwise outputs an existing vocabulary." } ; { $description "Creates a new vocabulary if one does not exist with the given name, otherwise outputs an existing vocabulary." } ;
HELP: child-vocabs HELP: loaded-child-vocab-names
{ $values { "vocab" "a vocabulary specifier" } { "seq" "a sequence of strings" } } { $values { "vocab-spec" "a vocabulary specifier" } { "seq" "a sequence of strings" } }
{ $description "Outputs all vocabularies which are conceptually under " { $snippet "vocab" } " in the hierarchy." } { $description "Outputs all vocabularies which are conceptually under " { $snippet "vocab" } " in the hierarchy." }
{ $examples { $examples
{ $unchecked-example { $unchecked-example
"\"io.streams\" child-vocabs ." "\"io.streams\" loaded-child-vocab-names ."
"{ \"io.streams.c\" \"io.streams.duplex\" \"io.streams.lines\" \"io.streams.nested\" \"io.streams.plain\" \"io.streams.string\" }" "{ \"io.streams.c\" \"io.streams.duplex\" \"io.streams.lines\" \"io.streams.nested\" \"io.streams.plain\" \"io.streams.string\" }"
} }
} ; } ;

View File

@ -44,7 +44,7 @@ M: object vocab-name check-vocab-name ;
: vocab-name* ( vocab-spec -- name ) : vocab-name* ( vocab-spec -- name )
vocab-name ".private" ?tail drop ; vocab-name ".private" ?tail drop ;
: private-vocab? ( vocab -- ? ) : private-vocab? ( vocab-spec -- ? )
vocab-name ".private" tail? ; vocab-name ".private" tail? ;
GENERIC: lookup-vocab ( vocab-spec -- vocab ) GENERIC: lookup-vocab ( vocab-spec -- vocab )
@ -53,13 +53,13 @@ M: vocab lookup-vocab ;
M: object lookup-vocab ( name -- vocab ) vocab-name dictionary get at ; M: object lookup-vocab ( name -- vocab ) vocab-name dictionary get at ;
GENERIC: vocab-words ( vocab-spec -- words ) GENERIC: vocab-words-assoc ( vocab-spec -- assoc/f )
M: vocab vocab-words words>> ; M: vocab vocab-words-assoc words>> ;
M: object vocab-words lookup-vocab vocab-words ; M: object vocab-words-assoc lookup-vocab vocab-words-assoc ;
M: f vocab-words ; M: f vocab-words-assoc ;
GENERIC: vocab-help ( vocab-spec -- help ) GENERIC: vocab-help ( vocab-spec -- help )
@ -96,18 +96,18 @@ GENERIC: vocab-changed ( vocab obj -- )
ERROR: no-vocab name ; ERROR: no-vocab name ;
: vocabs ( -- seq ) : loaded-vocab-names ( -- seq )
dictionary get keys natural-sort ; dictionary get keys natural-sort ;
: words ( vocab -- seq ) : vocab-words ( vocab-spec -- seq )
vocab-words values ; vocab-words-assoc values ;
: all-words ( -- seq ) : all-words ( -- seq )
dictionary get values [ words ] map concat ; dictionary get values [ vocab-words ] map concat ;
: words-named ( str -- seq ) : words-named ( str -- seq )
dictionary get values dictionary get values
[ vocab-words at ] with map [ vocab-words-assoc at ] with map
sift ; sift ;
: child-vocab? ( prefix name -- ? ) : child-vocab? ( prefix name -- ? )
@ -119,8 +119,8 @@ ERROR: no-vocab name ;
] if ] if
] if-empty ; ] if-empty ;
: child-vocabs ( vocab -- seq ) : loaded-child-vocab-names ( vocab-spec -- seq )
vocab-name vocabs [ child-vocab? ] with filter ; vocab-name loaded-vocab-names [ child-vocab? ] with filter ;
GENERIC: >vocab-link ( name -- vocab ) GENERIC: >vocab-link ( name -- vocab )
@ -129,7 +129,7 @@ M: vocab-spec >vocab-link ;
M: object >vocab-link dup lookup-vocab [ ] [ <vocab-link> ] ?if ; M: object >vocab-link dup lookup-vocab [ ] [ <vocab-link> ] ?if ;
: forget-vocab ( vocab -- ) : forget-vocab ( vocab -- )
[ words forget-all ] [ vocab-words forget-all ]
[ vocab-name dictionary get delete-at ] [ vocab-name dictionary get delete-at ]
[ notify-vocab-observers ] tri ; [ notify-vocab-observers ] tri ;

View File

@ -11,7 +11,7 @@ IN: words.tests
"poo" "words.tests" lookup-word execute "poo" "words.tests" lookup-word execute
] unit-test ] unit-test
[ t ] [ t vocabs [ words [ word? and ] each ] each ] unit-test [ t ] [ t loaded-vocab-names [ vocab-words [ word? and ] each ] each ] unit-test
DEFER: plist-test DEFER: plist-test
@ -41,8 +41,8 @@ DEFER: plist-test
"test-scope" "scratchpad" lookup-word name>> "test-scope" "scratchpad" lookup-word name>>
] unit-test ] unit-test
[ t ] [ vocabs array? ] unit-test [ t ] [ loaded-vocab-names array? ] unit-test
[ t ] [ vocabs [ words [ word? ] all? ] all? ] unit-test [ t ] [ loaded-vocab-names [ vocab-words [ word? ] all? ] all? ] unit-test
[ f ] [ gensym gensym = ] unit-test [ f ] [ gensym gensym = ] unit-test

View File

@ -67,7 +67,7 @@ PREDICATE: primitive < word "primitive" word-prop ;
M: primitive definer drop \ PRIMITIVE: f ; M: primitive definer drop \ PRIMITIVE: f ;
M: primitive definition drop f ; M: primitive definition drop f ;
: lookup-word ( name vocab -- word ) vocab-words at ; : lookup-word ( name vocab -- word ) vocab-words-assoc at ;
: target-word ( word -- target ) : target-word ( word -- target )
[ name>> ] [ vocabulary>> ] bi lookup-word ; [ name>> ] [ vocabulary>> ] bi lookup-word ;
@ -200,7 +200,7 @@ M: word reset-word
[ gensym dup ] 2dip define-declared ; [ gensym dup ] 2dip define-declared ;
: reveal ( word -- ) : reveal ( word -- )
dup [ name>> ] [ vocabulary>> ] bi dup vocab-words dup [ name>> ] [ vocabulary>> ] bi dup vocab-words-assoc
[ ] [ no-vocab ] ?if [ ] [ no-vocab ] ?if
set-at ; set-at ;
@ -242,7 +242,7 @@ M: word set-where swap "loc" set-word-prop ;
M: word forget* M: word forget*
dup "forgotten" word-prop [ drop ] [ dup "forgotten" word-prop [ drop ] [
[ subwords forget-all ] [ subwords forget-all ]
[ [ name>> ] [ vocabulary>> vocab-words ] bi delete-at ] [ [ name>> ] [ vocabulary>> vocab-words-assoc ] bi delete-at ]
[ t "forgotten" set-word-prop ] [ t "forgotten" set-word-prop ]
tri tri
] if ; ] if ;

View File

@ -20,7 +20,7 @@ PRIVATE>
compact-gc '[ _ run ] profile most-recent-profile-data ; compact-gc '[ _ run ] profile most-recent-profile-data ;
: find-benchmark-vocabs ( -- seq ) : find-benchmark-vocabs ( -- seq )
"benchmark" child-vocab-names "benchmark" loaded-child-vocab-names
[ find-vocab-root ] filter ; [ find-vocab-root ] filter ;
<PRIVATE <PRIVATE

View File

@ -65,7 +65,7 @@ TUPLE: x30 ;
M: x30 g ; M: x30 g ;
: my-classes ( -- seq ) : my-classes ( -- seq )
"benchmark.dispatch1" words [ tuple-class? ] filter ; "benchmark.dispatch1" vocab-words [ tuple-class? ] filter ;
: a-bunch-of-objects ( -- seq ) : a-bunch-of-objects ( -- seq )
my-classes [ new ] map ; my-classes [ new ] map ;

View File

@ -65,7 +65,7 @@ TUPLE: x30 ;
INSTANCE: x30 g INSTANCE: x30 g
: my-classes ( -- seq ) : my-classes ( -- seq )
"benchmark.dispatch5" words [ tuple-class? ] filter ; "benchmark.dispatch5" vocab-words [ tuple-class? ] filter ;
: a-bunch-of-objects ( -- seq ) : a-bunch-of-objects ( -- seq )
my-classes [ new ] map ; my-classes [ new ] map ;

View File

@ -83,7 +83,7 @@ PRIVATE>
article-location fuel-eval-set-result ; article-location fuel-eval-set-result ;
: fuel-get-vocabs ( -- ) : fuel-get-vocabs ( -- )
all-vocab-names fuel-eval-set-result ; all-disk-vocab-names fuel-eval-set-result ;
: fuel-get-vocabs/prefix ( prefix -- ) : fuel-get-vocabs/prefix ( prefix -- )
get-vocabs/prefix fuel-eval-set-result ; get-vocabs/prefix fuel-eval-set-result ;

View File

@ -1,11 +1,11 @@
! Copyright (C) 2009 Jose Antonio Ortega Ruiz. ! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators combinators.short-circuit fry USING: accessors arrays assocs combinators
fuel.eval help help.crossref help.markup help.markup.private help.topics io combinators.short-circuit fry help help.crossref help.markup
io.streams.string kernel make namespaces parser prettyprint sequences summary help.markup.private help.topics help.vocabs io io.streams.string
help.vocabs vocabs vocabs.loader vocabs.hierarchy vocabs.metadata kernel listener make namespaces parser prettyprint see sequences
vocabs.parser words see listener sets ; summary vocabs vocabs.hierarchy vocabs.metadata vocabs.parser
FROM: vocabs.hierarchy => child-vocabs ; words ;
IN: fuel.help IN: fuel.help
<PRIVATE <PRIVATE
@ -76,7 +76,7 @@ SYMBOL: describe-words
] { } assoc>map sift ; ] { } assoc>map sift ;
: fuel-vocab-children-help ( name -- element ) : fuel-vocab-children-help ( name -- element )
child-vocabs fuel-vocab-list ; inline disk-vocabs-for-prefix fuel-vocab-list ; inline
: fuel-vocab-describe-words ( name -- element ) : fuel-vocab-describe-words ( name -- element )
[ words. ] with-string-writer \ describe-words swap 2array ; inline [ words. ] with-string-writer \ describe-words swap 2array ; inline

View File

@ -34,7 +34,7 @@ IN: fuel.xref
[ drop-prefix nip empty? ] curry filter members ; [ drop-prefix nip empty? ] curry filter members ;
MEMO: (vocab-words) ( name -- seq ) MEMO: (vocab-words) ( name -- seq )
>vocab-link words [ name>> ] map ; >vocab-link vocab-words [ name>> ] map ;
: current-words ( -- seq ) : current-words ( -- seq )
manifest get manifest get
@ -53,7 +53,7 @@ PRIVATE>
: apropos-xref ( str -- seq ) words-matching keys format-xrefs group-xrefs ; : apropos-xref ( str -- seq ) words-matching keys format-xrefs group-xrefs ;
: vocab-xref ( vocab -- seq ) : vocab-xref ( vocab -- seq )
dup ".private" append [ words ] bi@ append dup ".private" append [ vocab-words ] bi@ append
format-xrefs group-xrefs ; format-xrefs group-xrefs ;
: word-location ( word -- loc ) where get-loc ; : word-location ( word -- loc ) where get-loc ;
@ -68,7 +68,7 @@ PRIVATE>
: article-location ( name -- loc ) lookup-article loc>> get-loc ; : article-location ( name -- loc ) lookup-article loc>> get-loc ;
: get-vocabs/prefix ( prefix -- seq ) all-vocab-names swap filter-prefix ; : get-vocabs/prefix ( prefix -- seq ) all-disk-vocab-names swap filter-prefix ;
: get-vocabs-words/prefix ( prefix names/f -- seq ) : get-vocabs-words/prefix ( prefix names/f -- seq )
[ vocabs-words ] [ current-words ] if* natural-sort swap filter-prefix ; [ vocabs-words ] [ current-words ] if* natural-sort swap filter-prefix ;

View File

@ -1,13 +1,10 @@
! Copyright (C) 2007, 2008, 2011 Doug Coleman. ! Copyright (C) 2007, 2008, 2011 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes classes.tuple.private
USING: accessors alien arrays assocs classes combinators.short-circuit continuations fry io kernel
classes.tuple.private combinators.short-circuit continuations kernel.private locals.backend make math math.private namespaces
fry hashtables io kernel kernel.private locals.backend make math prettyprint quotations sequences sequences.deep slots.private
math.private namespaces prettyprint quotations sequences splitting stack-checker vocabs words words.alias ;
sequences.deep shuffle slots.private splitting stack-checker
vectors vocabs words words.alias ;
IN: lint IN: lint
<PRIVATE <PRIVATE
@ -314,10 +311,10 @@ PRIVATE>
all-words run-lint dup lint. ; all-words run-lint dup lint. ;
: lint-vocab ( vocab -- seq ) : lint-vocab ( vocab -- seq )
words run-lint dup lint. ; vocab-words run-lint dup lint. ;
: lint-vocabs ( prefix -- seq ) : lint-vocabs ( prefix -- seq )
[ vocabs ] dip [ head? ] curry filter [ lint-vocab ] map ; [ loaded-vocab-names ] dip [ head? ] curry filter [ lint-vocab ] map ;
: lint-word ( word -- seq ) : lint-word ( word -- seq )
1array run-lint dup lint. ; 1array run-lint dup lint. ;

View File

@ -1,8 +1,7 @@
USING: accessors assocs bson.constants combinators.short-circuit USING: accessors assocs bson.constants bson.writer combinators
constructors continuations fry kernel mirrors mongodb.tuple.collection combinators.short-circuit constructors continuations fry
mongodb.tuple.state namespaces sequences words bson.writer combinators hashtables kernel linked-assocs mirrors mongodb.tuple.collection
hashtables linked-assocs ; mongodb.tuple.state namespaces sequences words ;
IN: mongodb.tuple.persistent IN: mongodb.tuple.persistent
SYMBOLS: object-map ; SYMBOLS: object-map ;

View File

@ -29,7 +29,7 @@ M: readline-reader prompt.
all-words [ name>> ] map! prefixed ; all-words [ name>> ] map! prefixed ;
: prefixed-vocabs ( prefix -- vocabs ) : prefixed-vocabs ( prefix -- vocabs )
all-vocabs-recursive filter-vocabs [ name>> ] map! prefixed ; disk-vocabs-recursive filter-vocabs [ name>> ] map! prefixed ;
: prefixed-colors ( prefix -- colors ) : prefixed-colors ( prefix -- colors )
named-colors prefixed ; named-colors prefixed ;

View File

@ -131,7 +131,7 @@ M: lambda-word word-noise-factor
] tabular-output ; ] tabular-output ;
: vocab-noise-factor ( vocab -- factor ) : vocab-noise-factor ( vocab -- factor )
words flatten-generics vocab-words flatten-generics
[ word-noise-factor dup 20 < [ drop 0 ] when ] map [ word-noise-factor dup 20 < [ drop 0 ] when ] map
[ 0 ] [ [ 0 ] [
[ [ sum ] [ length 5 max ] bi /i ] [ [ sum ] [ length 5 max ] bi /i ]

View File

@ -1,7 +1,7 @@
! Copyright (C) 2010 Doug Coleman. ! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: combinators combinators.smart fry kernel lexer USING: combinators combinators.smart fry kernel lexer quotations
quotations sequences sequences.generalizations slots words ; sequences sequences.generalizations slots words ;
IN: slots.syntax IN: slots.syntax
SYNTAX: slots[ SYNTAX: slots[

View File

@ -1,12 +1,11 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators.short-circuit USING: accessors arrays assocs combinators continuations fry
continuations fry kernel namespaces quotations sequences sets generic kernel locals locals.types math quotations sequences
generalizations sequences.generalizations slots locals.types sequences.generalizations sets smalltalk.ast smalltalk.classes
splitting math locals.rewrite.closures generic words combinators smalltalk.compiler.assignment smalltalk.compiler.lexenv
locals smalltalk.ast smalltalk.compiler.lexenv smalltalk.compiler.return smalltalk.selectors splitting vocabs
smalltalk.compiler.assignment smalltalk.compiler.return words ;
smalltalk.selectors smalltalk.classes ;
IN: smalltalk.compiler IN: smalltalk.compiler
GENERIC: compile-ast ( lexenv ast -- quot ) GENERIC: compile-ast ( lexenv ast -- quot )