diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index 247067673e..3fb0370ff1 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2003, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays byte-arrays byte-vectors generic hashtables -assocs kernel math namespaces make sequences strings sbufs vectors -words prettyprint.config prettyprint.custom prettyprint.sections -quotations io io.pathnames io.styles math.parser effects classes.tuple -math.order classes.tuple.private classes combinators colors ; +USING: accessors arrays byte-arrays byte-vectors continuations +generic hashtables assocs kernel math namespaces make sequences +strings sbufs vectors words prettyprint.config prettyprint.custom +prettyprint.sections quotations io io.pathnames io.styles math.parser +effects classes.tuple math.order classes.tuple.private classes +combinators colors ; IN: prettyprint.backend M: effect pprint* effect>string "(" ")" surround text ; @@ -153,6 +154,11 @@ M: pathname pprint* M: tuple pprint* pprint-tuple ; +: pprint-c-object ( object content-quot pointer-quot -- ) + [ c-object-pointers? get ] 2dip + [ nip ] + [ [ drop ] prepose [ recover ] 2curry ] 2bi if ; inline + : do-length-limit ( seq -- trimmed n/f ) length-limit get dup [ over length over [-] diff --git a/basis/prettyprint/config/config.factor b/basis/prettyprint/config/config.factor index d986791f94..d42b134d4c 100644 --- a/basis/prettyprint/config/config.factor +++ b/basis/prettyprint/config/config.factor @@ -13,6 +13,7 @@ SYMBOL: length-limit SYMBOL: line-limit SYMBOL: string-limit? SYMBOL: boa-tuples? +SYMBOL: c-object-pointers? 4 tab-size set-global 64 margin set-global diff --git a/basis/specialized-arrays/direct/functor/functor.factor b/basis/specialized-arrays/direct/functor/functor.factor index 2ba436cd58..9003b87e03 100755 --- a/basis/specialized-arrays/direct/functor/functor.factor +++ b/basis/specialized-arrays/direct/functor/functor.factor @@ -2,9 +2,17 @@ ! See http://factorcode.org/license.txt for BSD license. USING: functors sequences sequences.private kernel words classes math alien alien.c-types byte-arrays accessors -specialized-arrays prettyprint.custom ; +specialized-arrays parser prettyprint.backend prettyprint.custom ; IN: specialized-arrays.direct.functor +> ] [ length>> ] bi [ pprint* ] bi@ ; + +PRIVATE> + FUNCTOR: define-direct-array ( T -- ) A' IS ${T}-array @@ -15,6 +23,7 @@ A'{ IS ${A'}{ A DEFINES-CLASS direct-${T}-array DEFINES <${A}> +A'@ DEFINES ${A'}@ NTH [ T dup c-type-getter-boxer array-accessor ] SET-NTH [ T dup c-setter array-accessor ] @@ -34,11 +43,17 @@ M: A new-sequence drop ; inline M: A byte-length length>> T heap-size * ; inline +SYNTAX: A'@ + scan-object scan-object parsed ; + M: A pprint-delims drop \ A'{ \ } ; M: A >pprint-sequence ; -M: A pprint* pprint-object ; +M: A pprint* + [ pprint-object ] + [ \ A'@ pprint-direct-array ] + pprint-c-object ; INSTANCE: A sequence INSTANCE: A S