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
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

10
extra/classes/struct/struct-tests.factor
View 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

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.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 ;