]> gitweb.factorcode.org Git - factor.git/commitdiff
prettyprint: some minor cleanup.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 11 Dec 2014 15:52:14 +0000 (07:52 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 11 Dec 2014 15:52:14 +0000 (07:52 -0800)
basis/prettyprint/backend/backend.factor
basis/prettyprint/sections/sections.factor

index d9cde6448be0ffc449d6f107f2c31863cd4e95a2..0fd45feeadba9acf24e60c4f4b4a05adbdad2e5f 100644 (file)
@@ -145,10 +145,10 @@ M: pathname pprint*
 : present-text ( str obj -- )
     presented associate styled-text ;
 
-: check-recursion ( obj quot -- )
+: check-recursion ( obj quot: ( obj -- ) -- )
     nesting-limit? [
         drop
-        [ class-of name>> "~" dup surround ] keep present-text 
+        [ class-of name>> "~" dup surround ] keep present-text
     ] [
         over recursion-check get member-eq? [
             drop "~circularity~" swap present-text
index e591e62882f321a0d7127ce686302e81995de67b..48175a945c52ba9c29d357c5dae13fbeeaffa229 100644 (file)
@@ -99,8 +99,7 @@ style overhang ;
 
 M: section section-fits? ( section -- ? )
     [ end>> 1 - pprinter get last-newline>> - ]
-    [ overhang>> ] bi
-    + text-fits? ;
+    [ overhang>> ] bi + text-fits? ;
 
 M: section indent-section? drop f ;
 
@@ -146,7 +145,7 @@ M: object short-section? section-fits? ;
 TUPLE: line-break < section type ;
 
 : <line-break> ( type -- section )
-    0 line-break new-section
+    0 line-break new-section
         swap >>type ;
 
 M: line-break short-section drop ;
@@ -208,7 +207,7 @@ M: block short-section ( block -- )
 
 : empty-block? ( block -- ? ) sections>> empty? ;
 
-: if-nonempty ( block quot -- )
+: unless-empty-block ( block quot: ( block -- ) -- )
     [ dup empty-block? [ drop ] ] dip if ; inline
 
 : (<block) ( block -- ) pprinter-stack get push ;
@@ -289,8 +288,9 @@ M: colon unindent-first-line? drop t ;
     position get >>end drop ;
 
 : block> ( -- )
-    pprinter-stack get pop
-    [ [ save-end-position ] [ add-section ] bi ] if-nonempty ;
+    pprinter-stack get pop [
+        [ save-end-position ] [ add-section ] bi
+    ] unless-empty-block ;
 
 : do-pprint ( block -- )
     <pprinter> pprinter [
@@ -300,7 +300,7 @@ M: colon unindent-first-line? drop t ;
                     short-section
                 ] curry with-return
             ] with-nesting
-        ] if-nonempty
+        ] unless-empty-block
     ] with-variable ;
 
 ! Long section layout algorithm
@@ -347,25 +347,23 @@ M: block long-section ( block -- )
                 ] if
             ] each
         ] each
-    ] if-nonempty ;
+    ] unless-empty-block ;
 
 : pprinter-manifest ( -- manifest )
     <manifest>
-    [ [ pprinter-use get members >vector ] dip search-vocabs<< ]
-    [ [ pprinter-in get ] dip current-vocab<< ]
-    [ ]
-    tri ;
+        pprinter-use get members V{ } like >>search-vocabs
+        pprinter-in get >>current-vocab ;
 
 : make-pprint ( obj quot manifest? -- block manifest/f )
     [
-        0 position ,,
-        HS{ } clone pprinter-use ,,
-        V{ } clone recursion-check ,,
-        V{ } clone pprinter-stack ,,
-    ] H{ } make [
+        0 position set
+        HS{ } clone pprinter-use set
+        V{ } clone recursion-check set
+        V{ } clone pprinter-stack set
+
         [ over <object call pprinter-block ] dip
         [ pprinter-manifest ] [ f ] if
-    ] with-variables ; inline
+    ] with-scope ; inline
 
 : with-pprint ( obj quot -- )
     f make-pprint drop do-pprint ; inline