More work on auto-use
parent
5494f61df9
commit
274655e77c
|
@ -5,6 +5,7 @@ hashtables namespaces make parser prettyprint sequences strings
|
|||
io.styles vectors words math sorting splitting classes slots fry
|
||||
sets vocabs help.stylesheet help.topics vocabs.loader quotations
|
||||
combinators see present ;
|
||||
FROM: prettyprint.sections => with-pprint ;
|
||||
IN: help.markup
|
||||
|
||||
PREDICATE: simple-element < array
|
||||
|
@ -348,8 +349,6 @@ M: f ($instance)
|
|||
drop
|
||||
"Throws an error if the I/O operation fails." $errors ;
|
||||
|
||||
FROM: prettyprint.private => with-pprint ;
|
||||
|
||||
: $prettyprinting-note ( children -- )
|
||||
drop {
|
||||
"This word should only be called from inside the "
|
||||
|
|
|
@ -7,8 +7,7 @@ USING: vocabs.prettyprint tools.test io.streams.string multiline eval ;
|
|||
<< manifest get pprint-manifest >> "> ;
|
||||
|
||||
[
|
||||
<" USING: kernel namespaces syntax vocabs.parser
|
||||
vocabs.prettyprint ;">
|
||||
<" USING: kernel namespaces vocabs.parser vocabs.prettyprint ;">
|
||||
]
|
||||
[ [ manifest-test-1 eval( -- ) ] with-string-writer ] unit-test
|
||||
|
||||
|
@ -19,8 +18,7 @@ vocabs.prettyprint ;">
|
|||
<< manifest get pprint-manifest >> "> ;
|
||||
|
||||
[
|
||||
<" USING: kernel namespaces syntax vocabs.parser
|
||||
vocabs.prettyprint ;
|
||||
<" USING: kernel namespaces vocabs.parser vocabs.prettyprint ;
|
||||
IN: vocabs.prettyprint.tests">
|
||||
]
|
||||
[ [ manifest-test-2 eval( -- ) ] with-string-writer ] unit-test
|
||||
|
@ -36,8 +34,7 @@ IN: vocabs.prettyprint.tests">
|
|||
<< manifest get pprint-manifest >> "> ;
|
||||
|
||||
[
|
||||
<" USING: kernel namespaces syntax vocabs.parser
|
||||
vocabs.prettyprint ;
|
||||
<" USING: kernel namespaces vocabs.parser vocabs.prettyprint ;
|
||||
FROM: math => + - ;
|
||||
QUALIFIED: system
|
||||
QUALIFIED-WITH: assocs a
|
||||
|
|
|
@ -77,8 +77,8 @@ PRIVATE>
|
|||
nl
|
||||
{ { font-style bold } { font-name "sans-serif" } } [
|
||||
"Restarts were invoked adding vocabularies to the search path." print
|
||||
"To avoid doing this in the future, add the following USING:" print
|
||||
"and IN: forms at the top of the source file:" print nl
|
||||
"To avoid doing this in the future, add the following forms" print
|
||||
"at the top of the source file:" print nl
|
||||
] with-style
|
||||
{ { page-color T{ rgba f 0.8 0.8 0.8 1.0 } } }
|
||||
[ manifest get pprint-manifest ] with-nesting
|
||||
|
|
|
@ -38,17 +38,13 @@ M: parsing-word stack-effect drop (( parsed -- parsed )) ;
|
|||
|
||||
: CREATE-WORD ( -- word ) CREATE dup reset-generic ;
|
||||
|
||||
SYMBOL: amended-use
|
||||
|
||||
SYMBOL: auto-use?
|
||||
|
||||
: no-word-restarted ( restart-value -- word )
|
||||
dup word? [
|
||||
dup vocabulary>>
|
||||
[ use-vocab ]
|
||||
[ amended-use get dup [ push ] [ 2drop ] if ]
|
||||
[ "Added \"" "\" vocabulary to search path" surround note. ]
|
||||
tri
|
||||
[ auto-use-vocab ]
|
||||
[ "Added \"" "\" vocabulary to search path" surround note. ] bi
|
||||
] [ create-in ] if ;
|
||||
|
||||
: no-word ( name -- newword )
|
||||
|
@ -198,9 +194,8 @@ print-use-hook [ [ ] ] initialize
|
|||
|
||||
: parse-fresh ( lines -- quot )
|
||||
[
|
||||
V{ } clone amended-use set
|
||||
parse-lines
|
||||
amended-use get empty? [ print-use-hook get call( -- ) ] unless
|
||||
auto-used? [ print-use-hook get call( -- ) ] when
|
||||
] with-file-vocabs ;
|
||||
|
||||
: parsing-file ( file -- )
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs hashtables kernel namespaces sequences
|
||||
sets strings vocabs sorting accessors arrays compiler.units
|
||||
combinators vectors splitting continuations ;
|
||||
combinators vectors splitting continuations math ;
|
||||
IN: vocabs.parser
|
||||
|
||||
ERROR: no-word-error name ;
|
||||
|
@ -12,22 +12,28 @@ TUPLE: manifest
|
|||
current-vocab
|
||||
{ search-vocabs vector }
|
||||
{ qualified-vocabs vector }
|
||||
{ extra-words vector } ;
|
||||
{ extra-words vector }
|
||||
{ auto-used vector } ;
|
||||
|
||||
: <manifest> ( -- manifest )
|
||||
manifest new
|
||||
V{ } clone >>search-vocabs
|
||||
V{ } clone >>qualified-vocabs
|
||||
V{ } clone >>extra-words ;
|
||||
V{ } clone >>extra-words
|
||||
V{ } clone >>auto-used ;
|
||||
|
||||
M: manifest clone
|
||||
call-next-method
|
||||
[ clone ] change-search-vocabs
|
||||
[ clone ] change-qualified-vocabs
|
||||
[ clone ] change-extra-words ;
|
||||
[ clone ] change-extra-words
|
||||
[ clone ] change-auto-used ;
|
||||
|
||||
TUPLE: extra-words words ;
|
||||
|
||||
M: extra-words equal?
|
||||
over extra-words? [ [ words>> ] bi@ eq? ] [ 2drop f ] if ;
|
||||
|
||||
C: <extra-words> extra-words
|
||||
|
||||
<PRIVATE
|
||||
|
@ -83,6 +89,11 @@ TUPLE: no-current-vocab ;
|
|||
|
||||
: use-vocab ( vocab -- ) (use-vocab) push ;
|
||||
|
||||
: auto-use-vocab ( vocab -- )
|
||||
[ use-vocab ] [ manifest get auto-used>> push ] bi ;
|
||||
|
||||
: auto-used? ( -- ? ) manifest get auto-used>> length 0 > ;
|
||||
|
||||
: unuse-vocab ( vocab -- ) (use-vocab) delq ;
|
||||
|
||||
: only-use-vocabs ( vocabs -- )
|
||||
|
@ -128,7 +139,7 @@ TUPLE: rename word vocab words ;
|
|||
|
||||
: use-words ( assoc -- ) (use-words) push ;
|
||||
|
||||
: unuse-words ( assoc -- ) (use-words) delq ;
|
||||
: unuse-words ( assoc -- ) (use-words) delete ;
|
||||
|
||||
ERROR: ambiguous-use-error words ;
|
||||
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
|
||||
USING: accessors assocs compiler.units continuations fuel.eval fuel.help
|
||||
fuel.remote fuel.xref help.topics io.pathnames kernel namespaces parser
|
||||
sequences tools.scaffold vocabs.loader words ;
|
||||
sequences tools.scaffold vocabs.loader vocabs.parser words ;
|
||||
|
||||
IN: fuel
|
||||
|
||||
|
@ -46,7 +46,7 @@ SYMBOL: :uses-suggestions
|
|||
dup length 1 = [ first restart ] [ drop ] if ;
|
||||
|
||||
: fuel-set-use-hook ( -- )
|
||||
[ amended-use get clone :uses prefix fuel-eval-set-result ]
|
||||
[ manifest get auto-used>> clone :uses prefix fuel-eval-set-result ]
|
||||
print-use-hook set ;
|
||||
|
||||
: (fuel-get-uses) ( lines -- )
|
||||
|
|
Loading…
Reference in New Issue