Clean up pprint-use and related code to use manifests
Slava Pestov
parent
274655e77c
commit
7c388d702a
|
|
@ -161,10 +161,6 @@ $nl
|
|||
|
||||
ABOUT: "prettyprint"
|
||||
|
||||
HELP: with-pprint
|
||||
{ $values { "obj" object } { "quot" quotation } }
|
||||
{ $description "Sets up the prettyprinter and calls the quotation in a new scope. The quotation should add sections to the top-level block. When the quotation returns, the top-level block is printed to " { $link output-stream } "." } ;
|
||||
|
||||
HELP: pprint
|
||||
{ $values { "obj" object } }
|
||||
{ $description "Prettyprints an object to " { $link output-stream } ". Output is influenced by many variables; see " { $link "prettyprint-variables" } "." }
|
||||
|
|
@ -225,8 +221,3 @@ HELP: .r
|
|||
|
||||
HELP: .s
|
||||
{ $description "Displays the contents of the data stack, with the top of the stack printed first." } ;
|
||||
|
||||
HELP: in.
|
||||
{ $values { "vocab" "a vocabulary specifier" } }
|
||||
{ $description "Prettyprints a " { $snippet "IN:" } " declaration." }
|
||||
$prettyprinting-note ;
|
||||
|
|
@ -4,78 +4,16 @@ USING: arrays accessors assocs colors combinators grouping io
|
|||
io.streams.string io.styles kernel make math math.parser namespaces
|
||||
parser prettyprint.backend prettyprint.config prettyprint.custom
|
||||
prettyprint.sections quotations sequences sorting strings vocabs
|
||||
vocabs.parser words sets ;
|
||||
vocabs.prettyprint words sets ;
|
||||
IN: prettyprint
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: make-pprint ( obj quot -- block in use )
|
||||
[
|
||||
0 position set
|
||||
H{ } clone pprinter-use set
|
||||
V{ } clone recursion-check set
|
||||
V{ } clone pprinter-stack set
|
||||
over <object
|
||||
call
|
||||
pprinter-block
|
||||
pprinter-in get
|
||||
pprinter-use get keys
|
||||
] with-scope ; inline
|
||||
|
||||
: with-pprint ( obj quot -- )
|
||||
make-pprint 2drop do-pprint ; inline
|
||||
|
||||
: pprint-vocab ( vocab -- )
|
||||
dup vocab present-text ;
|
||||
|
||||
: write-in ( vocab -- )
|
||||
[ \ IN: pprint-word pprint-vocab ] with-pprint ;
|
||||
|
||||
: in. ( vocab -- )
|
||||
[ write-in ] when* ;
|
||||
|
||||
: use. ( seq -- )
|
||||
[
|
||||
natural-sort [
|
||||
\ USING: pprint-word
|
||||
[ pprint-vocab ] each
|
||||
\ ; pprint-word
|
||||
] with-pprint
|
||||
] unless-empty ;
|
||||
|
||||
: use/in. ( in use -- )
|
||||
over "syntax" 2array diff
|
||||
[ nip use. ]
|
||||
[ empty? not and [ nl ] when ]
|
||||
[ drop in. ]
|
||||
2tri ;
|
||||
|
||||
: vocab-names ( words -- vocabs )
|
||||
dictionary get
|
||||
[ [ words>> eq? nip ] with assoc-find 2drop ] curry map sift ;
|
||||
|
||||
: prelude. ( -- )
|
||||
in get use get vocab-names prune in get ".private" append swap remove use/in. ;
|
||||
|
||||
[
|
||||
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
|
||||
] with-style
|
||||
{ { page-color T{ rgba f 0.8 0.8 0.8 1.0 } } } [ prelude. ] with-nesting
|
||||
nl nl
|
||||
] print-use-hook set-global
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: with-use ( obj quot -- )
|
||||
make-pprint [ use/in. ] [ empty? not or [ nl ] when ] 2bi
|
||||
make-pprint (pprint-manifest
|
||||
[ pprint-manifest) ] [ [ drop nl ] unless-empty ] bi
|
||||
do-pprint ; inline
|
||||
|
||||
: with-in ( obj quot -- )
|
||||
make-pprint drop [ write-in bl ] when* do-pprint ; inline
|
||||
make-pprint current-vocab>> [ pprint-in bl ] when* do-pprint ; inline
|
||||
|
||||
: pprint ( obj -- ) [ pprint* ] with-pprint ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2003, 2008 Slava Pestov.
|
||||
! Copyright (C) 2003, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays generic hashtables io kernel math assocs
|
||||
namespaces make sequences strings io.styles vectors words
|
||||
prettyprint.config splitting classes continuations
|
||||
accessors sets ;
|
||||
accessors sets vocabs.parser combinators vocabs ;
|
||||
IN: prettyprint.sections
|
||||
|
||||
! State
|
||||
|
|
@ -19,8 +19,16 @@ TUPLE: pprinter last-newline line-count indent ;
|
|||
|
||||
: <pprinter> ( -- pprinter ) 0 1 0 pprinter boa ;
|
||||
|
||||
: (record-vocab) ( vocab -- )
|
||||
dup pprinter-in get dup [ vocab-name ] when =
|
||||
[ drop ] [ pprinter-use get conjoin ] if ;
|
||||
|
||||
: record-vocab ( word -- )
|
||||
vocabulary>> [ pprinter-use get conjoin ] when* ;
|
||||
vocabulary>> {
|
||||
{ f [ ] }
|
||||
{ "syntax" [ ] }
|
||||
[ (record-vocab) ]
|
||||
} case ;
|
||||
|
||||
! Utility words
|
||||
: line-limit? ( -- ? )
|
||||
|
|
@ -327,7 +335,14 @@ M: block long-section ( block -- )
|
|||
] each
|
||||
] if-nonempty ;
|
||||
|
||||
: make-pprint ( obj quot -- block in use )
|
||||
: pprinter-manifest ( -- manifest )
|
||||
<manifest>
|
||||
[ [ pprinter-use get keys >vector ] dip (>>search-vocabs) ]
|
||||
[ [ pprinter-in get ] dip (>>current-vocab) ]
|
||||
[ ]
|
||||
tri ;
|
||||
|
||||
: make-pprint ( obj quot -- block manifest )
|
||||
[
|
||||
0 position set
|
||||
H{ } clone pprinter-use set
|
||||
|
|
@ -336,9 +351,8 @@ M: block long-section ( block -- )
|
|||
over <object
|
||||
call
|
||||
pprinter-block
|
||||
pprinter-in get
|
||||
pprinter-use get keys
|
||||
pprinter-manifest
|
||||
] with-scope ; inline
|
||||
|
||||
: with-pprint ( obj quot -- )
|
||||
make-pprint 2drop do-pprint ; inline
|
||||
make-pprint drop do-pprint ; inline
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
USING: help.markup help.syntax strings definitions generic words classes ;
|
||||
FROM: prettyprint.sections => with-pprint ;
|
||||
IN: see
|
||||
USING: help.markup help.syntax strings prettyprint.private
|
||||
definitions generic words classes ;
|
||||
|
||||
HELP: synopsis
|
||||
{ $values { "defspec" "a definition specifier" } { "str" string } }
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ generic.single generic.standard generic.hook io io.pathnames
|
|||
io.streams.string io.styles kernel make namespaces prettyprint
|
||||
prettyprint.backend prettyprint.config prettyprint.custom
|
||||
prettyprint.sections sequences sets sorting strings summary words
|
||||
words.symbol words.constant words.alias ;
|
||||
words.symbol words.constant words.alias vocabs ;
|
||||
IN: see
|
||||
|
||||
GENERIC: synopsis* ( defspec -- )
|
||||
|
|
@ -44,7 +44,7 @@ M: word print-stack-effect? drop t ;
|
|||
<PRIVATE
|
||||
|
||||
: seeing-word ( word -- )
|
||||
vocabulary>> pprinter-in set ;
|
||||
vocabulary>> vocab pprinter-in set ;
|
||||
|
||||
: word-synopsis ( word -- )
|
||||
{
|
||||
|
|
|
|||
|
|
@ -64,15 +64,20 @@ M: rename pprint-qualified ( rename -- )
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: pprint-manifest ( manifest -- )
|
||||
: (pprint-manifest ( manifest -- quots )
|
||||
[
|
||||
[ search-vocabs>> [ '[ _ pprint-using ] , ] unless-empty ]
|
||||
[ qualified-vocabs>> [ extra-words? not ] filter [ '[ _ pprint-qualified ] , ] each ]
|
||||
[ current-vocab>> [ '[ _ pprint-in ] , ] when* ]
|
||||
tri
|
||||
] { } make
|
||||
] { } make ;
|
||||
|
||||
: pprint-manifest) ( quots -- )
|
||||
[ nl ] [ call( -- ) ] interleave ;
|
||||
|
||||
: pprint-manifest ( manifest -- )
|
||||
(pprint-manifest pprint-manifest) ;
|
||||
|
||||
[
|
||||
nl
|
||||
{ { font-style bold } { font-name "sans-serif" } } [
|
||||
|
|
|
|||
Loading…
Reference in New Issue