]> gitweb.factorcode.org Git - factor.git/commitdiff
Changing extra/advice to use coreset instead of coterminate
authorJames Cash <james.nvc@gmail.com>
Fri, 7 Nov 2008 01:03:04 +0000 (20:03 -0500)
committerJames Cash <james.nvc@gmail.com>
Tue, 11 Nov 2008 07:33:18 +0000 (02:33 -0500)
extra/advice/advice-tests.factor
extra/advice/advice.factor

index 17b60c8fb1e85ff7ee2cf245a99249fa0ba9ecf8..b359d5596fe2de76af6a167467215ce0e10a0e7c 100644 (file)
@@ -23,18 +23,42 @@ IN: advice.tests
 \ bar make-advised
 
   { 11 } [
-     [ 2 * ] "double" \ bar advise-before
-     5 bar
+    [ 2 * ] "double" \ bar advise-before
+    5 bar
   ] unit-test 
 
   { 11/3 } [
-      [ 3 / ] "third" \ bar advise-after
-      5 bar
+    [ 3 / ] "third" \ bar advise-after
+     5 bar
   ] unit-test
 
   { -2 } [
-      [ -1 * ad-do-it 3 + ] "frobnobicate" \ bar advise-around
-      5 bar
+    [ -1 * ad-do-it 3 + ] "frobnobicate" \ bar advise-around
+    5 bar
+  ] unit-test
+
+: add ( a b -- c ) + ;
+\ add make-advised
+
+  { 10 } [
+    [ [ 2 * ] bi@ ] "double-args" \ add advise-before
+    2 3 add
+  ] unit-test 
+
+  { 21 } [
+    [ 3 * ad-do-it 1- ] "around1" \ add advise-around
+    2 3 add
+  ] unit-test 
+
+  { 9 } [
+    [ [ 1- ] bi@ ad-do-it 2 / ] "around2" \ add advise-around
+    2 3 add
   ] unit-test
+
+  { 5 } [
+      \ add unadvise
+      2 3 add
+  ] unit-test
+
  
  ] with-scope
\ No newline at end of file
index 6a7d46f935cfb40b5321a20c5ea0e1edc019f7fc..b164c2c1a92e6cac49ebfce30db1e90b8690b649 100644 (file)
@@ -3,6 +3,8 @@
 USING: kernel sequences symbols fry words assocs tools.annotations coroutines ;
 IN: advice
 
+! TODO: What should be the order in which the advice is called?
+
 SYMBOLS: before after around advised ;
 
 <PRIVATE
@@ -17,7 +19,7 @@ PRIVATE>
     after advise ;
 
 : advise-around ( quot name word --  )
-    [ \ coterminate suffix ] 2dip
+    [ \ coreset suffix cocreate ] 2dip
     around advise ;
 
 : get-advice ( word type -- seq )
@@ -30,7 +32,7 @@ PRIVATE>
     after get-advice [ call ] each ;
 
 : call-around ( main word --  )
-    around get-advice [ cocreate ] map tuck 
+    around get-advice tuck 
     [ [ coresume ] each ] [ call ] [ reverse [ coresume ] each ] tri* ;
 
 : remove-advice ( name word loc --  )
@@ -46,4 +48,6 @@ PRIVATE>
     [ dup [ over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ]
     [ { before after around } [ H{ } clone swap set-word-prop ] with each ] 
     [ t advised set-word-prop ] tri ;
-    
\ No newline at end of file
+
+: unadvise ( word --  )
+    [ reset ] [ { before after around advised } [ f swap set-word-prop ] with each ] bi ;
\ No newline at end of file