likewise, an S@ word for structs

diff --git a/basis/classes/struct/prettyprint/prettyprint.factor b/basis/classes/struct/prettyprint/prettyprint.factor
index 6368424ec66ceb6e4aa18486752c66bd1909dfd9..d2ae17b9ce2521ef9c1b2a58af6bc249aba8a401 100644 (file)
--- 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 0cd91da37050f7a8f7ce40aaac736fdd034afcca..cf9c17da8bf7e368a5ba23d148bb644f117ca542 100644 (file)
--- 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 <struct> 7654 >>y [ pprint ] with-string-writer ]
-    with-variable
+    [
+        boa-tuples? off
+        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
 
 [ "S{ struct-test-foo f 0 7654 f }" ]
 [
-    t boa-tuples?
-    [ struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer ]
-    with-variable
+    [
+        boa-tuples? on
+        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
 
 [ <" USING: classes.struct ;

diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index 99150e9bb68be795310deda617aee80fb573607b..6ea4a6c5b53c1f080875d3d13dd41d1d9a245939 100644 (file)
--- 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
 
 <PRIVATE