From 4d95e5ef2ebe4df4d5ad0d6aec7e32708c55cac5 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 19 Aug 2009 20:21:57 -0500
Subject: [PATCH] fix up struct parsing/printing

---
 extra/classes/struct/prettyprint/prettyprint.factor |  5 +++--
 extra/classes/struct/struct-tests.factor            | 10 +++++++++-
 extra/classes/struct/struct.factor                  | 12 ++++++------
 3 files changed, 18 insertions(+), 9 deletions(-)

diff --git a/extra/classes/struct/prettyprint/prettyprint.factor b/extra/classes/struct/prettyprint/prettyprint.factor
index 517aa343c6..6bf62f694c 100644
--- a/extra/classes/struct/prettyprint/prettyprint.factor
+++ b/extra/classes/struct/prettyprint/prettyprint.factor
@@ -1,6 +1,7 @@
 ! (c)Joe Groff bsd license
-USING: classes.struct kernel prettyprint.backend prettyprint.custom
-prettyprint.sections see.private sequences words ;
+USING: accessors assocs classes classes.struct kernel math
+prettyprint.backend prettyprint.custom prettyprint.sections
+see.private sequences words ;
 IN: classes.struct.prettyprint
 
 <PRIVATE
diff --git a/extra/classes/struct/struct-tests.factor b/extra/classes/struct/struct-tests.factor
index 3ab6593070..80bd160292 100644
--- a/extra/classes/struct/struct-tests.factor
+++ b/extra/classes/struct/struct-tests.factor
@@ -1,6 +1,7 @@
 ! (c)Joe Groff bsd license
 USING: accessors alien.c-types classes.c-types classes.struct
-combinators kernel libc math tools.test ;
+combinators io.streams.string kernel libc math namespaces
+prettyprint prettyprint.config tools.test ;
 IN: classes.struct.tests
 
 STRUCT: foo
@@ -38,3 +39,10 @@ UNION-STRUCT: float-and-bits
 [ 4 ] [ float-and-bits heap-size ] unit-test
 
 [ ] [ foo malloc-struct free ] unit-test
+
+[ "S{ foo { y 7654 } }" ]
+[ f boa-tuples? [ foo <struct> 7654 >>y [ pprint ] with-string-writer ] with-variable ] unit-test
+
+[ "S{ foo f 0 7654 f }" ]
+[ t boa-tuples? [ foo <struct> 7654 >>y [ pprint ] with-string-writer ] with-variable ] unit-test
+
diff --git a/extra/classes/struct/struct.factor b/extra/classes/struct/struct.factor
index 2b2aa49aeb..675e1cf025 100644
--- a/extra/classes/struct/struct.factor
+++ b/extra/classes/struct/struct.factor
@@ -3,8 +3,8 @@ USING: accessors alien alien.c-types byte-arrays classes
 classes.c-types classes.parser classes.tuple
 classes.tuple.parser classes.tuple.private combinators
 combinators.smart fry generalizations generic.parser kernel
-kernel.private libc macros make math math.order quotations
-sequences slots slots.private struct-arrays words ;
+kernel.private libc macros make math math.order parser
+quotations sequences slots slots.private struct-arrays words ;
 IN: classes.struct
 
 ! struct class
@@ -15,7 +15,7 @@ TUPLE: struct
 PREDICATE: struct-class < tuple-class
     \ struct subclass-of? ;
 
-M: struct-class struct-slots
+: struct-slots ( struct -- slots )
     "struct-slots" word-prop ;
 
 ! struct allocation
@@ -48,7 +48,7 @@ MACRO: <struct-boa> ( class -- quot: ( ... -- struct ) )
     ] [ ] output>sequence ;
 
 : pad-struct-slots ( values class -- values' class )
-    [ class-slots [ initial>> ] map over length tail append ] keep ;
+    [ struct-slots [ initial>> ] map over length tail append ] keep ;
 
 : (writer-quot) ( slot -- quot )
     [ class>> c-setter ]
@@ -136,7 +136,7 @@ M: struct-class direct-array-of
 
 : (struct-word-props) ( class slots size align -- )
     [
-        [ struct-slots ]
+        [ "struct-slots" set-word-prop ]
         [ define-accessors ] 2bi
     ]
     [ "struct-size" set-word-prop ]
@@ -174,4 +174,4 @@ USING: vocabs vocabs.loader ;
 "prettyprint" vocab [ "classes.struct.prettyprint" require ] when
 
 SYNTAX: S{
-    scan-word dup struct-slots parse-tuple-literal-slots ;
+    scan-word dup struct-slots parse-tuple-literal-slots parsed ;