]> gitweb.factorcode.org Git - factor.git/commitdiff
fix up struct parsing/printing
authorJoe Groff <arcata@gmail.com>
Thu, 20 Aug 2009 01:21:57 +0000 (20:21 -0500)
committerJoe Groff <arcata@gmail.com>
Thu, 20 Aug 2009 01:21:57 +0000 (20:21 -0500)
extra/classes/struct/prettyprint/prettyprint.factor
extra/classes/struct/struct-tests.factor
extra/classes/struct/struct.factor

index 517aa343c6df7016124ca09de678064b5e34f978..6bf62f694cc2904f9d92e8781431abd6361188a1 100644 (file)
@@ -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
index 3ab6593070f6ca6f0ed3bdcbe89a698104f23b72..80bd160292c1168f7cf7015e79f3cf391b3a6afa 100644 (file)
@@ -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
+
index 2b2aa49aeb3087b7fbd5b8a3e228520960d7cd15..675e1cf0258aad7a830f2c5e838653319c52b2fc 100644 (file)
@@ -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 ;