add union word

move prune

core/hashtables/hashtables-docs.factor

@@ -138,13 +138,6 @@ HELP: >hashtable
 { $values { "assoc" "an assoc" } { "hashtable" "a hashtable" } }
 { $description "Constructs a hashtable from any assoc." } ;
 
-HELP: prune
-{ $values { "seq" "a sequence" } { "newseq" "a sequence" } }
-{ $description "Outputs a new sequence with each distinct element of " { $snippet "seq" } " appearing only once. Elements are compared for equality using " { $link = } " and elements are ordered according to their position in " { $snippet "seq" } "." }
-{ $examples
-    { $example "USING: hashtables prettyprint ;" "{ 1 1 t 3 t } prune ." "V{ 1 t 3 }" }
-} ;
-
 HELP: all-unique?
 { $values { "seq" sequence } { "?" "a boolean" } }
 { $description "Tests whether a sequence contains any repeated elements." }

core/hashtables/hashtables.factor

@@ -178,7 +178,7 @@ M: hashtable assoc-like
     rot 2dup key?
     [ 3drop ] [ dupd dupd set-at swap push ] if ; inline
 
-: prune ( seq -- newseq )
+M: sequence prune ( seq -- newseq )
     [ length <hashtable> ]
     [ length <vector> ]
     [ ] tri

core/sequences/sequences-docs.factor

@@ -660,9 +660,33 @@ HELP: prefix
 { $example "USING: prettyprint sequences ;" "{ 1 2 3 } 0 prefix ." "{ 0 1 2 3 }" }
 } ;
 
+HELP: prune
+{ $values { "seq" "a sequence" } { "newseq" "a sequence" } }
+{ $description "Outputs a new sequence with each distinct element of " { $snippet "seq" } " appearing only once. Elements are compared for equality using " { $link = } " and elements are ordered according to their position in " { $snippet "seq" } "." }
+{ $examples
+    { $example "USING: sequences prettyprint ;" "{ 1 1 t 3 t } prune ." "V{ 1 t 3 }" }
+} ;
+
 HELP: diff
 { $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
-{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq2" } " but not " { $snippet "seq1" } ", comparing elements for equality." } ;
+{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq2" } " but not " { $snippet "seq1" } ", comparing elements for equality." }
+{ $examples
+    { $example "USING: sequences prettyprint ;" "{ 1 2 3 } { 2 3 4 } diff ." "{ 4 }" }
+} ;
+
+HELP: intersect
+{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
+{ $description "Outputs a sequence consisting of elements present in both " { $snippet "seq1" } " and " { $snippet "seq2" } "." }
+{ $examples
+    { $example "USING: sequences prettyprint ;" "{ 1 2 3 } { 2 3 4 } union ." "{ 1 2 3 4 }" }
+} ;
+
+HELP: union
+{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
+{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq1" } " and " { $snippet "seq2" } " which does not contain duplicate values." }
+{ $examples
+    { $example "USING: sequences prettyprint ;" "{ 1 2 3 } { 2 3 4 } union ." "{ 1 2 3 4 }" }
+} ;
 
 HELP: sum-lengths
 { $values { "seq" "a sequence of sequences" } { "n" integer } }

core/sequences/sequences-tests.factor

@@ -260,5 +260,9 @@ unit-test
 [ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test
 [ " asdf" ] [ " asdf " [ CHAR: \s = ] right-trim ] unit-test
 
+[ { 1 2 3 4 } ] [ { 1 2 3 } { 2 3 4 } union ] unit-test
+[ { 4 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test
+[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test
+
 ! Hardcore
 [ ] [ "sequences" reload ] unit-test

core/sequences/sequences.factor

@@ -444,9 +444,17 @@ PRIVATE>
 : memq? ( obj seq -- ? )
     [ eq? ] with contains? ;
 
-: intersect ( seq1 seq2 -- seq1/\seq2 )
+: diff ( seq1 seq2 -- newseq )
+    swap [ member? not ] curry subset ;
+
+: intersect ( seq1 seq2 -- newseq )
     swap [ member? ] curry subset ;
 
+GENERIC: prune ( obj -- obj' )
+
+: union ( seq1 seq2 -- newseq )
+    append prune ;
+
 : remove ( obj seq -- newseq )
     [ = not ] with subset ;
 
@@ -512,9 +520,6 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
         [ 0 swap copy ] keep
     ] new-like ;
 
-: diff ( seq1 seq2 -- newseq )
-    swap [ member? not ] curry subset ;
-
 : peek ( seq -- elt ) dup length 1- swap nth ;
 
 : pop* ( seq -- ) dup length 1- swap set-length ;