From b5cc5ef4a7c3622529733c0d1de5755f0d718637 Mon Sep 17 00:00:00 2001
From: Joe Groff <joe@victoria.(none)>
Date: Tue, 8 Jun 2010 12:52:46 -0700
Subject: [PATCH] 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 | 15 ++++++++++++++-
 basis/classes/struct/struct.factor       |  4 ++++
 basis/delegate/delegate.factor           |  7 +++++--
 3 files changed, 23 insertions(+), 3 deletions(-)

diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor
index e841881d28..4ed7d9b446 100644
--- a/basis/classes/struct/struct-tests.factor
+++ b/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
diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index 97dbe16d30..b0f315b335 100644
--- a/basis/classes/struct/struct.factor
+++ b/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
diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor
index 5bbd62dfa8..ebd6a05b48 100644
--- a/basis/delegate/delegate.factor
+++ b/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
-    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 ;
-- 
2.34.1