]> gitweb.factorcode.org Git - factor.git/commitdiff
delegate: use string word-prop keys.
authorJohn Benediktsson <mrjbq7@gmail.com>
Fri, 15 Apr 2016 03:19:54 +0000 (20:19 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Fri, 15 Apr 2016 03:19:54 +0000 (20:19 -0700)
basis/delegate/delegate-tests.factor
basis/delegate/delegate.factor

index 9c79c5e8e511fb0e62d64405c1a96a9eb15ff03b..845e227e61ab09af3b32ad5b8ef778fb30b6363b 100644 (file)
@@ -192,7 +192,7 @@ DEFER: seq-delegate
 
 { t } [
     seq-delegate
-    sequence-protocol \ protocol-consult word-prop
+    sequence-protocol "protocol-consult" word-prop
     key?
 ] unit-test
 
@@ -205,7 +205,7 @@ DEFER: seq-delegate
 
 { f } [
     seq-delegate
-    sequence-protocol \ protocol-consult word-prop
+    sequence-protocol "protocol-consult" word-prop
     key?
 ] unit-test
 
index 6a18de6c0eba702fb90663184d28b59cc19db69d..e1c44d1efab8f393943bb74dafe1f0068530305d 100644 (file)
@@ -12,10 +12,10 @@ ERROR: broadcast-words-must-have-no-outputs group ;
 <PRIVATE
 
 : protocol-words ( protocol -- words )
-    \ protocol-words word-prop ;
+    "protocol-words" word-prop ;
 
 : protocol-consult ( protocol -- consulters )
-    \ protocol-consult word-prop ;
+    "protocol-consult" word-prop ;
 
 GENERIC: group-words ( group -- words )
 
@@ -43,10 +43,12 @@ M: tuple-class group-words
 ! Consultation
 
 TUPLE: consultation group class quot loc ;
+
 TUPLE: broadcast < consultation ;
 
 : <consultation> ( group class quot -- consultation )
     f consultation boa ;
+
 : <broadcast> ( group class quot -- consultation )
     [ check-broadcast-group ] 2dip f broadcast boa ;
 
@@ -64,6 +66,7 @@ GENERIC# (consult-method-quot) 2 ( consultation quot word -- object )
 
 M: consultation (consult-method-quot)
     '[ _ call _ execute ] nip ;
+
 M: broadcast (consult-method-quot)
     '[ _ call [ _ execute ] each ] nip ;
 
@@ -81,7 +84,7 @@ M: broadcast (consult-method-quot)
     [ [ group>> group-words ] keep ] dip curry each ; inline
 
 : register-consult ( consultation -- )
-    [ group>> \ protocol-consult ] [ ] [ class>> ] tri
+    [ group>> "protocol-consult" ] [ ] [ class>> ] tri
     '[ [ _ _ ] dip ?set-at ] change-word-prop ;
 
 : consult-methods ( consultation -- )
@@ -89,7 +92,7 @@ M: broadcast (consult-method-quot)
 
 : unregister-consult ( consultation -- )
     [ class>> ] [ group>> ] bi
-    \ protocol-consult word-prop delete-at ;
+    "protocol-consult" word-prop delete-at ;
 
 : unconsult-method ( word consultation -- )
     [ class>> swap first ?lookup-method ] keep
@@ -146,9 +149,9 @@ M: consultation forget*
 
 : initialize-protocol-props ( protocol wordlist -- )
     [
-        drop \ protocol-consult
+        drop "protocol-consult"
         [ H{ } assoc-like ] change-word-prop
-    ] [ { } like \ protocol-words set-word-prop ] 2bi ;
+    ] [ { } like "protocol-words" set-word-prop ] 2bi ;
 
 : fill-in-depth ( wordlist -- wordlist' )
     [ dup word? [ 0 2array ] when ] map ;
@@ -181,7 +184,6 @@ PREDICATE: protocol < word protocol-words ; ! Subclass of symbol?
 M: protocol forget*
     [ f forget-old-definitions ] [ call-next-method ] bi ;
 
-
 M: protocol definition protocol-words show-words ;
 
 M: protocol definer drop \ PROTOCOL: \ ; ;