steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Changing extra/advice to use coreset instead of coterminate

db4
James Cash 2008-11-06 20:03:04 -05:00
parent 1ca40efa12
commit e149088f2f
2 changed files with 37 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
extra/advice/advice-tests.factor
View File

@ -23,18 +23,42 @@ IN: advice.tests
\ bar make-advised \ bar make-advised
{ 11 } [ { 11 } [
[ 2 * ] "double" \ bar advise-before [ 2 * ] "double" \ bar advise-before
5 bar 5 bar
] unit-test ] unit-test
{ 11/3 } [ { 11/3 } [
[ 3 / ] "third" \ bar advise-after [ 3 / ] "third" \ bar advise-after
5 bar 5 bar
] unit-test ] unit-test
{ -2 } [ { -2 } [
[ -1 * ad-do-it 3 + ] "frobnobicate" \ bar advise-around [ -1 * ad-do-it 3 + ] "frobnobicate" \ bar advise-around
5 bar 5 bar
] unit-test ] 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 ] with-scope

10
extra/advice/advice.factor
View File

@ -3,6 +3,8 @@
USING: kernel sequences symbols fry words assocs tools.annotations coroutines ; USING: kernel sequences symbols fry words assocs tools.annotations coroutines ;
IN: advice IN: advice
! TODO: What should be the order in which the advice is called?
SYMBOLS: before after around advised ; SYMBOLS: before after around advised ;
<PRIVATE <PRIVATE
@ -17,7 +19,7 @@ PRIVATE>
after advise ; after advise ;
: advise-around ( quot name word -- ) : advise-around ( quot name word -- )
[ \ coterminate suffix ] 2dip [ \ coreset suffix cocreate ] 2dip
around advise ; around advise ;
: get-advice ( word type -- seq ) : get-advice ( word type -- seq )
@ -30,7 +32,7 @@ PRIVATE>
after get-advice [ call ] each ; after get-advice [ call ] each ;
: call-around ( main word -- ) : call-around ( main word -- )
around get-advice [ cocreate ] map tuck around get-advice tuck
[ [ coresume ] each ] [ call ] [ reverse [ coresume ] each ] tri* ; [ [ coresume ] each ] [ call ] [ reverse [ coresume ] each ] tri* ;
: remove-advice ( name word loc -- ) : remove-advice ( name word loc -- )
@ -46,4 +48,6 @@ PRIVATE>
[ dup [ over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ] [ dup [ over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ]
[ { before after around } [ H{ } clone swap set-word-prop ] with each ] [ { before after around } [ H{ } clone swap set-word-prop ] with each ]
[ t advised set-word-prop ] tri ; [ t advised set-word-prop ] tri ;
: unadvise ( word -- )
[ reset ] [ { before after around advised } [ f swap set-word-prop ] with each ] bi ;