diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor index d6064ba852..11601f7b63 100755 --- a/basis/bit-arrays/bit-arrays.factor +++ b/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 ; diff --git a/basis/bit-vectors/bit-vectors.factor b/basis/bit-vectors/bit-vectors.factor index 6a7d68beca..404b26829b 100755 --- a/basis/bit-vectors/bit-vectors.factor +++ b/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 ; diff --git a/basis/float-arrays/float-arrays.factor b/basis/float-arrays/float-arrays.factor index 28eea4701e..411643ddc0 100755 --- a/basis/float-arrays/float-arrays.factor +++ b/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 ; diff --git a/basis/float-vectors/float-vectors.factor b/basis/float-vectors/float-vectors.factor index 68b692da5a..8e93582f04 100755 --- a/basis/float-vectors/float-vectors.factor +++ b/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 ; diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index 78a3002906..7cc2f3d8d9 100755 --- a/basis/logging/logging.factor +++ b/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 diff --git a/basis/math/complex/complex.factor b/basis/math/complex/complex.factor index ff5c0feb78..acc8a9d6d6 100755 --- a/basis/math/complex/complex.factor +++ b/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 ; diff --git a/basis/persistent/hashtables/hashtables.factor b/basis/persistent/hashtables/hashtables.factor index ae60aba50e..2e2be264bb 100644 --- a/basis/persistent/hashtables/hashtables.factor +++ b/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 ; diff --git a/basis/persistent/vectors/vectors.factor b/basis/persistent/vectors/vectors.factor index a636d31f48..92b3f82a54 100644 --- a/basis/persistent/vectors/vectors.factor +++ b/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 diff --git a/basis/prettyprint/backend/backend-docs.factor b/basis/prettyprint/backend/backend-docs.factor index c6eff28d08..cc4f5cedb5 100755 --- a/basis/prettyprint/backend/backend-docs.factor +++ b/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 } } diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index 87f6d3122e..34ab1a2fcc 100755 --- a/basis/prettyprint/backend/backend.factor +++ b/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 -- ) + ] bi* + \ } pprint-word block> ; + +M: tuple pprint* + boa-tuples? get [ call-next-method ] [ + [ + 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 ] [ diff --git a/basis/prettyprint/config/config-docs.factor b/basis/prettyprint/config/config-docs.factor index 1a2fd69949..dda565d5c9 100644 --- a/basis/prettyprint/config/config-docs.factor +++ b/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." } ; diff --git a/basis/prettyprint/config/config.factor b/basis/prettyprint/config/config.factor index 6a649bc5a6..d986791f94 100644 --- a/basis/prettyprint/config/config.factor +++ b/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 diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor index f7f0f7ee44..44cf5f724f 100755 --- a/basis/prettyprint/prettyprint-docs.factor +++ b/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 ]" } ; diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index 63a44d85d4..c52ab18027 100755 --- a/basis/prettyprint/prettyprint.factor +++ b/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 ) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 833528018b..7e37436654 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/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 diff --git a/extra/math/blas/syntax/syntax.factor b/extra/math/blas/syntax/syntax.factor index 1072c64b32..6b40910687 100644 --- a/extra/math/blas/syntax/syntax.factor +++ b/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 ;