prettyprint: speed up unparse by not making the manifest sometimes.

diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor
index 5e7217cf89627993d2919f168f4ddae3e7acc930..a045dbdfa98ef82166f0ec874fd22a48b167c830 100644 (file)
--- a/basis/prettyprint/prettyprint.factor
+++ b/basis/prettyprint/prettyprint.factor
@@ -10,12 +10,12 @@ FROM: namespaces => set ;
 IN: prettyprint
 
 : with-use ( obj quot -- )
-    make-pprint (pprint-manifest
+    t make-pprint (pprint-manifest
     [ pprint-manifest) ] [ [ drop nl ] unless-empty ] bi
     do-pprint ; inline
 
 : with-in ( obj quot -- )
-    make-pprint current-vocab>> [ pprint-in bl ] when* do-pprint ; inline
+    t 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 de64eb3d593b1b6ff19052c8fd241993a1e1c345..0f2b2d40088083f964f029e7609e4c06cb4e259e 100644 (file)
--- a/basis/prettyprint/sections/sections.factor
+++ b/basis/prettyprint/sections/sections.factor
@@ -4,7 +4,7 @@ USING: arrays generic hashtables io kernel math assocs
 namespaces make sequences strings io.styles vectors words
 prettyprint.config splitting classes continuations
 accessors sets vocabs.parser combinators vocabs
-classes.maybe ;
+classes.maybe combinators.short-circuit ;
 FROM: sets => members ;
 FROM: namespaces => set ;
 IN: prettyprint.sections
@@ -180,9 +180,10 @@ TUPLE: block < section sections ;
     last-section t >>end-group? drop ;
 
 : advance ( section -- )
-    [ start>> pprinter get last-newline>> = not ]
-    [ short-section? ] bi
-    and [ bl ] when ;
+    {
+        [ start>> pprinter get last-newline>> = not ]
+        [ short-section? ]
+    } 1&& [ bl ] when ;
 
 : add-line-break ( type -- ) [ <line-break> add-section ] when* ;
 
@@ -263,9 +264,10 @@ M: flow short-section? ( section -- ? )
     #! If we can make room for this entire block by inserting
     #! a newline, do it; otherwise, don't bother, print it as
     #! a short section
-    [ section-fits? ]
-    [ [ end>> ] [ start>> ] bi - text-fits? not ] bi
-    or ;
+    {
+        [ section-fits? ]
+        [ [ end>> ] [ start>> ] bi - text-fits? not ]
+    } 1|| ;
 
 : <flow ( -- ) <flow> (<block) ;
 
@@ -311,9 +313,10 @@ SYMBOL: next
 : split-groups ( ? -- ) [ t , ] when ;
 
 : split-before ( section -- )
-    [ start-group?>> prev get [ end-group?>> ] [ t ] if* and ]
-    [ flow? prev get flow? not and ]
-    bi or split-groups ;
+    {
+        [ start-group?>> prev get [ end-group?>> ] [ t ] if* and ]
+        [ flow? prev get flow? not and ]
+    } 1|| split-groups ;
 
 : split-after ( section -- )
     [ end-group?>> ] [ f ] if* split-groups ;
@@ -328,7 +331,7 @@ SYMBOL: next
     ] { } make { t } split harvest ;
 
 : break-group? ( seq -- ? )
-    [ first section-fits? ] [ last section-fits? not ] bi and ;
+    { [ first section-fits? ] [ last section-fits? not ] } 1&& ;
 
 : ?break-group ( seq -- )
     dup break-group? [ first <fresh-line ] [ drop ] if ;
@@ -353,18 +356,16 @@ M: block long-section ( block -- )
     [ ]
     tri ;
 
-: make-pprint ( obj quot -- block manifest )
+: make-pprint ( obj quot manifest? -- block manifest/f )
     [
         0 position ,,
         HS{ } clone pprinter-use ,,
         V{ } clone recursion-check ,,
         V{ } clone pprinter-stack ,,
     ] H{ } make [
-        over <object
-        call
-        pprinter-block
-        pprinter-manifest
+        [ over <object call pprinter-block ] dip
+        [ pprinter-manifest ] [ f ] if
     ] with-variables ; inline
 
 : with-pprint ( obj quot -- )
-    make-pprint drop do-pprint ; inline
+    f make-pprint drop do-pprint ; inline