From 9a914d8ce502554f490037b2f1c8e293a46f563a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 6 May 2009 23:47:17 -0500
Subject: [PATCH] tools.trace: fix for call(

---
 basis/tools/trace/trace-tests.factor | 30 ++++++++++++++++++++++--
 basis/tools/trace/trace.factor       | 35 +++++++++++++++++-----------
 2 files changed, 49 insertions(+), 16 deletions(-)

diff --git a/basis/tools/trace/trace-tests.factor b/basis/tools/trace/trace-tests.factor
index 74f7c40943..06511c7ada 100644
--- a/basis/tools/trace/trace-tests.factor
+++ b/basis/tools/trace/trace-tests.factor
@@ -1,4 +1,30 @@
 IN: tools.trace.tests
-USING: tools.trace tools.test sequences ;
+USING: tools.trace tools.test tools.continuations kernel math combinators
+sequences ;
 
-[ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] trace ] unit-test
\ No newline at end of file
+[ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] trace ] unit-test
+
+GENERIC: method-breakpoint-test ( x -- y )
+
+TUPLE: method-breakpoint-tuple ;
+
+M: method-breakpoint-tuple method-breakpoint-test break drop 1 2 + ;
+
+\ method-breakpoint-test don't-step-into
+
+[ 3 ]
+[ [ T{ method-breakpoint-tuple } method-breakpoint-test ] trace ] unit-test
+
+: case-breakpoint-test ( -- x )
+    5 { [ break 1 + ] } case ;
+
+\ case-breakpoint-test don't-step-into
+
+[ 6 ] [ [ case-breakpoint-test ] trace ] unit-test
+
+: call(-breakpoint-test ( -- x )
+    [ break 1 ] call( -- x ) 2 + ;
+
+\ call(-breakpoint-test don't-step-into
+
+[ 3 ] [ [ call(-breakpoint-test ] trace ] unit-test
diff --git a/basis/tools/trace/trace.factor b/basis/tools/trace/trace.factor
index e2c6bf864b..f7f0ae4a69 100644
--- a/basis/tools/trace/trace.factor
+++ b/basis/tools/trace/trace.factor
@@ -4,19 +4,21 @@ USING: concurrency.promises models tools.continuations kernel
 sequences concurrency.messaging locals continuations threads
 namespaces namespaces.private make assocs accessors io strings
 prettyprint math math.parser words effects summary io.styles classes
-generic.math combinators.short-circuit ;
+generic.math combinators.short-circuit kernel.private quotations ;
 IN: tools.trace
 
-: callstack-depth ( callstack -- n )
-    callstack>array length 2/ ;
-
-SYMBOL: end
-
 SYMBOL: exclude-vocabs
 SYMBOL: include-vocabs
 
 exclude-vocabs { "math" "accessors" } swap set-global
 
+<PRIVATE
+
+: callstack-depth ( callstack -- n )
+    callstack>array length 2/ ;
+
+SYMBOL: end
+
 : include? ( vocab -- ? )
     include-vocabs get dup [ member? ] [ 2drop t ] if ;
 
@@ -65,15 +67,20 @@ M: trace-step summary
     [ CHAR: \s <string> write ]
     [ number>string write ": " write ] bi ;
 
+: trace-into? ( continuation -- ? )
+    continuation-current into? ;
+
 : trace-step ( continuation -- continuation' )
-    dup continuation-current end eq? [
-        [ print-depth ]
-        [ print-step ]
-        [
-            dup continuation-current into?
-            [ continuation-step-into ] [ continuation-step ] if
-        ] tri
-    ] unless ;
+    dup call>> innermost-frame-executing quotation? [
+        dup continuation-current end eq? [
+            [ print-depth ]
+            [ print-step ]
+            [ dup trace-into? [ continuation-step-into ] [ continuation-step ] if ]
+            tri
+        ] unless
+    ] when ;
+
+PRIVATE>
 
 : trace ( quot -- data )
     [ [ trace-step ] break-hook ] dip