Improve branch folding
parent
f53baa2529
commit
8e847749ce
unfinished/compiler/tree/propagation
|
@ -16,7 +16,8 @@ GENERIC: child-constraints ( node -- seq )
|
|||
M: #if child-constraints
|
||||
in-d>> first [ =t ] [ =f ] bi 2array ;
|
||||
|
||||
M: #dispatch child-constraints drop f ;
|
||||
M: #dispatch child-constraints
|
||||
children>> length f <repetition> ;
|
||||
|
||||
GENERIC: live-children ( #branch -- children )
|
||||
|
||||
|
@ -27,15 +28,22 @@ M: #if live-children
|
|||
2bi 2array ;
|
||||
|
||||
M: #dispatch live-children
|
||||
children>> ;
|
||||
[ children>> ] [ in-d>> first value-info interval>> ] bi
|
||||
'[ , interval-contains? [ drop f ] unless ] map-index ;
|
||||
|
||||
: infer-children ( node -- assocs )
|
||||
[ live-children ] [ child-constraints ] bi [
|
||||
[
|
||||
value-infos [ clone ] change
|
||||
constraints [ clone ] change
|
||||
assume
|
||||
[ first>> (propagate) ] when*
|
||||
over [
|
||||
value-infos [ clone ] change
|
||||
constraints [ clone ] change
|
||||
assume
|
||||
first>> (propagate)
|
||||
] [
|
||||
2drop
|
||||
value-infos off
|
||||
constraints off
|
||||
] if
|
||||
] H{ } make-assoc
|
||||
] 2map ;
|
||||
|
||||
|
|
|
@ -56,3 +56,8 @@ IN: compiler.tree.propagation.info.tests
|
|||
fixnum 19 29 [a,b] <class/interval-info>
|
||||
value-info-intersect
|
||||
] unit-test
|
||||
|
||||
[ 3 t ] [
|
||||
3 <literal-info>
|
||||
null <class-info> value-info-union >literal<
|
||||
] unit-test
|
||||
|
|
|
@ -84,23 +84,37 @@ literal? ;
|
|||
[ drop >literal< ]
|
||||
} cond ;
|
||||
|
||||
: value-info-intersect ( info1 info2 -- info )
|
||||
: (value-info-intersect) ( info1 info2 -- info )
|
||||
[ [ class>> ] bi@ class-and ]
|
||||
[ [ interval>> ] bi@ interval-intersect ]
|
||||
[ intersect-literals ]
|
||||
2tri <value-info> ;
|
||||
|
||||
: value-info-intersect ( info1 info2 -- info )
|
||||
{
|
||||
{ [ dup class>> null class<= ] [ nip ] }
|
||||
{ [ over class>> null class<= ] [ drop ] }
|
||||
[ (value-info-intersect) ]
|
||||
} cond ;
|
||||
|
||||
: union-literals ( info1 info2 -- literal literal? )
|
||||
2dup [ literal?>> ] both? [
|
||||
[ literal>> ] bi@ 2dup eql? [ drop t ] [ 2drop f f ] if
|
||||
] [ 2drop f f ] if ;
|
||||
|
||||
: value-info-union ( info1 info2 -- info )
|
||||
: (value-info-union) ( info1 info2 -- info )
|
||||
[ [ class>> ] bi@ class-or ]
|
||||
[ [ interval>> ] bi@ interval-union ]
|
||||
[ union-literals ]
|
||||
2tri <value-info> ;
|
||||
|
||||
: value-info-union ( info1 info2 -- info )
|
||||
{
|
||||
{ [ dup class>> null class<= ] [ drop ] }
|
||||
{ [ over class>> null class<= ] [ nip ] }
|
||||
[ (value-info-union) ]
|
||||
} cond ;
|
||||
|
||||
: value-infos-union ( infos -- info )
|
||||
dup first [ value-info-union ] reduce ;
|
||||
|
||||
|
|
|
@ -2,7 +2,7 @@ USING: kernel compiler.tree.builder compiler.tree
|
|||
compiler.tree.propagation compiler.tree.copy-equiv
|
||||
compiler.tree.def-use tools.test math math.order
|
||||
accessors sequences arrays kernel.private vectors
|
||||
alien.accessors alien.c-types ;
|
||||
alien.accessors alien.c-types sequences.private ;
|
||||
IN: compiler.tree.propagation.tests
|
||||
|
||||
\ propagate must-infer
|
||||
|
@ -178,7 +178,7 @@ IN: compiler.tree.propagation.tests
|
|||
[ V{ f } ] [
|
||||
[
|
||||
/f
|
||||
dup 0.0 < [ dup 0.0 > [ drop 0.0 ] unless ] [ drop 0.0 ] if
|
||||
dup 0.0 <= [ dup 0.0 >= [ drop 0.0 ] unless ] [ drop 0.0 ] if
|
||||
] final-literals
|
||||
] unit-test
|
||||
|
||||
|
@ -197,3 +197,26 @@ IN: compiler.tree.propagation.tests
|
|||
[ V{ t } ] [
|
||||
[ dup 10 < [ 3 * 30 < ] [ drop t ] if ] final-literals
|
||||
] unit-test
|
||||
|
||||
[ V{ "d" } ] [
|
||||
[
|
||||
3 {
|
||||
[ "a" ]
|
||||
[ "b" ]
|
||||
[ "c" ]
|
||||
[ "d" ]
|
||||
[ "e" ]
|
||||
[ "f" ]
|
||||
[ "g" ]
|
||||
[ "h" ]
|
||||
} dispatch
|
||||
] final-literals
|
||||
] unit-test
|
||||
|
||||
[ V{ "hi" } ] [
|
||||
[ [ "hi" ] [ 123 3 throw ] if ] final-literals
|
||||
] unit-test
|
||||
|
||||
[ V{ fixnum } ] [
|
||||
[ >fixnum dup 100 < [ 1+ ] [ "Oops" throw ] if ] final-classes
|
||||
] unit-test
|
||||
|
|
Loading…
Reference in New Issue