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

compiler.tree.propagation.transforms: fix intersect and add intersects?.

db4
John Benediktsson 2013-03-26 19:04:50 -07:00
parent 3d9b1f4adb
commit c4d832ce4d
2 changed files with 10 additions and 2 deletions
basis/compiler/tree/propagation

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

@ -973,6 +973,9 @@ M: tuple-with-read-only-slot clone
[ t ] [ [ { 1 } intersect ] { intersect } inlined? ] unit-test
[ f ] [ [ { 1 } swap intersect ] { intersect } inlined? ] unit-test ! We could do this
[ t ] [ [ { 1 } intersects? ] { intersects? } inlined? ] unit-test
[ f ] [ [ { 1 } swap intersects? ] { intersects? } inlined? ] unit-test ! We could do this
[ t ] [ [ { 1 } diff ] { diff } inlined? ] unit-test
[ f ] [ [ { 1 } swap diff ] { diff } inlined? ] unit-test ! We could do this

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

@ -11,7 +11,7 @@ assocs sets combinators.short-circuit sequences.private locals
growable stack-checker namespaces compiler.tree.propagation.info
hash-sets ;
FROM: math => float ;
FROM: sets => set ;
FROM: sets => set members ;
IN: compiler.tree.propagation.transforms
\ equal? [
@ -307,10 +307,15 @@ CONSTANT: lookup-table-at-max 256
M\ set diff [ diff-quot ] 1 define-partial-eval
: intersect-quot ( seq -- quot: ( seq' -- seq'' ) )
tester '[ [ _ filter ] keep set-like ] ;
tester '[ [ members _ filter ] keep set-like ] ;
M\ set intersect [ intersect-quot ] 1 define-partial-eval
: intersects?-quot ( seq -- quot: ( seq' -- seq'' ) )
tester '[ members _ any? ] ;
M\ set intersects? [ intersects?-quot ] 1 define-partial-eval
: bit-quot ( #call -- quot/f )
in-d>> second value-info interval>> 0 fixnum-bits [a,b] interval-subset?
[ [ >fixnum ] dip fixnum-bit? ] f ? ;