steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

delegate: fix delegation to tuples with read only slots

db4
Slava Pestov 2010-09-04 18:48:54 -07:00
parent 12b63c5957
commit 4995d9153e
2 changed files with 21 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
basis/delegate/delegate-tests.factor
View File

@ -93,6 +93,17 @@ CONSULT: slot-protocol-test-2 slot-protocol-test-3 d>> ;
[ a>> ] [ b>> ] [ c>> ] tri
] unit-test
TUPLE: slot-protocol-test-4 { x read-only } ;
TUPLE: slot-protocol-test-5 { a-read-only-slot read-only } ;
CONSULT: slot-protocol-test-5 slot-protocol-test-4 x>> ;
[ "hey" ] [
"hey" slot-protocol-test-5 boa slot-protocol-test-4 boa
a-read-only-slot>>
] unit-test
GENERIC: do-me ( x -- )
M: f do-me drop ;

17
basis/delegate/delegate.factor
View File

@ -4,7 +4,7 @@
USING: accessors arrays assocs classes.tuple definitions effects generic
generic.standard hashtables kernel lexer math parser
generic.parser sequences sets slots words words.symbol fry
compiler.units ;
compiler.units make ;
IN: delegate
ERROR: broadcast-words-must-have-no-outputs group ;
@ -22,13 +22,16 @@ GENERIC: group-words ( group -- words )
M: standard-generic group-words
dup "combination" word-prop #>> 2array 1array ;
: slot-group-words ( slots -- words )
: slot-words, ( slot-spec -- )
[ name>> reader-word 0 2array , ]
[
name>>
[ reader-word 0 2array ]
[ writer-word 0 2array ] bi
2array
] map concat ;
dup read-only>> [ drop ] [
name>> writer-word 0 2array ,
] if
] bi ;
: slot-group-words ( slots -- words )
[ [ slot-words, ] each ] { } make ;
M: tuple-class group-words
all-slots slot-group-words ;