tools.trace: we can surely hardcode the excluded vocab list

modern-harvey2
Björn Lindqvist 2017-06-24 00:14:52 +02:00
parent c53895e03d
commit 3f818637cd
2 changed files with 17 additions and 30 deletions

View File

@ -1,6 +1,6 @@
IN: tools.trace.tests IN: tools.trace.tests
USING: tools.trace tools.test tools.continuations kernel math combinators USING: combinators kernel math sequences tools.continuations
sequences ; tools.test tools.trace tools.trace.private ;
{ { 3 2 1 } } [ { 1 2 3 } [ reverse ] trace ] unit-test { { 3 2 1 } } [ { 1 2 3 } [ reverse ] trace ] unit-test
@ -22,9 +22,15 @@ M: method-breakpoint-tuple method-breakpoint-test break drop 1 2 + ;
{ 6 } [ [ case-breakpoint-test ] trace ] unit-test { 6 } [ [ case-breakpoint-test ] trace ] unit-test
: call(-breakpoint-test ( -- x ) : call-op-para-breakpoint-test ( -- x )
[ break 1 ] call( -- x ) 2 + ; [ break 1 ] call( -- x ) 2 + ;
\ call(-breakpoint-test don't-step-into \ call-op-para-breakpoint-test don't-step-into
{ 3 } [ [ call(-breakpoint-test ] trace ] unit-test { 3 } [ [ call-op-para-breakpoint-test ] trace ] unit-test
{ f t t } [
\ + into?
\ dip into?
\ sq into?
] unit-test

View File

@ -1,17 +1,11 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: concurrency.promises models tools.continuations kernel USING: accessors classes combinators.short-circuit effects
sequences concurrency.messaging locals continuations threads generic.math io io.styles kernel kernel.private make math.parser
namespaces namespaces.private make assocs accessors io strings namespaces prettyprint quotations sequences strings summary
prettyprint math math.parser words effects summary io.styles classes tools.continuations words ;
generic.math combinators.short-circuit kernel.private quotations ;
IN: tools.trace IN: tools.trace
SYMBOL: exclude-vocabs
SYMBOL: include-vocabs
exclude-vocabs { "math" "accessors" } swap set-global
<PRIVATE <PRIVATE
: callstack-depth ( callstack -- n ) : callstack-depth ( callstack -- n )
@ -19,27 +13,14 @@ exclude-vocabs { "math" "accessors" } swap set-global
SYMBOL: end SYMBOL: end
: include? ( vocab -- ? )
include-vocabs get [ member? ] [ drop t ] if* ;
: exclude? ( vocab -- ? )
exclude-vocabs get [ member? ] [ drop f ] if* ;
: into? ( obj -- ? ) : into? ( obj -- ? )
{ {
[ word? ] [ word? ]
[ predicate? not ] [ predicate? not ]
[ math-generic? not ] [ math-generic? not ]
[ [
{ [ inline? ]
[ inline? ] [ vocabulary>> { "math" "accessors" } member? not ] bi or
[
{
[ vocabulary>> include? ]
[ vocabulary>> exclude? not ]
} 1&&
]
} 1||
] ]
} 1&& ; } 1&& ;