add product-map-as and use it in poker vocab

diff --git a/basis/sequences/product/product-docs.factor b/basis/sequences/product/product-docs.factor
index 0b6805eb71526f9a3d17049c44def9acfc63502d..117d77d38e2280767ac787c502fda0a56d63fdde 100644 (file)
--- a/basis/sequences/product/product-docs.factor
+++ b/basis/sequences/product/product-docs.factor
@@ -44,6 +44,10 @@ HELP: product-map
 { $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } " and collects the results from " { $snippet "quot" } " into an output sequence." }
 { $notes { $snippet "[ ... ] product-map" } " is equivalent to, but more efficient than, " { $snippet "<product-sequence> [ ... ] map" } "." } ;
 
+HELP: product-map-as
+{ $values { "sequences" sequence } { "quot" { $quotation "( sequence -- value )" } } { "exemplar" sequence } { "sequence" sequence } }
+{ $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } " and collects the results from " { $snippet "quot" } " into an output sequence the same type as the " { $snippet "exemplar" } " sequence." } ;
+
 HELP: product-each
 { $values { "sequences" sequence } { "quot" { $quotation "( sequence -- )" } } }
 { $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } "." }
@@ -57,6 +61,7 @@ ARTICLE: "sequences.product" "Product sequences"
     product-sequence
     <product-sequence>
     product-map
+    product-map-as
     product-each
 } ;
 

diff --git a/basis/sequences/product/product.factor b/basis/sequences/product/product.factor
index f783fad31204a3744ff21b8499aee057f787b5fc..52d4a2d93777463dfcdc6fd9991880463d5bfa97 100644 (file)
--- a/basis/sequences/product/product.factor
+++ b/basis/sequences/product/product.factor
@@ -55,11 +55,13 @@ M: product-sequence nth
         [ ns sequences nths quot call ns lengths product-iter ] until
     ] unless ; inline
 
-:: product-map ( sequences quot -- sequence )
+:: product-map-as ( sequences quot exemplar -- sequence )
     0 :> i!
-    sequences [ length ] [ * ] map-reduce sequences
+    sequences [ length ] [ * ] map-reduce exemplar
     [| result |
         sequences [ quot call i result set-nth i 1 + i! ] product-each
         result
     ] new-like ; inline
 
+: product-map ( sequences quot -- sequence )
+    over product-map-as ; inline

diff --git a/extra/poker/poker.factor b/extra/poker/poker.factor
index a5a5a936284f4cfa2d6d31e0e4e6c38d76a4a4aa..9c320a9510188991df3055b742433771afa7796d 100644 (file)
--- a/extra/poker/poker.factor
+++ b/extra/poker/poker.factor
@@ -202,8 +202,9 @@ TUPLE: deck
     { cards sequence } ;
 
 : <deck> ( -- deck )
-    RANK_STR SUIT_STR 2array [ concat >ckf ] product-map deck boa ;
+    RANK_STR SUIT_STR 2array [ concat >ckf ] V{ } product-map-as deck boa ;
 
 : shuffle ( deck -- deck )
     [ randomize ] change-cards ;
 
+: draw-card ( deck -- card ) cards>> pop ;