]> gitweb.factorcode.org Git - factor.git/commitdiff
classes.struct: implement "group-words" method on struct-class so that struct classes...
authorJoe Groff <joe@victoria.(none)>
Tue, 8 Jun 2010 19:52:46 +0000 (12:52 -0700)
committerJoe Groff <joe@victoria.(none)>
Tue, 8 Jun 2010 19:52:46 +0000 (12:52 -0700)
basis/classes/struct/struct-tests.factor
basis/classes/struct/struct.factor
basis/delegate/delegate.factor

index e841881d28190257f38862e3780646be3470958b..4ed7d9b446deb1716e6fa17433d0811bc2633fc8 100644 (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
index 97dbe16d30ba4f3f13acc88ac01706589aba99c4..b0f315b3359231830d50f8b7394215d5fe2bb7f3 100644 (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
index 5bbd62dfa8c9f0389586c8b52b4c2d11be7c3514..ebd6a05b482c30025bb246d3c4a17549f516c866 100644 (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 ;