From 7c388d702a78b5bc6979d1355d38dcfd90e8a3a5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 16 May 2009 08:54:14 -0500 Subject: [PATCH] Clean up pprint-use and related code to use manifests --- basis/prettyprint/prettyprint-docs.factor | 9 --- basis/prettyprint/prettyprint.factor | 70 ++------------------- basis/prettyprint/sections/sections.factor | 28 ++++++--- basis/see/see-docs.factor | 4 +- basis/see/see.factor | 4 +- basis/vocabs/prettyprint/prettyprint.factor | 9 ++- 6 files changed, 36 insertions(+), 88 deletions(-) diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor index 1af921d4f3..fbbece4602 100644 --- a/basis/prettyprint/prettyprint-docs.factor +++ b/basis/prettyprint/prettyprint-docs.factor @@ -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 ; \ No newline at end of file diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index 2286417dd1..99913a803a 100644 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -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 -> 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 ; diff --git a/basis/prettyprint/sections/sections.factor b/basis/prettyprint/sections/sections.factor index f72c426533..b4eb40757d 100644 --- a/basis/prettyprint/sections/sections.factor +++ b/basis/prettyprint/sections/sections.factor @@ -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 ) 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 ) + + [ [ 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 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 } } diff --git a/basis/see/see.factor b/basis/see/see.factor index 37153b5229..d2515a2e81 100644 --- a/basis/see/see.factor +++ b/basis/see/see.factor @@ -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 ; > pprinter-in set ; + vocabulary>> vocab pprinter-in set ; : word-synopsis ( word -- ) { diff --git a/basis/vocabs/prettyprint/prettyprint.factor b/basis/vocabs/prettyprint/prettyprint.factor index 2ada653af1..0e150ef07a 100644 --- a/basis/vocabs/prettyprint/prettyprint.factor +++ b/basis/vocabs/prettyprint/prettyprint.factor @@ -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" } } [