Prettyprinter now emits assoc-form tuples unless boa-tuple? is on

basis/bit-arrays/bit-arrays.factor

@@ -91,5 +91,5 @@ M: bit-array byte-length length 7 + -3 shift ;
 INSTANCE: bit-array sequence
 
 M: bit-array pprint-delims drop \ ?{ \ } ;
-
 M: bit-array >pprint-sequence ;
+M: bit-array pprint* pprint-object ;

basis/bit-vectors/bit-vectors.factor

@@ -34,5 +34,5 @@ INSTANCE: bit-vector growable
 : ?V{ \ } [ >bit-vector ] parse-literal ; parsing
 
 M: bit-vector >pprint-sequence ;
-
 M: bit-vector pprint-delims drop \ ?V{ \ } ;
+M: bit-vector pprint* pprint-object ;

basis/float-arrays/float-arrays.factor

@@ -61,8 +61,8 @@ INSTANCE: float-array sequence
 : F{ \ } [ >float-array ] parse-literal ; parsing
 
 M: float-array pprint-delims drop \ F{ \ } ;
-
 M: float-array >pprint-sequence ;
+M: float-array pprint* pprint-object ;
 
 USING: hints math.vectors arrays ;
 

basis/float-vectors/float-vectors.factor

@@ -34,5 +34,5 @@ INSTANCE: float-vector growable
 : FV{ \ } [ >float-vector ] parse-literal ; parsing
 
 M: float-vector >pprint-sequence ;
-
 M: float-vector pprint-delims drop \ FV{ \ } ;
+M: float-vector pprint* pprint-object ;

basis/logging/logging.factor

@@ -46,7 +46,7 @@ SYMBOL: log-service
     dup array? [ dup length 1 = [ first ] when ] when
     dup string? [
         [
-            string-limit off
+            string-limit? off
             1 line-limit set
             3 nesting-limit set
             0 margin set

basis/math/complex/complex.factor

@@ -49,5 +49,5 @@ IN: syntax
 : C{ \ } [ first2 rect> ] parse-literal ; parsing
 
 M: complex pprint-delims drop \ C{ \ } ;
-
 M: complex >pprint-sequence >rect 2array ;
+M: complex pprint* pprint-object ;

basis/persistent/hashtables/hashtables.factor

@@ -51,5 +51,5 @@ M: persistent-hash clone ;
 : PH{ \ } [ >persistent-hash ] parse-literal ; parsing
 
 M: persistent-hash pprint-delims drop \ PH{ \ } ;
-
 M: persistent-hash >pprint-sequence >alist ;
+M: persistent-hash pprint* pprint-object ;

basis/persistent/vectors/vectors.factor

@@ -182,7 +182,7 @@ M: persistent-vector equal?
 : PV{ \ } [ >persistent-vector ] parse-literal ; parsing
 
 M: persistent-vector pprint-delims drop \ PV{ \ } ;
-
 M: persistent-vector >pprint-sequence ;
+M: persistent-vector pprint* pprint-object ;
 
 INSTANCE: persistent-vector immutable-sequence

basis/prettyprint/backend/backend-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax io kernel prettyprint
+USING: help.markup help.syntax io kernel
 prettyprint.config prettyprint.sections words strings ;
 IN: prettyprint.backend
 
@@ -24,7 +24,7 @@ HELP: unparse-ch
 
 HELP: do-string-limit
 { $values { "str" string } { "trimmed" "a possibly trimmed string" } }
-{ $description "If " { $link string-limit } " is on, trims the string such that it does not exceed the margin, appending \"...\" if trimming took place." } ;
+{ $description "If " { $link string-limit? } " is on, trims the string such that it does not exceed the margin, appending \"...\" if trimming took place." } ;
 
 HELP: pprint-string
 { $values { "obj" object } { "str" string } { "prefix" string } { "suffix" string } }

basis/prettyprint/backend/backend.factor

@@ -80,7 +80,7 @@ M: f pprint* drop \ f pprint-word ;
     dup ch>ascii-escape [ "\\" % ] [ ] ?if , ;
 
 : do-string-limit ( str -- trimmed )
-    string-limit get [
+    string-limit? get [
         dup length margin get > [
             margin get 3 - head "..." append
         ] when
@@ -129,6 +129,30 @@ M: pathname pprint*
         ] if
     ] if ; inline
 
+: tuple>assoc ( tuple -- assoc )
+    [ class all-slots ] [ tuple-slots ] bi zip
+    [ [ initial>> ] dip = not ] assoc-filter
+    [ [ name>> ] dip ] assoc-map ;
+
+: pprint-slot-value ( name value -- )
+    <flow \ { pprint-word
+    [ text ] [ f <inset pprint* block> ] bi*
+    \ } pprint-word block> ;
+
+M: tuple pprint*
+    boa-tuples? get [ call-next-method ] [
+        [
+            <flow
+            \ T{ pprint-word
+            dup class pprint-word
+            t <inset
+            tuple>assoc [ pprint-slot-value ] assoc-each
+            block>
+            \ } pprint-word
+            block>
+        ] check-recursion
+    ] if ;
+
 : do-length-limit ( seq -- trimmed n/f )
     length-limit get dup [
         over length over [-]
@@ -188,6 +212,8 @@ M: tuple pprint-narrow? drop t ;
     ] check-recursion ;
 
 M: object pprint* pprint-object ;
+M: vector pprint* pprint-object ;
+M: hashtable pprint* pprint-object ;
 
 M: curry pprint*
     dup quot>> callable? [ pprint-object ] [

basis/prettyprint/config/config-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax io kernel prettyprint
+USING: help.markup help.syntax io kernel
 prettyprint.sections words ;
 IN: prettyprint.config
 
@@ -19,5 +19,9 @@ HELP: length-limit
 HELP: line-limit
 { $var-description "The maximum number of lines output by the prettyprinter before output is truncated with \"...\". The default is " { $link f } ", denoting unlimited line count." } ;
 
-HELP: string-limit
+HELP: string-limit?
 { $var-description "Toggles whether printed strings are truncated to the margin." } ;
+
+HELP: boa-tuples?
+{ $var-description "Toggles whether tuples print in BOA-form or assoc-form." }
+{ $notes "See " { $link POSTPONE: T{ } " for a description of both literal tuple forms." } ;

basis/prettyprint/config/config.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2003, 2007 Slava Pestov.
+! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: prettyprint.config
 USING: arrays generic assocs io kernel math
 namespaces sequences strings io.styles vectors words
 continuations ;
+IN: prettyprint.config
 
 ! Configuration
 SYMBOL: tab-size
@@ -11,10 +11,8 @@ SYMBOL: margin
 SYMBOL: nesting-limit
 SYMBOL: length-limit
 SYMBOL: line-limit
-SYMBOL: string-limit
+SYMBOL: string-limit?
+SYMBOL: boa-tuples?
 
-global [
-    4 tab-size set
-    64 margin set
-    string-limit off
-] bind
+4 tab-size set-global
+64 margin set-global

basis/prettyprint/prettyprint-docs.factor

@@ -26,7 +26,8 @@ ARTICLE: "prettyprint-variables" "Prettyprint control variables"
 { $subsection nesting-limit }
 { $subsection length-limit }
 { $subsection line-limit }
-{ $subsection string-limit }
+{ $subsection string-limit? }
+{ $subsection boa-tuples? }
 "Note that the " { $link short. } " and " { $link pprint-short } " variables override some of these variables."
 {
     $warning "Treat the global variables as essentially being constants. Only ever rebind them in a nested scope."
@@ -86,7 +87,7 @@ $nl
 { $subsection "prettyprint-section-protocol" } ;
 
 ARTICLE: "prettyprint-literal" "Literal prettyprinting protocol"
-"Unless a more specialized method exists for the input class, the " { $link pprint* } " word outputs an object in a standard format, ultimately calling two generic words:"
+"Most custom data types have a literal syntax which resembles a sequence. An easy way to define such a syntax is to add a method to the " { $link pprint* } " generic word which calls " { $link pprint-object } ", and then to provide methods on two other generic words:"
 { $subsection pprint-delims }
 { $subsection >pprint-sequence }
 "For example, consider the following data type, together with a parsing word for creating literals:"
@@ -104,10 +105,11 @@ ARTICLE: "prettyprint-literal" "Literal prettyprinting protocol"
 { $code "RECT[ 100 * 200 ]" }
 "Without further effort, the literal does not print in the same way:"
 { $unchecked-example "RECT[ 100 * 200 ] ." "T{ rect f 100 200 }" }
-"However, we can define two methods easily enough:"
+"However, we can define three methods easily enough:"
 { $code
     "M: rect pprint-delims drop \\ RECT[ \\ ] ;"
     "M: rect >pprint-sequence dup rect-w \\ * rot rect-h 3array ;"
+    "M: rect pprint* pprint-object ;"
 }
 "Now, it will be printed in a custom way:"
 { $unchecked-example "RECT[ 100 * 200 ] ." "RECT[ 100 * 200 ]" } ;

basis/prettyprint/prettyprint.factor

@@ -71,7 +71,8 @@ IN: prettyprint
        { line-limit 1 }
        { length-limit 15 }
        { nesting-limit 2 }
-       { string-limit t }
+       { string-limit? t }
+       { boa-tuples? t }
     } clone [ pprint ] bind ;
 
 : unparse-short ( obj -- str )

basis/tools/deploy/shaker/shaker.factor

@@ -252,7 +252,8 @@ IN: tools.deploy.shaker
         strip-prettyprint? [
             {
                 prettyprint.config:margin
-                prettyprint.config:string-limit
+                prettyprint.config:string-limit?
+                prettyprint.config:boa-tuples?
                 prettyprint.config:tab-size
             } %
         ] when

extra/math/blas/syntax/syntax.factor

@@ -31,4 +31,6 @@ M: float-complex-blas-matrix pprint-delims drop \ cmatrix{ \ } ;
 M: double-complex-blas-matrix pprint-delims drop \ zmatrix{ \ } ;
 
 M: blas-vector-base >pprint-sequence ;
+M: blas-vector-base pprint* pprint-object ;
 M: blas-matrix-base >pprint-sequence Mrows ;
+M: blas-matrix-base pprint* pprint-object ;