tools.trace: fix for call(
parent
4950ca76c2
commit
9a914d8ce5
|
@ -1,4 +1,30 @@
|
||||||
IN: tools.trace.tests
|
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
|
[ { 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
|
||||||
|
|
|
@ -4,19 +4,21 @@ USING: concurrency.promises models tools.continuations kernel
|
||||||
sequences concurrency.messaging locals continuations threads
|
sequences concurrency.messaging locals continuations threads
|
||||||
namespaces namespaces.private make assocs accessors io strings
|
namespaces namespaces.private make assocs accessors io strings
|
||||||
prettyprint math math.parser words effects summary io.styles classes
|
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
|
IN: tools.trace
|
||||||
|
|
||||||
: callstack-depth ( callstack -- n )
|
|
||||||
callstack>array length 2/ ;
|
|
||||||
|
|
||||||
SYMBOL: end
|
|
||||||
|
|
||||||
SYMBOL: exclude-vocabs
|
SYMBOL: exclude-vocabs
|
||||||
SYMBOL: include-vocabs
|
SYMBOL: include-vocabs
|
||||||
|
|
||||||
exclude-vocabs { "math" "accessors" } swap set-global
|
exclude-vocabs { "math" "accessors" } swap set-global
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: callstack-depth ( callstack -- n )
|
||||||
|
callstack>array length 2/ ;
|
||||||
|
|
||||||
|
SYMBOL: end
|
||||||
|
|
||||||
: include? ( vocab -- ? )
|
: include? ( vocab -- ? )
|
||||||
include-vocabs get dup [ member? ] [ 2drop t ] if ;
|
include-vocabs get dup [ member? ] [ 2drop t ] if ;
|
||||||
|
|
||||||
|
@ -65,15 +67,20 @@ M: trace-step summary
|
||||||
[ CHAR: \s <string> write ]
|
[ CHAR: \s <string> write ]
|
||||||
[ number>string write ": " write ] bi ;
|
[ number>string write ": " write ] bi ;
|
||||||
|
|
||||||
|
: trace-into? ( continuation -- ? )
|
||||||
|
continuation-current into? ;
|
||||||
|
|
||||||
: trace-step ( continuation -- continuation' )
|
: trace-step ( continuation -- continuation' )
|
||||||
|
dup call>> innermost-frame-executing quotation? [
|
||||||
dup continuation-current end eq? [
|
dup continuation-current end eq? [
|
||||||
[ print-depth ]
|
[ print-depth ]
|
||||||
[ print-step ]
|
[ print-step ]
|
||||||
[
|
[ dup trace-into? [ continuation-step-into ] [ continuation-step ] if ]
|
||||||
dup continuation-current into?
|
tri
|
||||||
[ continuation-step-into ] [ continuation-step ] if
|
] unless
|
||||||
] tri
|
] when ;
|
||||||
] unless ;
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
: trace ( quot -- data )
|
: trace ( quot -- data )
|
||||||
[ [ trace-step ] break-hook ] dip
|
[ [ trace-step ] break-hook ] dip
|
||||||
|
|
Loading…
Reference in New Issue