Working on implementation of 'around' advice

diff --git a/extra/advice/advice.factor b/extra/advice/advice.factor
index 12874be1f1ee93401ad29d622b372878c1f3f203..3fb694185424ebb7d31583f2b54e01f57edc105c 100644 (file)
--- a/extra/advice/advice.factor
+++ b/extra/advice/advice.factor
@@ -1,10 +1,23 @@
 ! Copyright (C) 2008 James Cash
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences symbols fry words assocs tools.annotations ;
+USING: kernel sequences symbols fry words assocs tools.annotations coroutines ;
 IN: advice
 
 SYMBOLS: before after around ;
 
+: advise ( quot name word loc --  )
+    word-prop set-at ;
+    
+: advise-before ( quot name word --  )
+    before advise ;
+    
+: advise-after ( quot name word --  )
+    after advise ;
+
+: advise-around ( quot name word --  )
+    [ \ coterminate suffix cocreate ] 2dip
+    around advise ;
+
 : get-advice ( word type -- seq )
     word-prop values ;
 
@@ -13,17 +26,19 @@ SYMBOLS: before after around ;
 
 : call-after ( word --  )
     after get-advice [ call ] each ;
-    
-: advise-before ( quot name word --  )
-    before word-prop set-at ;
-    
-: advise-after ( quot name word --  )
-    after word-prop set-at ;
+
+: call-around ( main word --  )
+    around get-advice [ [ coresume ] each ] dip call
+    around get-advice reverse [ coresume ] each ;
 
 : remove-advice ( name word loc --  )
     word-prop delete-at ;
+
+: ad-do-it ( input -- result )
+    coyield ;
+    
     
 : make-advised ( word -- )
-    [ dup [ over '[ _ call-before @  _ call-after ] ] annotate ]
+    [ dup [ over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ]
     [ { before after around } [ H{ } clone swap set-word-prop ] with each ] bi ;
     
\ No newline at end of file