diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor index 2ebf4d0300..43d1933d26 100644 --- a/core/sets/sets-docs.factor +++ b/core/sets/sets-docs.factor @@ -27,6 +27,7 @@ ARTICLE: "set-operations" "Operations on sets" clear-set union! diff! + intersect! } "To test if a set is the empty set:" { $subsections null? } @@ -172,6 +173,11 @@ HELP: diff! { $description "Removes all members from " { $snippet "set1" } " contained in " { $snippet "set2" } "." } { $side-effects "set1" } ; +HELP: intersect! +{ $values { "set1" set } { "set2" set } } +{ $description "Removes all members from " { $snippet "set1" } " not contained in " { $snippet "set2" } "." } +{ $side-effects "set1" } ; + HELP: intersects? { $values { "set1" set } { "set2" set } { "?" "a boolean" } } { $description "Tests if " { $snippet "set1" } " and " { $snippet "set2" } " have any elements in common." } diff --git a/core/sets/sets-tests.factor b/core/sets/sets-tests.factor index 3874402f6a..33cc173cb2 100644 --- a/core/sets/sets-tests.factor +++ b/core/sets/sets-tests.factor @@ -140,3 +140,8 @@ M: null-set members drop f ; [ HS{ 1 } ] [ HS{ 1 2 3 } HS{ 2 3 } diff! ] unit-test [ HS{ 1 } ] [ HS{ 1 } HS{ 2 3 4 } diff! ] unit-test [ HS{ 1 2 3 } ] [ HS{ 1 2 3 } HS{ 4 } diff! ] unit-test + +[ HS{ } ] [ HS{ } HS{ } intersect! ] unit-test +[ HS{ 2 3 } ] [ HS{ 1 2 3 } HS{ 2 3 } intersect! ] unit-test +[ HS{ } ] [ HS{ 1 } HS{ 2 3 4 } intersect! ] unit-test +[ HS{ } ] [ HS{ 1 2 3 } HS{ 4 } intersect! ] unit-test diff --git a/core/sets/sets.factor b/core/sets/sets.factor index cca6239955..fe3282ec18 100644 --- a/core/sets/sets.factor +++ b/core/sets/sets.factor @@ -168,6 +168,10 @@ M: sequence clear-set dupd sequence/tester [ dup ] prepose pick [ delete ] curry [ [ drop ] if ] curry compose each ; +: intersect! ( set1 set2 -- set1 ) + dupd sequence/tester [ dup ] prepose [ not ] compose pick + [ delete ] curry [ [ drop ] if ] curry compose each ; + ! Temporarily for compatibility : unique ( seq -- assoc )