add alternate literal syntax "X-array@ PTR LEN" for direct-arrays. pprint with this syntax when c-object-pointers? prettyprint flag is set, or the pointer under the direct-array is invalid
parent
0f1270720d
commit
dee9f56500
|
@ -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 [-]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: pprint-direct-array ( direct-array tag -- )
|
||||
pprint-word
|
||||
[ underlying>> ] [ 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
|
||||
<A> 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 <A'> ; inline
|
|||
|
||||
M: A byte-length length>> T heap-size * ; inline
|
||||
|
||||
SYNTAX: A'@
|
||||
scan-object scan-object <A> 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
|
||||
|
|
Loading…
Reference in New Issue