From 0f9ccaa35275c005fcb101612ab93e18a4693809 Mon Sep 17 00:00:00 2001
From: James Cash <james.nvc@gmail.com>
Date: Wed, 5 Nov 2008 23:50:33 -0500
Subject: [PATCH] Working on implementation of 'around' advice
---
extra/advice/advice.factor | 31 +++++++++++++++++++++++--------
1 file changed, 23 insertions(+), 8 deletions(-)
diff --git a/extra/advice/advice.factor b/extra/advice/advice.factor
index 12874be1f1..3fb6941854 100644
--- 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