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

basis/classes/struct/struct-tests.factor

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

basis/classes/struct/struct.factor

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

basis/delegate/delegate.factor

@@ -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
+: slot-group-words ( slots -- words )
-    all-slots [
+    [
         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 ;