! (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
! (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
[ 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
+
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
PREDICATE: struct-class < tuple-class
\ struct subclass-of? ;
-M: struct-class struct-slots
+: struct-slots ( struct -- slots )
"struct-slots" word-prop ;
! struct allocation
] [ ] 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 ]
: (struct-word-props) ( class slots size align -- )
[
- [ struct-slots ]
+ [ "struct-slots" set-word-prop ]
[ define-accessors ] 2bi
]
[ "struct-size" set-word-prop ]
"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 ;