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

Naive around-advice working

db4
James Cash 2008-11-06 00:44:11 -05:00
parent d530ec6bd5
commit 894d9a67c9
1 changed files with 4 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/advice/advice.factor
View File

@ -5,8 +5,10 @@ IN: advice
SYMBOLS: before after around advised ; SYMBOLS: before after around advised ;
<PRIVATE
: advise ( quot name word loc -- ) : advise ( quot name word loc -- )
word-prop set-at ; word-prop set-at ;
PRIVATE>
: advise-before ( quot name word -- ) : advise-before ( quot name word -- )
before advise ; before advise ;
@ -15,7 +17,7 @@ SYMBOLS: before after around advised ;
after advise ; after advise ;
: advise-around ( quot name word -- ) : advise-around ( quot name word -- )
[ \ coterminate suffix cocreate ] 2dip [ \ coterminate suffix ] 2dip
around advise ; around advise ;
: get-advice ( word type -- seq ) : get-advice ( word type -- seq )
@ -28,7 +30,7 @@ SYMBOLS: before after around advised ;
after get-advice [ call ] each ; after get-advice [ call ] each ;
: call-around ( main word -- ) : call-around ( main word -- )
around get-advice tuck around get-advice [ cocreate ] map 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 -- )