assocs: adding zip-with.

diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor
index c25c0f81352a82612d3e8cb6b8476987275feef9..c77440096cd36d8abd20e50368d5213c9d3c05f5 100644 (file)
--- a/core/assocs/assocs-docs.factor
+++ b/core/assocs/assocs-docs.factor
@@ -129,6 +129,8 @@ ARTICLE: "assocs-conversions" "Associative mapping conversions"
 { $subsections zip zip-as }
 "Creating an assoc from key/value sequences and their indices:"
 { $subsections zip-index zip-index-as }
+"Creating an assoc from a sequence and a key quotation:"
+{ $subsections zip-with zip-with-as }
 "Creating key/value sequences from an assoc:"
 { $subsections unzip }
 ;
@@ -626,7 +628,33 @@ HELP: zip-index-as
 }
 { $description "Zip a sequence with its index and return an associative list of type " { $snippet "exemplar" } " where the input sequence is the keys and the indices are the values." } ;
 
-{ unzip zip zip-as zip-index zip-index-as } related-words
+HELP: zip-with
+{ $values
+    { "seq" sequence } { "quot" { $quotation ( ... key -- ... value ) } }
+    { "alist" assoc }
+}
+{ $examples
+    { $example "USING: assocs math prettyprint ;"
+        "{ 1 2 3 4 } [ sq ] zip-with ."
+        "{ { 1 1 } { 2 4 } { 3 9 } { 4 16 } }"
+    }
+}
+{ $description "Zip a sequence with values generated by applying " { $snippet "quot" } " to each element in the sequence." } ;
+
+HELP: zip-with-as
+{ $values
+    { "seq" sequence } { "quot" { $quotation ( ... key -- ... value ) } }
+    { "exemplar" assoc } { "assoc" assoc }
+}
+{ $examples
+    { $example "USING: assocs math prettyprint ;"
+        "{ 1 2 3 4 } [ sq ] H{ } zip-with-as ."
+        "H{ { 1 1 } { 2 4 } { 3 9 } { 4 16 } }"
+    }
+}
+{ $description "Zip a sequence with values generated by applying " { $snippet "quot" } " to each element in the sequence, outputting an " { $link assoc } " of type " { $snippet "exemplar" } "." } ;
+
+{ unzip zip zip-as zip-index zip-index-as zip-with zip-with-as } related-words
 
 HELP: collect-by
 { $values

diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor
index be72d223cb6036f91cb3592ca5eb6115edb7a04e..152ad82c84ef5ede9376f2bc7e2286a6e4ad1b74 100644 (file)
--- a/core/assocs/assocs-tests.factor
+++ b/core/assocs/assocs-tests.factor
@@ -308,6 +308,19 @@ unit-test
     V{ { 11 0 } { 22 1 } { 33 2 } }
 } [ { 11 22 33 } V{ } zip-index-as ] unit-test
 
+! zip-with, zip-with-as
+{
+    { { "cat" 3 } { "food" 4 } { "is" 2 } { "yummy" 5 } }
+} [
+    { "cat" "food" "is" "yummy" } [ length ] zip-with
+] unit-test
+
+{
+    H{ { "cat" 3 } { "food" 4 } { "is" 2 } { "yummy" 5 } }
+} [
+    { "cat" "food" "is" "yummy" } [ length ] H{ } zip-with-as
+] unit-test
+
 {
     H{
         { 0 V{ 0 3 6 9 } }

diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index 6955efbe9c0d6d418e3fb443777e49efd1d02387..e6e18db924c22bdc7eeaa2109e8fb1ae991d1a6d 100644 (file)
--- a/core/assocs/assocs.factor
+++ b/core/assocs/assocs.factor
@@ -245,6 +245,12 @@ M: assoc value-at* swap [ = nip ] curry assoc-find nip ;
 : unzip ( assoc -- keys values )
     dup assoc-empty? [ drop { } { } ] [ >alist flip first2 ] if ;
 
+: zip-with-as ( ... seq quot: ( ... key -- ... value ) exemplar -- ... assoc )
+    [ [ keep swap ] curry ] dip map>assoc ; inline
+
+: zip-with ( ... seq quot: ( ... key -- ... value ) -- ... alist )
+    { } zip-with-as ; inline
+
 : collect-by ( ... seq quot: ( ... obj -- ... key ) -- ... assoc )
     [ keep swap ] curry H{ } clone [
         [ push-at ] curry compose each