diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 3021bb6398..056dc54f3f 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -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 diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index 705156ff2c..f1cf936840 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -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 ? ;