More debugging

db4
Slava Pestov 2008-07-30 17:36:24 -05:00
parent 65df4739ce
commit e61f2321d0
7 changed files with 54 additions and 15 deletions

View File

@ -195,17 +195,17 @@ GENERIC: annotate-entry-test-1 ( x -- )
M: fixnum annotate-entry-test-1 drop ;
: (annotate-entry-test-2) ( from to quot: ( -- ) -- )
2over >= [
3drop
: (annotate-entry-test-2) ( from to -- )
2dup >= [
2drop
] [
[ swap >r call dup annotate-entry-test-1 1+ r> ] keep (annotate-entry-test-2)
>r dup annotate-entry-test-1 1+ r> (annotate-entry-test-2)
] if ; inline recursive
: annotate-entry-test-2 0 -rot (annotate-entry-test-2) ; inline
[ f ] [
[ { bignum } declare [ ] annotate-entry-test-2 ]
[ { bignum } declare annotate-entry-test-2 ]
\ annotate-entry-test-1 inlined?
] unit-test
@ -375,7 +375,7 @@ cell-bits 32 = [
[ t ] [
[ { fixnum } declare 0 [ + ] reduce ]
{ < <-integer-fixnum } inlined?
{ < <-integer-fixnum nth-unsafe } inlined?
] unit-test
[ f ] [

View File

@ -22,7 +22,8 @@ GENERIC: cleanup* ( node -- node/nodes )
[ cleanup* ] map flatten ;
: cleanup-folding? ( #call -- ? )
node-output-infos [ literal?>> ] all? ;
node-output-infos dup empty?
[ drop f ] [ [ literal?>> ] all? ] if ;
: cleanup-folding ( #call -- nodes )
#! Replace a #call having a known result with a #drop of its

View File

@ -520,3 +520,11 @@ M: array iterate first t ;
[ V{ POSTPONE: f } ] [
[ 3 string? ] final-classes
] unit-test
[ V{ fixnum } ] [
[ { fixnum } declare [ ] curry obj>> ] final-classes
] unit-test
[ V{ fixnum } ] [
[ { fixnum fixnum } declare [ nth-unsafe ] curry call ] final-classes
] unit-test

View File

@ -0,0 +1,19 @@
IN: compiler.tree.propagation.recursive.tests
USING: tools.test compiler.tree.propagation.recursive
math.intervals kernel ;
[ T{ interval f { 0 t } { 1/0. t } } ] [
T{ interval f { 1 t } { 1 t } }
T{ interval f { 0 t } { 0 t } } generalize-counter-interval
] unit-test
[ T{ interval f { -1/0. t } { 10 t } } ] [
T{ interval f { -1 t } { -1 t } }
T{ interval f { 10 t } { 10 t } } generalize-counter-interval
] unit-test
[ t ] [
T{ interval f { 1 t } { 268435455 t } }
T{ interval f { -268435456 t } { 268435455 t } } tuck
generalize-counter-interval =
] unit-test

View File

@ -21,12 +21,12 @@ IN: compiler.tree.propagation.recursive
: generalize-counter-interval ( interval initial-interval -- interval' )
{
{ [ 2dup = ] [ empty-interval ] }
{ [ 2dup interval-subset? ] [ empty-interval ] }
{ [ over empty-interval eq? ] [ empty-interval ] }
{ [ 2dup interval>= t eq? ] [ 1./0. [a,a] ] }
{ [ 2dup interval<= t eq? ] [ -1./0. [a,a] ] }
[ [-inf,inf] ]
} cond nip interval-union ;
} cond interval-union nip ;
: generalize-counter ( info' initial -- info )
2dup [ class>> null-class? ] either? [ drop ] [

View File

@ -29,7 +29,7 @@ UNION: fixed-length-sequence array byte-array string ;
bi* value-info-intersect 1array ;
: tuple-constructor? ( word -- ? )
{ <tuple-boa> <complex> } memq? ;
{ <tuple-boa> curry compose <complex> } memq? ;
: read-only-slots ( values class -- slots )
#! Delegation.
@ -41,22 +41,33 @@ UNION: fixed-length-sequence array byte-array string ;
[ , f , [ literal>> ] map % ] { } make >tuple
<literal-info> ;
: propagate-<tuple-boa> ( #call -- info )
#! Delegation
in-d>> [ value-info ] map unclip-last
literal>> class>> [ read-only-slots ] keep
: (propagate-tuple-constructor) ( values class -- info )
[ [ value-info ] map ] dip [ read-only-slots ] keep
over 2 tail-slice [ dup [ literal?>> ] when ] all? [
[ 2 tail-slice ] dip fold-<tuple-boa>
] [
<tuple-info>
] if ;
: propagate-<tuple-boa> ( #call -- info )
#! Delegation
in-d>> unclip-last
value-info literal>> class>> (propagate-tuple-constructor) ;
: propagate-curry ( #call -- info )
in-d>> \ curry (propagate-tuple-constructor) ;
: propagate-compose ( #call -- info )
in-d>> \ compose (propagate-tuple-constructor) ;
: propagate-<complex> ( #call -- info )
in-d>> [ value-info ] map complex <tuple-info> ;
: propagate-tuple-constructor ( #call word -- infos )
{
{ \ <tuple-boa> [ propagate-<tuple-boa> ] }
{ \ curry [ propagate-curry ] }
{ \ compose [ propagate-compose ] }
{ \ <complex> [ propagate-<complex> ] }
} case 1array ;

View File

@ -6,7 +6,7 @@ quotations effects tools.test continuations generic.standard
sorting assocs definitions prettyprint io inspector
classes.tuple classes.union classes.predicate debugger
threads.private io.streams.string io.timeouts io.thread
sequences.private destructors combinators ;
sequences.private destructors combinators eval ;
IN: stack-checker.tests
: short-effect ( effect -- pair )