Add new intersects? word and use it in a few places instead of intersect empty?

diff --git a/basis/http/http.factor b/basis/http/http.factor
index 0aeb771c11ad2bbb1c8740054ea3ce2c5989920c..4702f88830639abc98f066f31ae7c020d860508c 100644 (file)
--- a/basis/http/http.factor
+++ b/basis/http/http.factor
@@ -45,8 +45,8 @@ IN: http
 
 : check-header-string ( str -- str )
     #! http://en.wikipedia.org/wiki/HTTP_Header_Injection
-    dup "\r\n\"" intersect empty?
-    [ "Header injection attack" throw ] unless ;
+    dup "\r\n\"" intersects?
+    [ "Header injection attack" throw ] when ;
 
 : write-header ( assoc -- )
     >alist sort-keys [
@@ -97,8 +97,8 @@ TUPLE: cookie name value version comment path domain expires max-age http-only s
     ] { } make ;
 
 : check-cookie-string ( string -- string' )
-    dup "=;'\"\r\n" intersect empty?
-    [ "Bad cookie name or value" throw ] unless ;
+    dup "=;'\"\r\n" intersects?
+    [ "Bad cookie name or value" throw ] when ;
 
 : unparse-cookie-value ( key value -- )
     {

diff --git a/basis/regexp/dfa/dfa.factor b/basis/regexp/dfa/dfa.factor
index 0abd1c2edc5dc243c27c6634c686df9518495e7e..c3e98ae1ec2f66a4ae6424ef39d1747f1531b092 100644 (file)
--- a/basis/regexp/dfa/dfa.factor
+++ b/basis/regexp/dfa/dfa.factor
@@ -57,7 +57,7 @@ IN: regexp.dfa
     dup
     [ nfa-table>> final-states>> keys ]
     [ dfa-table>> transitions>> states ] bi
-    [ intersect empty? not ] with filter
+    [ intersects? ] with filter
 
     swap dfa-table>> final-states>>
     [ conjoin ] curry each ;

diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor
index 0f16863a79fec3944961a027d635ccf05c55bd7d..c17db13b014ea3573ecffdfc6d61a4fa0f6f61be 100644 (file)
--- a/basis/smtp/smtp.factor
+++ b/basis/smtp/smtp.factor
@@ -68,8 +68,8 @@ ERROR: bad-email-address email ;
 
 : validate-address ( string -- string' )
     #! Make sure we send funky stuff to the server by accident.
-    dup "\r\n>" intersect empty?
-    [ bad-email-address ] unless ;
+    dup "\r\n>" intersects?
+    [ bad-email-address ] when ;
 
 : mail-from ( fromaddr -- )
     validate-address
@@ -170,8 +170,8 @@ M: plain-auth send-auth
 ERROR: invalid-header-string string ;
 
 : validate-header ( string -- string' )
-    dup "\r\n" intersect empty?
-    [ invalid-header-string ] unless ;
+    dup "\r\n" intersects?
+    [ invalid-header-string ] when ;
 
 : write-header ( key value -- )
     [ validate-header write ]

diff --git a/basis/validators/validators.factor b/basis/validators/validators.factor
index 78e01fdaf7854a89cb608239068ffa115c693828..a70e20d7b6c7b28d112dcd4972986d3493705fde 100644 (file)
--- a/basis/validators/validators.factor
+++ b/basis/validators/validators.factor
@@ -69,8 +69,8 @@ IN: validators
 
 : v-one-line ( str -- str )
     v-required
-    dup "\r\n" intersect empty?
-    [ "must be a single line" throw ] unless ;
+    dup "\r\n" intersects?
+    [ "must be a single line" throw ] when ;
 
 : v-one-word ( str -- str )
     v-required

diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor
index 5f7f4acf7accf00cfdae4ab1bfe5869b6fb6119c..428bf104012c8bf820b6e92412c3d452e4bc3d40 100644 (file)
--- a/core/sets/sets-docs.factor
+++ b/core/sets/sets-docs.factor
@@ -13,6 +13,8 @@ $nl
 { $subsection diff }
 { $subsection intersect }
 { $subsection union }
+"Set-theoretic predicates:"
+{ $subsection intersects? }
 { $subsection subset? }
 { $subsection set= }
 "A word used to implement the above:"
@@ -104,9 +106,15 @@ HELP: union
 
 { diff intersect union } related-words
 
+HELP: intersects?
+{ $values { "seq1" sequence } { "seq2" sequence } { "?" "a boolean" } }
+{ $description "Tests if " { $snippet "seq1" } " and " { $snippet "seq2" } " have any elements in common." }
+{ $notes "If one of the sequences is empty, the result is always " { $link f } "." } ;
+
 HELP: subset?
 { $values { "seq1" sequence } { "seq2" sequence } { "?" "a boolean" } }
-{ $description "Tests if every element of " { $snippet "seq1" } " is contained in " { $snippet "seq2" } "." } ;
+{ $description "Tests if every element of " { $snippet "seq1" } " is contained in " { $snippet "seq2" } "." }
+{ $notes "If " { $snippet "seq1" } " is empty, the result is always " { $link t } "." } ;
 
 HELP: set=
 { $values { "seq1" sequence } { "seq2" sequence } { "?" "a boolean" } }

diff --git a/core/sets/sets-tests.factor b/core/sets/sets-tests.factor
index b6e6443afadae10dac08777f5f1263af2df9c82f..838a0a82b8ae44dbf74b7bd8aba1a76a8ee9ba95 100644 (file)
--- a/core/sets/sets-tests.factor
+++ b/core/sets/sets-tests.factor
@@ -21,3 +21,11 @@ IN: sets.tests
 
 [ V{ 1 2 3 } ]
 [ 3 V{ 1 3 2 } clone [ adjoin ] keep ] unit-test
+
+[ t ] [ { 1 2 } { 1 3 } intersects? ] unit-test
+
+[ f ] [ { 4 2 } { 1 3 } intersects? ] unit-test
+
+[ f ] [ { } { 1 } intersects? ] unit-test
+
+[ f ] [ { 1 } { } intersects? ] unit-test

diff --git a/core/sets/sets.factor b/core/sets/sets.factor
index c411bfcdcdcc4dda1d565f1d9e923cefb5f749dc..88dffa6777c4aa8d9303cadce1ad0c361eb31e65 100644 (file)
--- a/core/sets/sets.factor
+++ b/core/sets/sets.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov, Doug Coleman.
+! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs hashtables kernel sequences vectors ;
 IN: sets
@@ -31,17 +31,26 @@ IN: sets
 : all-unique? ( seq -- ? )
     dup length <hashtable> [ (all-unique?) ] curry all? ;
 
+<PRIVATE
+
+: tester ( seq -- quot ) unique [ key? ] curry ; inline
+
+PRIVATE>
+
 : intersect ( seq1 seq2 -- newseq )
-    unique [ key? ] curry filter ;
+    tester filter ;
+
+: intersects? ( seq1 seq2 -- newseq )
+    tester contains? ;
 
 : diff ( seq1 seq2 -- newseq )
-    unique [ key? not ] curry filter ;
+    tester [ not ] compose filter ;
 
 : union ( seq1 seq2 -- newseq )
     append prune ;
 
 : subset? ( seq1 seq2 -- ? )
-    unique [ key? ] curry all? ;
+    tester all? ;
 
 : set= ( seq1 seq2 -- ? )
     [ unique ] bi@ = ;

diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor
index 29fee2e5c3c063d0b3cb2d65ae9760fabd2244ef..a2a302d995fad1b6f47b16b55584713afef4b60e 100644 (file)
--- a/core/splitting/splitting.factor
+++ b/core/splitting/splitting.factor
@@ -48,12 +48,12 @@ IN: splitting
 : split ( seq separators -- pieces ) [ split, ] { } make ;
 
 : string-lines ( str -- seq )
-    dup "\r\n" intersect empty? [
-        1array
-    ] [
+    dup "\r\n" intersects? [
         "\n" split [
             but-last-slice [
                 "\r" ?tail drop "\r" split
             ] map
         ] keep peek "\r" split suffix concat
+    ] [
+        1array
     ] if ;