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

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
 } ;
 

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

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 ;