Naive around-advice working
parent
d530ec6bd5
commit
894d9a67c9
extra/advice
|
@ -5,8 +5,10 @@ IN: advice
|
|||
|
||||
SYMBOLS: before after around advised ;
|
||||
|
||||
<PRIVATE
|
||||
: advise ( quot name word loc -- )
|
||||
word-prop set-at ;
|
||||
PRIVATE>
|
||||
|
||||
: advise-before ( quot name word -- )
|
||||
before advise ;
|
||||
|
@ -15,7 +17,7 @@ SYMBOLS: before after around advised ;
|
|||
after advise ;
|
||||
|
||||
: advise-around ( quot name word -- )
|
||||
[ \ coterminate suffix cocreate ] 2dip
|
||||
[ \ coterminate suffix ] 2dip
|
||||
around advise ;
|
||||
|
||||
: get-advice ( word type -- seq )
|
||||
|
@ -28,7 +30,7 @@ SYMBOLS: before after around advised ;
|
|||
after get-advice [ call ] each ;
|
||||
|
||||
: call-around ( main word -- )
|
||||
around get-advice tuck
|
||||
around get-advice [ cocreate ] map tuck
|
||||
[ [ coresume ] each ] [ call ] [ reverse [ coresume ] each ] tri* ;
|
||||
|
||||
: remove-advice ( name word loc -- )
|
||||
|
|
Loading…
Reference in New Issue