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
vocabs [ words compile-unoptimized "." write flush ] each
loaded-vocab-names [ vocab-words compile-unoptimized "." write flush ] each
" 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/utf16n/utf16n.factor" [ forget ] bi@
"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
] when ;

View File

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

View File

@ -98,7 +98,7 @@ M: pathname url-of
dup topic>filename utf8 [ help>html write-xml ] with-file-writer ;
: 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 ;
: all-topics ( -- topics )

View File

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

View File

@ -4,8 +4,6 @@ USING: assocs combinators continuations fry help
help.lint.checks 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
@ -73,7 +71,7 @@ PRIVATE>
: check-vocab ( vocab -- )
"Checking " write dup write "..." print flush
[ check-about ]
[ words [ check-word ] each ]
[ vocab-words [ check-word ] each ]
[ vocab-articles get at [ check-article ] each ]
tri ;
@ -82,9 +80,9 @@ PRIVATE>
: help-lint ( prefix -- )
[
auto-use? off
all-vocab-names all-vocabs set
all-disk-vocab-names all-vocabs-list set
group-articles vocab-articles set
child-vocabs
loaded-child-vocab-names
[ check-vocab ] each
] with-scope ;
@ -93,7 +91,7 @@ PRIVATE>
: :lint-failures ( -- ) lint-failures get values errors. ;
: unlinked-words ( vocab -- seq )
words all-word-help [ article-parent ] reject ;
vocab-words all-word-help [ article-parent ] reject ;
: linked-undocumented-words ( -- seq )
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
vocabs.hierarchy vocabs.loader vocabs.metadata words
words.symbol ;
FROM: vocabs.hierarchy => child-vocabs ;
IN: help.vocabs
: about ( vocab -- )
@ -60,7 +59,7 @@ C: <vocab-author> vocab-author
] unless-empty ;
: describe-children ( vocab -- )
vocab-name child-vocabs
vocab-name disk-vocabs-for-prefix
$vocab-roots ;
: files. ( seq -- )
@ -226,14 +225,14 @@ C: <vocab-author> vocab-author
: describe-words ( vocab -- )
{
{ [ dup lookup-vocab ] [ words $words ] }
{ [ dup lookup-vocab ] [ vocab-words $words ] }
{ [ dup find-vocab-root ] [ vocab-is-not-loaded ] }
[ drop ]
} cond ;
: words. ( vocab -- )
last-element off
[ require ] [ words $words ] bi nl ;
[ require ] [ vocab-words $words ] bi nl ;
: describe-metadata ( vocab -- )
[
@ -254,7 +253,7 @@ C: <vocab-author> vocab-author
} cleave ;
: keyed-vocabs ( str quot -- seq )
[ all-vocabs-recursive ] 2dip '[
[ all-disk-vocabs-recursive ] 2dip '[
[ _ swap @ member? ] filter no-prefixes
[ name>> ] sort-with
] assoc-map ; inline

View File

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

View File

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

View File

@ -6,7 +6,7 @@ vocabs.hierarchy ;
{ "Hi" } [ "Hi" present ] unit-test
{ "+" } [ \ + 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

View File

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

View File

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

View File

@ -115,7 +115,7 @@ M: f smart-usage drop \ f smart-usage ;
[ "No usages." print ] [ sorted-definitions. ] if-empty ;
: 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 [
dup method?

View File

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

View File

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

View File

@ -166,9 +166,9 @@ M: test-failure error. ( error -- )
: :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 ( -- )
command-line get [ [ load ] [ test ] bi ] each ;

View File

@ -6,7 +6,7 @@ IN: ui.pixel-formats
<<
"ui.gadgets.worlds" create-vocab 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"

View File

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

View File

@ -14,13 +14,13 @@ $nl
}
"Getting all vocabularies from disk:"
{ $subsections
all-vocabs
all-vocabs-recursive
all-disk-vocabs-by-root
all-disk-vocabs-recursive
}
"Getting all vocabularies from disk whose names which match a string prefix:"
{ $subsections
child-vocabs
child-vocabs-recursive
disk-vocabs-for-prefix
disk-vocabs-recursive-for-prefix
}
"Words for modifying output:"
{ $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
memoize namespaces sequences sorting splitting vocabs sets
vocabs.loader vocabs.metadata vocabs.errors ;
RENAME: child-vocabs vocabs => vocabs:child-vocabs
IN: vocabs.hierarchy
TUPLE: vocab-prefix name ;
@ -40,33 +39,33 @@ ERROR: vocab-root-required root ;
: ensure-vocab-root/prefix ( root prefix -- root prefix )
[ ensure-vocab-root ] [ check-vocab-name ] bi* ;
: (child-vocabs) ( root prefix -- vocabs )
: (disk-vocab-children) ( root prefix -- vocabs )
check-vocab-name
[ vocab-dir append-path dup exists? [ vocab-subdirs ] [ drop { } ] if ]
[ nip [ "." append '[ _ prepend ] map! ] unless-empty ]
[ drop '[ _ over vocab-dir? [ >vocab-link ] [ <vocab-prefix> ] if ] map! ]
2tri ;
: ((child-vocabs-recursive)) ( root prefix -- )
dupd vocab-name (child-vocabs) [ % ] keep
[ ((child-vocabs-recursive)) ] with each ;
: ((disk-vocabs-recursive)) ( root prefix -- )
dupd vocab-name (disk-vocab-children) [ % ] keep
[ ((disk-vocabs-recursive)) ] with each ;
: (child-vocabs-recursive) ( root prefix -- seq )
: (disk-vocabs-recursive) ( root prefix -- seq )
[ ensure-vocab-root ] dip
[ ((child-vocabs-recursive)) ] { } make ;
[ ((disk-vocabs-recursive)) ] { } make ;
: no-rooted ( seq -- seq' ) [ find-vocab-root ] reject ;
: one-level-only? ( name prefix -- ? )
?head [ "." split1 nip not ] [ drop f ] if ;
: unrooted-child-vocabs ( prefix -- seq )
[ vocabs no-rooted ] dip
: unrooted-disk-vocabs ( prefix -- seq )
[ loaded-vocab-names no-rooted ] dip
dup empty? [ CHAR: . suffix ] unless
'[ vocab-name _ one-level-only? ] filter ;
: unrooted-child-vocabs-recursive ( prefix -- seq )
vocabs:child-vocabs no-rooted ;
: unrooted-disk-vocabs-recursive ( prefix -- seq )
loaded-child-vocab-names no-rooted ;
PRIVATE>
@ -90,32 +89,32 @@ PRIVATE>
: filter-vocabs ( assoc -- seq )
no-roots no-prefixes members ;
: child-vocabs ( prefix -- assoc )
[ [ vocab-roots get ] dip '[ dup _ (child-vocabs) ] { } map>assoc ]
[ unrooted-child-vocabs [ lookup-vocab ] map! f swap 2array ]
: disk-vocabs-for-prefix ( prefix -- assoc )
[ [ vocab-roots get ] dip '[ dup _ (disk-vocab-children) ] { } map>assoc ]
[ unrooted-disk-vocabs [ lookup-vocab ] map! f swap 2array ]
bi suffix ;
: all-vocabs ( -- assoc )
"" child-vocabs ;
: all-disk-vocabs-by-root ( -- assoc )
"" disk-vocabs-for-prefix ;
: child-vocabs-recursive ( prefix -- assoc )
[ [ vocab-roots get ] dip '[ dup _ (child-vocabs-recursive) ] { } map>assoc ]
[ unrooted-child-vocabs-recursive [ lookup-vocab ] map! f swap 2array ]
: disk-vocabs-recursive-for-prefix ( prefix -- assoc )
[ [ vocab-roots get ] dip '[ dup _ (disk-vocabs-recursive) ] { } map>assoc ]
[ unrooted-disk-vocabs-recursive [ lookup-vocab ] map! f swap 2array ]
bi suffix ;
MEMO: all-vocabs-recursive ( -- assoc )
"" child-vocabs-recursive ;
MEMO: all-disk-vocabs-recursive ( -- assoc )
"" disk-vocabs-recursive-for-prefix ;
: all-vocab-names ( -- seq )
all-vocabs-recursive filter-vocabs [ vocab-name ] map! ;
: all-disk-vocab-names ( -- seq )
all-disk-vocabs-recursive filter-vocabs [ vocab-name ] map! ;
: child-vocab-names ( prefix -- seq )
child-vocabs filter-vocabs [ vocab-name ] map! ;
: disk-child-vocab-names ( prefix -- seq )
disk-vocabs-for-prefix filter-vocabs [ vocab-name ] map! ;
<PRIVATE
: collect-vocabs ( quot -- seq )
[ all-vocabs-recursive filter-vocabs ] dip
[ all-disk-vocabs-recursive filter-vocabs ] dip
gather natural-sort ; inline
: maybe-include-root/prefix ( root prefix -- vocab-link/f )
@ -127,15 +126,15 @@ MEMO: all-vocabs-recursive ( -- assoc )
PRIVATE>
: vocabs-in-root/prefix ( root prefix -- seq )
[ (child-vocabs-recursive) ]
: disk-vocabs-in-root/prefix ( root prefix -- seq )
[ (disk-vocabs-recursive) ]
[ maybe-include-root/prefix [ prefix ] when* ] 2bi ;
: vocabs-in-root ( root -- seq )
"" vocabs-in-root/prefix ;
: disk-vocabs-in-root ( root -- seq )
"" disk-vocabs-in-root/prefix ;
: (load-from-root) ( root prefix -- failures )
vocabs-in-root/prefix
disk-vocabs-in-root/prefix
[ don't-load? ] reject no-prefixes
require-all ;

View File

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

View File

@ -55,7 +55,7 @@ SYMBOL: changed-vocabs
[ vocab-docs-path ] tri (to-refresh) ;
: 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-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
! 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 root-cache set
@ -149,7 +149,7 @@ call( -- ) ! syntax-quot
"f" "syntax" lookup-word { } define-builtin
"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
@ -180,7 +180,7 @@ define-predicate-class
[ [ drop t ] "predicate" set-word-prop ]
bi
"object?" "kernel" vocab-words delete-at
"object?" "kernel" vocab-words-assoc delete-at
! Empty class with no instances
"null" "kernel" create
@ -188,7 +188,7 @@ bi
[ [ drop f ] "predicate" set-word-prop ]
bi
"null?" "kernel" vocab-words delete-at
"null?" "kernel" vocab-words-assoc delete-at
"fixnum" "math" create { } define-builtin
"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
[ ] [ "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

View File

@ -1,5 +1,5 @@
USING: help.markup help.syntax strings words compiler.units
vocabs.loader ;
vocabs.loader assocs ;
IN: vocabs
ARTICLE: "vocabularies" "Vocabularies"
@ -28,13 +28,13 @@ $nl
"Looking up existing vocabularies and creating new vocabularies:"
{ $subsections
lookup-vocab
child-vocabs
loaded-child-vocab-names
create-vocab
}
"Getting words from a vocabulary:"
{ $subsections
vocab-words-assoc
vocab-words
words
all-words
words-named
}
@ -47,7 +47,7 @@ ABOUT: "vocabularies"
HELP: dictionary
{ $var-description "Holds a hashtable mapping vocabulary names to vocabularies." } ;
HELP: vocabs
HELP: loaded-vocab-names
{ $values { "seq" "a sequence of strings" } }
{ $description "Outputs a sequence of all defined vocabulary names." } ;
@ -62,12 +62,12 @@ HELP: vocab-name
{ $values { "vocab-spec" "a vocabulary specifier" } { "name" string } }
{ $description "Outputs the name of a vocabulary." } ;
HELP: vocab-words
{ $values { "vocab-spec" "a vocabulary specifier" } { "words" "an assoc mapping strings to words" } }
HELP: vocab-words-assoc
{ $values { "vocab-spec" "a vocabulary specifier" } { "assoc/f" { $maybe assoc } } }
{ $description "Outputs the words defined in a vocabulary." } ;
HELP: words
{ $values { "vocab" string } { "seq" "a sequence of words" } }
HELP: vocab-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." } ;
HELP: all-words
@ -95,12 +95,12 @@ HELP: create-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." } ;
HELP: child-vocabs
{ $values { "vocab" "a vocabulary specifier" } { "seq" "a sequence of strings" } }
HELP: loaded-child-vocab-names
{ $values { "vocab-spec" "a vocabulary specifier" } { "seq" "a sequence of strings" } }
{ $description "Outputs all vocabularies which are conceptually under " { $snippet "vocab" } " in the hierarchy." }
{ $examples
{ $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\" }"
}
} ;

View File

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

View File

@ -11,7 +11,7 @@ IN: words.tests
"poo" "words.tests" lookup-word execute
] 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
@ -41,8 +41,8 @@ DEFER: plist-test
"test-scope" "scratchpad" lookup-word name>>
] unit-test
[ t ] [ vocabs array? ] unit-test
[ t ] [ vocabs [ words [ word? ] all? ] all? ] unit-test
[ t ] [ loaded-vocab-names array? ] unit-test
[ t ] [ loaded-vocab-names [ vocab-words [ word? ] all? ] all? ] 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 definition drop f ;
: lookup-word ( name vocab -- word ) vocab-words at ;
: lookup-word ( name vocab -- word ) vocab-words-assoc at ;
: target-word ( word -- target )
[ name>> ] [ vocabulary>> ] bi lookup-word ;
@ -200,7 +200,7 @@ M: word reset-word
[ gensym dup ] 2dip define-declared ;
: reveal ( word -- )
dup [ name>> ] [ vocabulary>> ] bi dup vocab-words
dup [ name>> ] [ vocabulary>> ] bi dup vocab-words-assoc
[ ] [ no-vocab ] ?if
set-at ;
@ -242,7 +242,7 @@ M: word set-where swap "loc" set-word-prop ;
M: word forget*
dup "forgotten" word-prop [ drop ] [
[ subwords forget-all ]
[ [ name>> ] [ vocabulary>> vocab-words ] bi delete-at ]
[ [ name>> ] [ vocabulary>> vocab-words-assoc ] bi delete-at ]
[ t "forgotten" set-word-prop ]
tri
] if ;

View File

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

View File

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

View File

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

View File

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

View File

@ -1,11 +1,11 @@
! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators combinators.short-circuit fry
fuel.eval help help.crossref help.markup help.markup.private help.topics io
io.streams.string kernel make namespaces parser prettyprint sequences summary
help.vocabs vocabs vocabs.loader vocabs.hierarchy vocabs.metadata
vocabs.parser words see listener sets ;
FROM: vocabs.hierarchy => child-vocabs ;
USING: accessors arrays assocs combinators
combinators.short-circuit fry help help.crossref help.markup
help.markup.private help.topics help.vocabs io io.streams.string
kernel listener make namespaces parser prettyprint see sequences
summary vocabs vocabs.hierarchy vocabs.metadata vocabs.parser
words ;
IN: fuel.help
<PRIVATE
@ -76,7 +76,7 @@ SYMBOL: describe-words
] { } assoc>map sift ;
: 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 )
[ 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 ;
MEMO: (vocab-words) ( name -- seq )
>vocab-link words [ name>> ] map ;
>vocab-link vocab-words [ name>> ] map ;
: current-words ( -- seq )
manifest get
@ -53,7 +53,7 @@ PRIVATE>
: apropos-xref ( str -- seq ) words-matching keys format-xrefs group-xrefs ;
: vocab-xref ( vocab -- seq )
dup ".private" append [ words ] bi@ append
dup ".private" append [ vocab-words ] bi@ append
format-xrefs group-xrefs ;
: word-location ( word -- loc ) where get-loc ;
@ -68,7 +68,7 @@ PRIVATE>
: 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 )
[ vocabs-words ] [ current-words ] if* natural-sort swap filter-prefix ;

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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