Have method combinations themselves make their consultation quotations.

[factor.git] / basis / delegate / delegate.factor

diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor
index ff9574c066feb26222b0d96cacade2430cf62ebb..5d5ac044a1a92311d5e402e0ae7625a257a2f744 100644 (file)
--- a/basis/delegate/delegate.factor
+++ b/basis/delegate/delegate.factor
@@ -1,10 +1,10 @@
 ! Copyright (C) 2007, 2008 Daniel Ehrenberg
 ! Portions copyright (C) 2009, 2010 Slava Pestov, Joe Groff
 ! See https://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs classes classes.tuple
-compiler.units definitions effects fry generic generic.standard
-hashtables kernel lexer make math namespaces parser sequences
-sets slots words words.symbol ;
+USING: accessors arrays assocs classes classes.tuple combinators
+compiler.units definitions effects fry generic generic.hook generic.standard
+hashtables kernel lexer make math namespaces parser sequences sets slots
+words words.symbol ;
 IN: delegate
 
 ERROR: broadcast-words-must-have-no-outputs group ;
@@ -44,8 +44,6 @@ M: tuple-class group-words
 
 TUPLE: consultation group class quot loc ;
 
-TUPLE: hook-consultation < consultation ;
-
 TUPLE: broadcast < consultation ;
 
 : <consultation> ( group class quot -- consultation )
@@ -54,9 +52,6 @@ TUPLE: broadcast < consultation ;
 : <broadcast> ( group class quot -- consultation )
     [ check-broadcast-group ] 2dip f broadcast boa ;
 
-: <hook-consultation> ( group class quot -- hook-consultation )
-    f hook-consultation boa ;
-
 : create-consult-method ( word consultation -- method )
     [ class>> swap first create-method dup fake-definition ] keep
     [ drop ] [ "consultation" set-word-prop ] 2bi ;
@@ -70,17 +65,11 @@ M: consult-method reset-word
 GENERIC#: (consult-method-quot) 2 ( consultation quot word -- object )
 
 M: consultation (consult-method-quot)
-    '[ _ call _ execute ] nip ;
+    dup "combination" word-prop make-consult-quot ;
 
 M: broadcast (consult-method-quot)
     '[ _ call [ _ execute ] each ] nip ;
 
-M: hook-consultation (consult-method-quot) ( consultation quot word -- object )
-    [ drop ] 2dip ! consultation no longer necessary
-    dup "combination" word-prop var>> ! (quot word var)
-    -rot ! (var quot word)
-    '[ _ _ call swap [ _ execute ] with-variable ] ;
-
 : consult-method-quot ( consultation word -- object )
     [ dup quot>> ] dip
     [ second [ [ dip ] curry ] times ] [ first ] bi
@@ -124,10 +113,6 @@ SYNTAX: CONSULT:
     scan-word scan-word parse-definition <consultation>
     [ save-location ] [ define-consult ] bi ;
 
-SYNTAX: HOOK-CONSULT:
-    scan-word scan-word parse-definition <hook-consultation>
-    [ save-location ] [ define-consult ] bi ;
-
 SYNTAX: BROADCAST:
     scan-word scan-word parse-definition <broadcast>
     [ save-location ] [ define-consult ] bi ;