classes.struct: implement "group-words" method on struct-class so that struct classes can be used as a CONSULT: protocol

db4
Joe Groff 2010-06-08 12:52:46 -07:00
parent dd71d20e4e
commit b5cc5ef4a7
3 changed files with 23 additions and 3 deletions

View File

@ -2,7 +2,7 @@
USING: accessors alien alien.c-types alien.data alien.syntax ascii
assocs byte-arrays classes.struct classes.tuple.parser
classes.tuple.private classes.tuple combinators compiler.tree.debugger
compiler.units destructors io.encodings.utf8 io.pathnames
compiler.units delegate destructors io.encodings.utf8 io.pathnames
io.streams.string kernel libc literals math mirrors namespaces
prettyprint prettyprint.config see sequences specialized-arrays
system tools.test parser lexer eval layouts generic.single classes
@ -461,3 +461,16 @@ cpu ppc? [
[ 12 ] [ ppc-align-test-2 heap-size ] unit-test
[ 4 ] [ "x" ppc-align-test-2 offset-of ] unit-test
] when
STRUCT: struct-test-delegate
{ a int } ;
STRUCT: struct-test-delegator
{ del struct-test-delegate }
{ b int } ;
CONSULT: struct-test-delegate struct-test-delegator del>> ;
[ S{ struct-test-delegator f S{ struct-test-delegate f 7 } 8 } ] [
struct-test-delegator <struct>
7 >>a
8 >>b
] unit-test

View File

@ -10,6 +10,7 @@ slots slots.private specialized-arrays vectors words summary
namespaces assocs vocabs.parser math.functions
classes.struct.bit-accessors bit-arrays
stack-checker.dependencies system layouts ;
FROM: delegate.private => group-words slot-group-words ;
QUALIFIED: math
IN: classes.struct
@ -38,6 +39,9 @@ SLOT: fields
: struct-slots ( struct-class -- slots )
"c-type" word-prop fields>> ;
M: struct-class group-words
struct-slots slot-group-words ;
! struct allocation
M: struct >c-ptr

View File

@ -22,14 +22,17 @@ GENERIC: group-words ( group -- words )
M: standard-generic group-words
dup "combination" word-prop #>> 2array 1array ;
M: tuple-class group-words
all-slots [
: slot-group-words ( slots -- words )
[
name>>
[ reader-word 0 2array ]
[ writer-word 0 2array ] bi
2array
] map concat ;
M: tuple-class group-words
all-slots slot-group-words ;
: check-broadcast-group ( group -- group )
dup group-words [ first stack-effect out>> empty? ] all?
[ broadcast-words-must-have-no-outputs ] unless ;