From 37dddb190f5228f678926fffa5474d7599a567c4 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Sun, 6 Mar 2022 21:45:21 +0100
Subject: [PATCH] Add make-tabulate* to factor out the common parts.

---
 functions.rkt | 21 ++++++++++++---------
 1 file changed, 12 insertions(+), 9 deletions(-)

diff --git a/functions.rkt b/functions.rkt
index 8760f43..23fc56e 100644
--- a/functions.rkt
+++ b/functions.rkt
@@ -10,7 +10,8 @@
 (require "utils.rkt")
 
 (module typed typed/racket
-  (require "utils.rkt")
+  (require "utils.rkt"
+           (for-syntax syntax/parse))
 
   (provide
    tabulate* tabulate*/strict)
@@ -18,12 +19,17 @@
   (module+ test
     (require typed/rackunit))
 
+  (define-syntax (make-tabulate* stx)
+    (syntax-parse stx
+      [(_ name:id row-op)
+       #'(define (name funcs doms)
+           (for/list ([xs (in-list (apply cartesian-product doms))])
+             (row-op xs (for/list ([f funcs]) : (Listof b)
+                                  (apply f xs)))))]))
+
   (: tabulate* (All (b a ... ) (-> (Listof (-> a ... b)) (List (Listof a) ... a)
                                    (Listof (Listof (U Any b))))))
-  (define (tabulate* funcs doms)
-    (for/list ([xs (in-list (apply cartesian-product doms))])
-      (append xs (for/list ([f funcs]) : (Listof b)
-                           (apply f xs)))))
+  (make-tabulate* tabulate* append)
 
   (module+ test
     (test-case "tabulate*"
@@ -37,10 +43,7 @@
 
   (: tabulate*/strict (All (b a ...) (-> (Listof (-> a ... b)) (List (Listof a) ... a)
                                          (Listof (List (List a ...) (Listof b))))))
-  (define (tabulate*/strict funcs doms)
-    (for/list ([xs (in-list (apply cartesian-product doms))])
-      (list xs (for/list ([f funcs]) : (Listof b)
-                         (apply f xs)))))
+  (make-tabulate* tabulate*/strict list)
 
   (module+ test
     (test-case "tabulate*/strict"