Clean up stack shuffling in basis/delegate/
parent
6e2f60729f
commit
f6bc5c0b75
|
@ -38,7 +38,7 @@ M: hello bing hello-test ;
|
|||
[ H{ { goodbye [ these>> ] } } ] [ baz protocol-consult ] unit-test
|
||||
[ H{ } ] [ bee protocol-consult ] unit-test
|
||||
|
||||
[ "USING: delegate ;\nIN: delegate.tests\nPROTOCOL: baz foo bar { whoa 1 } ;\n" ] [ [ baz see ] with-string-writer ] unit-test
|
||||
[ "USING: delegate ;\nIN: delegate.tests\nPROTOCOL: baz foo bar { whoa 1 } ; inline\n" ] [ [ baz see ] with-string-writer ] unit-test
|
||||
|
||||
GENERIC: one
|
||||
M: integer one ;
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs classes.tuple definitions
|
||||
generalizations generic hashtables kernel lexer make math parser
|
||||
sequences sets slots words words.symbol ;
|
||||
sequences sets slots words words.symbol fry ;
|
||||
IN: delegate
|
||||
|
||||
: protocol-words ( protocol -- words )
|
||||
|
@ -29,14 +29,15 @@ M: tuple-class group-words
|
|||
define ;
|
||||
|
||||
: change-word-prop ( word prop quot -- )
|
||||
rot props>> swap change-at ; inline
|
||||
[ swap props>> ] dip change-at ; inline
|
||||
|
||||
: register-protocol ( group class quot -- )
|
||||
rot \ protocol-consult [ swapd ?set-at ] change-word-prop ;
|
||||
[ \ protocol-consult ] 2dip
|
||||
'[ [ _ _ swap ] dip ?set-at ] change-word-prop ;
|
||||
|
||||
: define-consult ( group class quot -- )
|
||||
[ register-protocol ]
|
||||
[ [ group-words ] 2dip [ consult-method ] 2curry each ]
|
||||
[ [ group-words ] 2dip '[ _ _ consult-method ] each ]
|
||||
3bi ;
|
||||
|
||||
: CONSULT:
|
||||
|
|
Loading…
Reference in New Issue