diff --git a/basis/classes/struct/prettyprint/prettyprint.factor b/basis/classes/struct/prettyprint/prettyprint.factor index 6368424ec6..d2ae17b9ce 100644 --- a/basis/classes/struct/prettyprint/prettyprint.factor +++ b/basis/classes/struct/prettyprint/prettyprint.factor @@ -1,6 +1,6 @@ ! (c)Joe Groff bsd license -USING: accessors assocs classes classes.struct combinators -kernel math prettyprint.backend prettyprint.custom +USING: accessors alien assocs classes classes.struct +combinators kernel math prettyprint.backend prettyprint.custom prettyprint.sections see.private sequences strings words ; IN: classes.struct.prettyprint @@ -24,6 +24,14 @@ IN: classes.struct.prettyprint } cleave \ } 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> M: struct-class see-class* @@ -38,4 +46,5 @@ M: struct >pprint-sequence [ class ] [ struct-slot-values ] bi class-slot-sequence ; M: struct pprint* - [ [ \ S{ ] dip [ class ] [ struct>assoc ] bi \ } (pprint-tuple) ] ?pprint-tuple ; + [ pprint-struct ] + [ pprint-struct-pointer ] pprint-c-object ; diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 0cd91da370..cf9c17da8b 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -1,7 +1,7 @@ ! (c)Joe Groff bsd license USING: accessors alien alien.c-types alien.libraries -alien.structs.fields alien.syntax ascii classes.struct combinators -destructors io.encodings.utf8 io.pathnames io.streams.string +alien.structs.fields alien.syntax ascii byte-arrays classes.struct +combinators destructors io.encodings.utf8 io.pathnames io.streams.string kernel libc literals math multiline namespaces prettyprint prettyprint.config see sequences specialized-arrays.ushort system tools.test compiler.tree.debugger struct-arrays @@ -78,16 +78,36 @@ STRUCT: struct-test-string-ptr [ "S{ struct-test-foo { y 7654 } }" ] [ - f boa-tuples? - [ struct-test-foo 7654 >>y [ pprint ] with-string-writer ] - with-variable + [ + boa-tuples? off + c-object-pointers? off + struct-test-foo 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 struct-test-foo memory>struct [ pprint ] with-string-writer + ] with-scope ] unit-test [ "S{ struct-test-foo f 0 7654 f }" ] [ - t boa-tuples? - [ struct-test-foo 7654 >>y [ pprint ] with-string-writer ] - with-variable + [ + boa-tuples? on + c-object-pointers? off + struct-test-foo 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 [ <" USING: classes.struct ; diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 99150e9bb6..6ea4a6c5b5 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -277,6 +277,9 @@ SYNTAX: UNION-STRUCT: SYNTAX: S{ scan-word dup struct-slots parse-tuple-literal-slots parsed ; +SYNTAX: S@ + scan-word scan-object swap memory>struct parsed ; + ! functor support