likewise, an S@ word for structs
parent
dee9f56500
commit
82025bde30
|
@ -1,6 +1,6 @@
|
||||||
! (c)Joe Groff bsd license
|
! (c)Joe Groff bsd license
|
||||||
USING: accessors assocs classes classes.struct combinators
|
USING: accessors alien assocs classes classes.struct
|
||||||
kernel math prettyprint.backend prettyprint.custom
|
combinators kernel math prettyprint.backend prettyprint.custom
|
||||||
prettyprint.sections see.private sequences strings words ;
|
prettyprint.sections see.private sequences strings words ;
|
||||||
IN: classes.struct.prettyprint
|
IN: classes.struct.prettyprint
|
||||||
|
|
||||||
|
@ -24,6 +24,14 @@ IN: classes.struct.prettyprint
|
||||||
} cleave
|
} cleave
|
||||||
\ } pprint-word block> ;
|
\ } pprint-word block> ;
|
||||||
|
|
||||||
|
: pprint-struct ( struct -- )
|
||||||
|
[ [ \ S{ ] dip [ class ] [ struct>assoc ] bi \ } (pprint-tuple) ] ?pprint-tuple ;
|
||||||
|
|
||||||
|
: pprint-struct-pointer ( struct -- )
|
||||||
|
\ S@ pprint-word
|
||||||
|
[ class pprint-word ]
|
||||||
|
[ >c-ptr pprint* ] bi ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
M: struct-class see-class*
|
M: struct-class see-class*
|
||||||
|
@ -38,4 +46,5 @@ M: struct >pprint-sequence
|
||||||
[ class ] [ struct-slot-values ] bi class-slot-sequence ;
|
[ class ] [ struct-slot-values ] bi class-slot-sequence ;
|
||||||
|
|
||||||
M: struct pprint*
|
M: struct pprint*
|
||||||
[ [ \ S{ ] dip [ class ] [ struct>assoc ] bi \ } (pprint-tuple) ] ?pprint-tuple ;
|
[ pprint-struct ]
|
||||||
|
[ pprint-struct-pointer ] pprint-c-object ;
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! (c)Joe Groff bsd license
|
! (c)Joe Groff bsd license
|
||||||
USING: accessors alien alien.c-types alien.libraries
|
USING: accessors alien alien.c-types alien.libraries
|
||||||
alien.structs.fields alien.syntax ascii classes.struct combinators
|
alien.structs.fields alien.syntax ascii byte-arrays classes.struct
|
||||||
destructors io.encodings.utf8 io.pathnames io.streams.string
|
combinators destructors io.encodings.utf8 io.pathnames io.streams.string
|
||||||
kernel libc literals math multiline namespaces prettyprint
|
kernel libc literals math multiline namespaces prettyprint
|
||||||
prettyprint.config see sequences specialized-arrays.ushort
|
prettyprint.config see sequences specialized-arrays.ushort
|
||||||
system tools.test compiler.tree.debugger struct-arrays
|
system tools.test compiler.tree.debugger struct-arrays
|
||||||
|
@ -78,16 +78,36 @@ STRUCT: struct-test-string-ptr
|
||||||
|
|
||||||
[ "S{ struct-test-foo { y 7654 } }" ]
|
[ "S{ struct-test-foo { y 7654 } }" ]
|
||||||
[
|
[
|
||||||
f boa-tuples?
|
[
|
||||||
[ struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer ]
|
boa-tuples? off
|
||||||
with-variable
|
c-object-pointers? off
|
||||||
|
struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer
|
||||||
|
] with-scope
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ "S@ struct-test-foo B{ 0 0 0 0 0 0 0 0 0 0 0 0 }" ]
|
||||||
|
[
|
||||||
|
[
|
||||||
|
c-object-pointers? on
|
||||||
|
12 <byte-array> struct-test-foo memory>struct [ pprint ] with-string-writer
|
||||||
|
] with-scope
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ "S{ struct-test-foo f 0 7654 f }" ]
|
[ "S{ struct-test-foo f 0 7654 f }" ]
|
||||||
[
|
[
|
||||||
t boa-tuples?
|
[
|
||||||
[ struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer ]
|
boa-tuples? on
|
||||||
with-variable
|
c-object-pointers? off
|
||||||
|
struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer
|
||||||
|
] with-scope
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ "S@ struct-test-foo f" ]
|
||||||
|
[
|
||||||
|
[
|
||||||
|
c-object-pointers? off
|
||||||
|
f struct-test-foo memory>struct [ pprint ] with-string-writer
|
||||||
|
] with-scope
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ <" USING: classes.struct ;
|
[ <" USING: classes.struct ;
|
||||||
|
|
|
@ -277,6 +277,9 @@ SYNTAX: UNION-STRUCT:
|
||||||
SYNTAX: S{
|
SYNTAX: S{
|
||||||
scan-word dup struct-slots parse-tuple-literal-slots parsed ;
|
scan-word dup struct-slots parse-tuple-literal-slots parsed ;
|
||||||
|
|
||||||
|
SYNTAX: S@
|
||||||
|
scan-word scan-object swap memory>struct parsed ;
|
||||||
|
|
||||||
! functor support
|
! functor support
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
Loading…
Reference in New Issue