steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.tree.propagation: fix broken corner cases in bitand and shift transforms, exposed by Hugh Aguilar's LC53 benchmark

db4
Slava Pestov 2009-10-24 01:09:32 -05:00
parent e46259bd33
commit 0c431f1222
3 changed files with 60 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
basis/compiler/tree/propagation/known-words/known-words.factor
View File

@ -140,8 +140,19 @@ IN: compiler.tree.propagation.known-words
'[ _ _ 2bi ] "outputs" set-word-prop
] each
\ shift [ [ interval-shift-safe ] [ may-overflow integer-valued ] binary-op ] each-derived-op
\ shift [ [ interval-shift-safe ] [ integer-valued ] binary-op ] each-fast-derived-op
: shift-op-class ( info1 info2 -- newclass )
[ class>> ] bi@
2dup [ null-class? ] either? [ 2drop null ] [ drop math-closure ] if ;
: shift-op ( word interval-quot post-proc-quot -- )
'[
[ shift-op-class ] [ _ binary-op-interval ] 2bi
@
<class/interval-info>
] "outputs" set-word-prop ;
\ shift [ [ interval-shift-safe ] [ may-overflow integer-valued ] shift-op ] each-derived-op
\ shift [ [ interval-shift-safe ] [ integer-valued ] shift-op ] each-fast-derived-op
\ bitand [ [ interval-bitand ] [ integer-valued ] binary-op ] each-derived-op
\ bitor [ [ interval-bitor ] [ integer-valued ] binary-op ] each-derived-op

19
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -407,10 +407,18 @@ IN: compiler.tree.propagation.tests
[ { fixnum fixnum } declare 7 bitand neg shift ] final-classes
] unit-test
[ V{ fixnum } ] [
[ { fixnum fixnum } declare 7 bitand neg >bignum shift ] final-classes
] unit-test
[ V{ fixnum } ] [
[ { fixnum } declare 1 swap 7 bitand shift ] final-classes
] unit-test
[ V{ fixnum } ] [
[ { fixnum } declare 1 swap 7 bitand >bignum shift ] final-classes
] unit-test
cell-bits 32 = [
[ V{ integer } ] [
[ { fixnum } declare 1 swap 31 bitand shift ]
@ -900,9 +908,20 @@ M: tuple-with-read-only-slot clone
[ t ] [ [ void* <c-direct-array> ] { <c-direct-array> } inlined? ] unit-test
[ V{ void*-array } ] [ [ void* <c-direct-array> ] final-classes ] unit-test
! bitand identities
[ t ] [ [ alien-unsigned-1 255 bitand ] { bitand fixnum-bitand } inlined? ] unit-test
[ t ] [ [ alien-unsigned-1 255 swap bitand ] { bitand fixnum-bitand } inlined? ] unit-test
[ t ] [ [ { fixnum } declare 256 rem -256 bitand ] { fixnum-bitand } inlined? ] unit-test
[ t ] [ [ { fixnum } declare 250 rem -256 bitand ] { fixnum-bitand } inlined? ] unit-test
[ f ] [ [ { fixnum } declare 257 rem -256 bitand ] { fixnum-bitand } inlined? ] unit-test
[ V{ fixnum } ] [ [ >bignum 10 mod 2^ ] final-classes ] unit-test
[ V{ bignum } ] [ [ >bignum 10 bitand ] final-classes ] unit-test
[ V{ bignum } ] [ [ >bignum 10 >bignum bitand ] final-classes ] unit-test
[ V{ bignum } ] [ [ >bignum 10 mod ] final-classes ] unit-test
[ V{ bignum } ] [ [ { fixnum } declare -1 >bignum bitand ] final-classes ] unit-test
[ V{ bignum } ] [ [ { fixnum } declare -1 >bignum swap bitand ] final-classes ] unit-test
! Could be bignum not integer but who cares
[ V{ integer } ] [ [ 10 >bignum bitand ] final-classes ] unit-test

53
basis/compiler/tree/propagation/transforms/transforms.factor
View File

@ -42,30 +42,27 @@ IN: compiler.tree.propagation.transforms
: positive-fixnum? ( obj -- ? )
{ [ fixnum? ] [ 0 >= ] } 1&& ;
: simplify-bitand? ( value -- ? )
value-info literal>> positive-fixnum? ;
: simplify-bitand? ( value1 value2 -- ? )
[ literal>> positive-fixnum? ]
[ class>> fixnum swap class<= ]
bi* and ;
: all-ones? ( int -- ? )
dup 1 + bitand zero? ; inline
: all-ones? ( n -- ? ) dup 1 + bitand zero? ; inline
: redundant-bitand? ( var 111... -- ? )
[ value-info ] bi@ [ interval>> ] [ literal>> ] bi* {
: redundant-bitand? ( value1 value2 -- ? )
[ interval>> ] [ literal>> ] bi* {
[ nip integer? ]
[ nip all-ones? ]
[ 0 swap [a,b] interval-subset? ]
} 2&& ;
: (zero-bitand?) ( value-info value-info' -- ? )
: zero-bitand? ( value1 value2 -- ? )
[ interval>> ] [ literal>> ] bi* {
[ nip integer? ]
[ nip bitnot all-ones? ]
[ 0 swap bitnot [a,b] interval-subset? ]
} 2&& ;
: zero-bitand? ( var1 var2 -- ? )
[ value-info ] bi@
{ [ (zero-bitand?) ] [ swap (zero-bitand?) ] } 2|| ;
{
bitand-integer-integer
bitand-integer-fixnum
@ -73,36 +70,42 @@ IN: compiler.tree.propagation.transforms
bitand
} [
[
{
in-d>> first2 [ value-info ] bi@ {
{
[ dup in-d>> first2 zero-bitand? ]
[ drop [ 2drop 0 ] ]
[ 2dup zero-bitand? ]
[ 2drop [ 2drop 0 ] ]
}
{
[ dup in-d>> first2 redundant-bitand? ]
[ drop [ drop ] ]
[ 2dup swap zero-bitand? ]
[ 2drop [ 2drop 0 ] ]
}
{
[ dup in-d>> first2 swap redundant-bitand? ]
[ drop [ nip ] ]
[ 2dup redundant-bitand? ]
[ 2drop [ drop ] ]
}
{
[ dup in-d>> first simplify-bitand? ]
[ drop [ >fixnum fixnum-bitand ] ]
[ 2dup swap redundant-bitand? ]
[ 2drop [ nip ] ]
}
{
[ dup in-d>> second simplify-bitand? ]
[ drop [ [ >fixnum ] dip fixnum-bitand ] ]
[ 2dup simplify-bitand? ]
[ 2drop [ >fixnum fixnum-bitand ] ]
}
[ drop f ]
{
[ 2dup swap simplify-bitand? ]
[ 2drop [ [ >fixnum ] dip fixnum-bitand ] ]
}
[ 2drop f ]
} cond
] "custom-inlining" set-word-prop
] each
! Speeds up 2^
: 2^? ( #call -- ? )
in-d>> first value-info
{ [ literal>> 1 = ] [ class>> fixnum class<= ] } 1&& ;
in-d>> first2 [ value-info ] bi@
[ { [ literal>> 1 = ] [ class>> fixnum class<= ] } 1&& ]
[ class>> fixnum class<= ]
bi* and ;
\ shift [
2^? [