classes.struct: implement "group-words" method on struct-class so that struct classes can be used as a CONSULT: protocol
parent
dd71d20e4e
commit
b5cc5ef4a7
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue