From 894d9a67c9696ef3fd045de1340e14f02b481538 Mon Sep 17 00:00:00 2001
From: James Cash <james.nvc@gmail.com>
Date: Thu, 6 Nov 2008 00:44:11 -0500
Subject: [PATCH] Naive around-advice working
---
extra/advice/advice.factor | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/extra/advice/advice.factor b/extra/advice/advice.factor
index a71b9590f1..6a7d46f935 100644
--- a/extra/advice/advice.factor
+++ b/extra/advice/advice.factor
@@ -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 -- )