steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Auto-use output omits duplicate vocabulary names, and the current vocabulary's private vocab

db4
Slava Pestov 2009-03-12 21:21:48 -05:00
parent 9696661ef5
commit e18e99acc3
1 changed files with 13 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
basis/prettyprint/prettyprint.factor
View File

@ -4,7 +4,7 @@ USING: accessors assocs colors combinators grouping io
io.streams.string io.styles kernel make math math.parser namespaces io.streams.string io.styles kernel make math math.parser namespaces
parser prettyprint.backend prettyprint.config prettyprint.custom parser prettyprint.backend prettyprint.config prettyprint.custom
prettyprint.sections quotations sequences sorting strings vocabs prettyprint.sections quotations sequences sorting strings vocabs
vocabs.parser words ; vocabs.parser words sets ;
IN: prettyprint IN: prettyprint
<PRIVATE <PRIVATE
@ -32,7 +32,7 @@ IN: prettyprint
[ \ IN: pprint-word pprint-vocab ] with-pprint ; [ \ IN: pprint-word pprint-vocab ] with-pprint ;
: in. ( vocab -- ) : in. ( vocab -- )
[ write-in nl ] when* ; [ write-in ] when* ;
: use. ( seq -- ) : use. ( seq -- )
[ [
@ -40,33 +40,35 @@ IN: prettyprint
\ USING: pprint-word \ USING: pprint-word
[ pprint-vocab ] each [ pprint-vocab ] each
\ ; pprint-word \ ; pprint-word
] with-pprint nl ] with-pprint
] unless-empty ; ] unless-empty ;
: use/in. ( in use -- ) : use/in. ( in use -- )
dupd remove [ { "syntax" "scratchpad" } member? not ] filter dupd remove [ { "syntax" "scratchpad" } member? not ] filter
use. in. ; use. nl in. ;
: vocab-names ( words -- vocabs ) : vocab-names ( words -- vocabs )
dictionary get dictionary get
[ [ words>> eq? nip ] with assoc-find 2drop ] curry map sift ; [ [ words>> eq? nip ] with assoc-find 2drop ] curry map sift ;
: prelude. ( -- ) : prelude. ( -- )
in get use get vocab-names use/in. ; in get use get vocab-names prune in get ".private" append swap remove use/in. ;
[ [
nl nl
"Restarts were invoked adding vocabularies to the search path." print { { font-style bold } { font-name "sans-serif" } } [
"To avoid doing this in the future, add the following USING:" print "Restarts were invoked adding vocabularies to the search path." print
"and IN: forms at the top of the source file:" print nl "To avoid doing this in the future, add the following USING:" print
prelude. "and IN: forms at the top of the source file:" print nl
nl ] with-style
{ { page-color COLOR: light-gray } } [ prelude. ] with-nesting
nl nl
] print-use-hook set-global ] print-use-hook set-global
PRIVATE> PRIVATE>
: with-use ( obj quot -- ) : with-use ( obj quot -- )
make-pprint use/in. do-pprint ; inline make-pprint use/in. nl do-pprint ; inline
: with-in ( obj quot -- ) : with-in ( obj quot -- )
make-pprint drop [ write-in bl ] when* do-pprint ; inline make-pprint drop [ write-in bl ] when* do-pprint ; inline