diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 58a2a29eb1..0508d2e569 100644 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -117,7 +117,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) [ at* [ = ] [ 2drop f ] if ] with-assoc assoc-all? ; : assoc= ( assoc1 assoc2 -- ? ) - [ assoc-subset? ] [ swap assoc-subset? ] 2bi and ; + 2dup [ assoc-size ] bi@ eq? [ assoc-subset? ] [ 2drop f ] if ; : assoc-hashcode ( n assoc -- code ) >alist hashcode* ; diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor index be5aa97634..e7acf12454 100644 --- a/core/hashtables/hashtables.factor +++ b/core/hashtables/hashtables.factor @@ -151,10 +151,7 @@ M: hashtable clone (clone) [ clone ] change-array ; inline M: hashtable equal? - over hashtable? [ - 2dup [ assoc-size ] bi@ eq? - [ assoc= ] [ 2drop f ] if - ] [ 2drop f ] if ; + over hashtable? [ assoc= ] [ 2drop f ] if ; ! Default method M: assoc new-assoc drop ; inline diff --git a/core/sets/sets-tests.factor b/core/sets/sets-tests.factor index 899a43af4f..df6185671c 100644 --- a/core/sets/sets-tests.factor +++ b/core/sets/sets-tests.factor @@ -5,10 +5,14 @@ IN: sets.tests [ { } ] [ { } { } intersect ] unit-test [ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test +[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 5 } intersect ] unit-test +[ { 2 3 4 } ] [ { 1 2 3 4 } { 2 3 4 } intersect ] unit-test [ { 2 3 } ] [ { 1 2 2 3 } { 2 3 3 4 } intersect ] unit-test [ { } ] [ { } { } diff ] unit-test [ { 1 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test +[ { 1 } ] [ { 1 2 3 } { 2 3 4 5 } diff ] unit-test +[ { 1 } ] [ { 1 2 3 4 } { 2 3 4 } diff ] unit-test [ { 1 } ] [ { 1 1 2 3 } { 2 3 4 4 } diff ] unit-test [ { } ] [ { } { } within ] unit-test diff --git a/core/sets/sets.factor b/core/sets/sets.factor index ae15908e4c..06f6e04655 100644 --- a/core/sets/sets.factor +++ b/core/sets/sets.factor @@ -46,22 +46,25 @@ M: set union : sequence/tester ( set1 set2 -- set1' quot ) [ members ] [ tester ] bi* ; inline +: small/large ( set1 set2 -- set1' set2' ) + 2dup [ cardinality ] bi@ > [ swap ] when ; + PRIVATE> M: set intersect - [ sequence/tester filter ] keep set-like ; + [ small/large sequence/tester filter ] keep set-like ; M: set diff [ sequence/tester [ not ] compose filter ] keep set-like ; M: set intersects? - sequence/tester any? ; + small/large sequence/tester any? ; M: set subset? - sequence/tester all? ; + small/large sequence/tester all? ; M: set set= - 2dup subset? [ swap subset? ] [ 2drop f ] if ; + 2dup [ cardinality ] bi@ eq? [ subset? ] [ 2drop f ] if ; M: set fast-set ;