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
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 ;
[ 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