steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix up struct parsing/printing

db4
Joe Groff 2009-08-19 20:21:57 -05:00
parent d99a126ca4
commit 4d95e5ef2e
3 changed files with 18 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
extra/classes/struct/prettyprint/prettyprint.factor
View File

@ -1,6 +1,7 @@
! (c)Joe Groff bsd license ! (c)Joe Groff bsd license
USING: classes.struct kernel prettyprint.backend prettyprint.custom USING: accessors assocs classes classes.struct kernel math
prettyprint.sections see.private sequences words ; prettyprint.backend prettyprint.custom prettyprint.sections
see.private sequences words ;
IN: classes.struct.prettyprint IN: classes.struct.prettyprint
<PRIVATE <PRIVATE

10
extra/classes/struct/struct-tests.factor
View File

@ -1,6 +1,7 @@
! (c)Joe Groff bsd license ! (c)Joe Groff bsd license
USING: accessors alien.c-types classes.c-types classes.struct 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 IN: classes.struct.tests
STRUCT: foo STRUCT: foo
@ -38,3 +39,10 @@ UNION-STRUCT: float-and-bits
[ 4 ] [ float-and-bits heap-size ] unit-test [ 4 ] [ float-and-bits heap-size ] unit-test
[ ] [ foo malloc-struct free ] 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

12
extra/classes/struct/struct.factor
View File

@ -3,8 +3,8 @@ USING: accessors alien alien.c-types byte-arrays classes
classes.c-types classes.parser classes.tuple classes.c-types classes.parser classes.tuple
classes.tuple.parser classes.tuple.private combinators classes.tuple.parser classes.tuple.private combinators
combinators.smart fry generalizations generic.parser kernel combinators.smart fry generalizations generic.parser kernel
kernel.private libc macros make math math.order quotations kernel.private libc macros make math math.order parser
sequences slots slots.private struct-arrays words ; quotations sequences slots slots.private struct-arrays words ;
IN: classes.struct IN: classes.struct
! struct class ! struct class
@ -15,7 +15,7 @@ TUPLE: struct
PREDICATE: struct-class < tuple-class PREDICATE: struct-class < tuple-class
\ struct subclass-of? ; \ struct subclass-of? ;
M: struct-class struct-slots : struct-slots ( struct -- slots )
"struct-slots" word-prop ; "struct-slots" word-prop ;
! struct allocation ! struct allocation
@ -48,7 +48,7 @@ MACRO: <struct-boa> ( class -- quot: ( ... -- struct ) )
] [ ] output>sequence ; ] [ ] output>sequence ;
: pad-struct-slots ( values class -- values' class ) : 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 ) : (writer-quot) ( slot -- quot )
[ class>> c-setter ] [ class>> c-setter ]
@ -136,7 +136,7 @@ M: struct-class direct-array-of
: (struct-word-props) ( class slots size align -- ) : (struct-word-props) ( class slots size align -- )
[ [
[ struct-slots ] [ "struct-slots" set-word-prop ]
[ define-accessors ] 2bi [ define-accessors ] 2bi
] ]
[ "struct-size" set-word-prop ] [ "struct-size" set-word-prop ]
@ -174,4 +174,4 @@ USING: vocabs vocabs.loader ;
"prettyprint" vocab [ "classes.struct.prettyprint" require ] when "prettyprint" vocab [ "classes.struct.prettyprint" require ] when
SYNTAX: S{ SYNTAX: S{
scan-word dup struct-slots parse-tuple-literal-slots ; scan-word dup struct-slots parse-tuple-literal-slots parsed ;