\ 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
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
after advise ;
: advise-around ( quot name word -- )
- [ \ coterminate suffix ] 2dip
+ [ \ coreset suffix cocreate ] 2dip
around advise ;
: get-advice ( word type -- seq )
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 -- )
[ 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