struct boa

Joe Groff 2009-08-12 09:37:39 -04:00
parent 4ae3e3f5d7
commit 9970b6fdd0
1 changed files with 16 additions and 2 deletions

View File

@ -1,8 +1,9 @@
! (c)Joe Groff bsd license ! (c)Joe Groff bsd license
USING: accessors alien alien.c-types byte-arrays classes 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 fry kernel classes.tuple.parser classes.tuple.private combinators
kernel.private libc make math math.order sequences slots combinators.smart fry generalizations kernel kernel.private
libc macros make math math.order quotations sequences slots
slots.private words ; slots.private words ;
IN: classes.struct IN: classes.struct
@ -33,6 +34,19 @@ M: struct-class new
dup "prototype" word-prop dup "prototype" word-prop
[ >c-ptr clone swap memory>struct ] [ <struct> ] if* ; inline [ >c-ptr clone swap memory>struct ] [ <struct> ] if* ; inline
MACRO: <struct-boa> ( class -- quot: ( ... -- struct ) )
[
[ \ <struct> [ ] 2sequence ]
[
"struct-slots" word-prop
[ length \ ndip ]
[ [ name>> setter-word 1quotation ] map \ spread ] bi
] bi
] [ ] output>sequence ;
M: struct-class boa
<struct-boa> ; inline
! Struct slot accessors ! Struct slot accessors
M: struct-class reader-quot M: struct-class reader-quot