From f53efa88c61eff15ca65c29dd82641f1588bd858 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 3 Jul 2009 22:32:30 -0500
Subject: [PATCH] tools.annotations: redo 'watch' so that it doesn't call
 'datastack' anymore, instead use macros to capture stack values. This works
 better with compiler optimizations

---
 .../annotations/annotations-tests.factor      | 11 +++++++++
 basis/tools/annotations/annotations.factor    | 24 +++++++++++--------
 2 files changed, 25 insertions(+), 10 deletions(-)

diff --git a/basis/tools/annotations/annotations-tests.factor b/basis/tools/annotations/annotations-tests.factor
index c312b54edb..79aef90bea 100644
--- a/basis/tools/annotations/annotations-tests.factor
+++ b/basis/tools/annotations/annotations-tests.factor
@@ -49,3 +49,14 @@ M: string blah-generic ;
 [ ] [ M\ string blah-generic watch ] unit-test
 
 [ "hi" ] [ "hi" blah-generic ] unit-test
+
+! See how well watch interacts with optimizations.
+GENERIC: my-generic ( a -- b )
+M: object my-generic ;
+
+\ my-generic watch
+
+: some-code ( -- )
+    f my-generic drop ;
+
+[ ] [ some-code ] unit-test
\ No newline at end of file
diff --git a/basis/tools/annotations/annotations.factor b/basis/tools/annotations/annotations.factor
index 3aac371a6a..e7e5837ee8 100644
--- a/basis/tools/annotations/annotations.factor
+++ b/basis/tools/annotations/annotations.factor
@@ -3,7 +3,8 @@
 USING: accessors kernel math sorting words parser io summary
 quotations sequences prettyprint continuations effects
 definitions compiler.units namespaces assocs tools.walker
-tools.time generic inspector fry tools.continuations ;
+tools.time generic inspector fry tools.continuations
+locals generalizations macros ;
 IN: tools.annotations
 
 GENERIC: reset ( word -- )
@@ -46,17 +47,20 @@ M: word annotate
 
 <PRIVATE
 
-: stack-values ( names -- alist )
-    [ datastack ] dip [ nip ] [ length tail* ] 2bi zip ;
+:: trace-quot ( word effect quot str -- quot' )
+    effect quot call :> values
+    values length :> n
+    [
+        "--- " write str write bl word .
+        n ndup n narray values swap zip simple-table.
+        flush
+    ] ; inline
 
-: trace-message ( word quot str -- )
-    "--- " write write bl over .
-    [ stack-effect ] dip '[ @ stack-values ] [ f ] if*
-    [ simple-table. ] unless-empty flush ; inline
+MACRO: entering ( word -- quot )
+    dup stack-effect [ in>> ] "Entering" trace-quot ;
 
-: entering ( str -- ) [ in>> ] "Entering" trace-message ;
-
-: leaving ( str -- ) [ out>> ] "Leaving" trace-message ;
+MACRO: leaving ( word -- quot )
+    dup stack-effect [ out>> ] "Leaving" trace-quot ;
 
 : (watch) ( word def -- def )
     over '[ _ entering @ _ leaving ] ;