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

Working on implementation of 'around' advice

db4
James Cash 2008-11-05 23:50:33 -05:00
parent 585afbf24e
commit 0f9ccaa352
1 changed files with 23 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
extra/advice/advice.factor
View File

@ -1,10 +1,23 @@
! Copyright (C) 2008 James Cash ! Copyright (C) 2008 James Cash
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: advice
SYMBOLS: before after around ; 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 ) : get-advice ( word type -- seq )
word-prop values ; word-prop values ;
@ -14,16 +27,18 @@ SYMBOLS: before after around ;
: call-after ( word -- ) : call-after ( word -- )
after get-advice [ call ] each ; after get-advice [ call ] each ;
: advise-before ( quot name word -- ) : call-around ( main word -- )
before word-prop set-at ; around get-advice [ [ coresume ] each ] dip call
around get-advice reverse [ coresume ] each ;
: advise-after ( quot name word -- )
after word-prop set-at ;
: remove-advice ( name word loc -- ) : remove-advice ( name word loc -- )
word-prop delete-at ; word-prop delete-at ;
: ad-do-it ( input -- result )
coyield ;
: make-advised ( word -- ) : 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 ; [ { before after around } [ H{ } clone swap set-word-prop ] with each ] bi ;