From 66f11572001b8df1946ec0a0a25923342eebce63 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Sun, 6 Mar 2022 19:54:05 +0100
Subject: [PATCH] Add typed versions of tabulate* and tabulate*/strict.

---
 functions.rkt               | 62 +++++++++++++++++++++++++++++--------
 scribblings/functions.scrbl | 43 ++++++++++++++++++++++++-
 2 files changed, 91 insertions(+), 14 deletions(-)

diff --git a/functions.rkt b/functions.rkt
index 41a4e7c..8760f43 100644
--- a/functions.rkt
+++ b/functions.rkt
@@ -12,12 +12,48 @@
 (module typed typed/racket
   (require "utils.rkt")
 
+  (provide
+   tabulate* tabulate*/strict)
+
   (module+ test
     (require typed/rackunit))
+
+  (: 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)))))
+
+  (module+ test
+    (test-case "tabulate*"
+      (check-equal? (tabulate*
+                     (list (λ (x y) (and x y))
+                           (λ (x y) (or x y)))
+                     '((#f #t) (#f #t)))
+                    '((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))
+      (check-equal? (tabulate* empty '((#f #t) (#f #t)))
+                    '((#f #f) (#f #t) (#t #f) (#t #t)))))
+
+  (: 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)))))
+
+  (module+ test
+    (test-case "tabulate*/strict"
+      (check-equal? (tabulate*/strict
+                     (list (λ (x y) (and x y))
+                           (λ (x y) (or x y)))
+                     '((#f #t) (#f #t)))
+                    '(((#f #f) (#f #f)) ((#f #t) (#f #t)) ((#t #f) (#f #t)) ((#t #t) (#t #t))))))
   )
 
 (require 'typed)
-(provide)
+(provide
+ tabulate* tabulate*/strict)
 
 
 (provide
@@ -27,7 +63,6 @@
  ;; Functions
  (contract-out
   [tabulate (-> procedure? (listof generic-set?) (listof list?))]
-  [tabulate* (-> (listof procedure?) (listof generic-set?) (listof list?))]
   [tabulate/boolean (-> procedure? (listof (listof boolean?)))]
   [tabulate*/boolean (-> (non-empty-listof procedure?) (listof (listof boolean?)))]
   [tabulate/01 (-> procedure? (listof (listof (or/c 0 1))))]
@@ -66,17 +101,6 @@
 ;;; Tabulating
 ;;; ==========
 
-;;; Given a function and a list of domains for each of its arguments,
-;;; in order, produces a list of lists giving the values of arguments
-;;; and the value of the functions for these inputs.
-(define (tabulate func doms)
-  (tabulate* `(,func) doms))
-
-(module+ test
-  (test-case "tabulate"
-    (check-equal? (tabulate (λ (x y) (and x y)) '((#f #t) (#f #t)))
-                  '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
-
 ;;; Like tabulate, but takes a list of functions taking
 ;;; the same arguments over the same domains.
 (define (tabulate* funcs doms)
@@ -92,6 +116,18 @@
     (check-equal? (tabulate* empty '((#f #t) (#f #t)))
                   '((#f #f) (#f #t) (#t #f) (#t #t)))))
 
+;;; Given a function and a list of domains for each of its arguments,
+;;; in order, produces a list of lists giving the values of arguments
+;;; and the value of the functions for these inputs.
+(define (tabulate func doms)
+  (tabulate* `(,func) doms))
+
+(module+ test
+  (test-case "tabulate"
+    (check-equal? (tabulate (λ (x y) (and x y)) '((#f #t) (#f #t)))
+                  '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
+
+
 ;;; Like tabulate, but assumes the domains of all variables of the
 ;;; function are Boolean.  func must have a fixed arity.  It is an
 ;;; error to supply a function of variable arity.
diff --git a/scribblings/functions.scrbl b/scribblings/functions.scrbl
index b77a62d..2c82d59 100644
--- a/scribblings/functions.scrbl
+++ b/scribblings/functions.scrbl
@@ -1,6 +1,6 @@
 #lang scribble/manual
 @(require scribble/example racket/sandbox
-	  (for-label typed/racket/base "../functions.rkt"))
+	  (for-label typed/racket/base "../functions.rkt" dds/utils))
 
 @title[#:tag "functions"]{dds/functions: Formal Functions}
 
@@ -19,6 +19,47 @@ Boolean functions, etc.).
 
 @section{Tabulating functions}
 
+@defproc[(tabulate* [funcs (Listof (-> a ... b))]
+		    [doms (List (Listof a) ... a)])
+		    (Listof (Listof (U Any b)))]{
+
+Like @racket[tabulate], but @racket[funcs] is a list of functions taking the
+same arguments over the same domains.
+
+@examples[#:eval functions-evaluator
+(tabulate* (list (λ (x y) (and x y))
+                 (λ (x y) (or x y)))
+           '((#f #t) (#f #t)))
+]}
+
+@defproc[(tabulate*/strict [funcs (Listof (-> a ... b))]
+			   [doms (List (Listof a) ... a)])
+			   (Listof (List (List a ...) (Listof b)))]{
+
+Like @racket[tabulate*], but the types of the arguments of the functions
+explicitly appear in the return type.
+
+As of 2022-03-06, I am not able to write the type of a list first containing
+elements of types @racket[a ...], followed by a list of elements of type
+@racket[b].  This is why this function returns a list of lists, each containing
+first a list of inputs, and then the list of outputs of @racket[funcs].
+
+@examples[#:eval functions-evaluator
+(tabulate*/strict (list (λ (x y) (and x y))
+                  	(λ (x y) (or x y)))
+           	   '((#f #t) (#f #t)))
+]
+
+The result of @racket[tabulate*] can be obtained by applying
+@racket[append-lists]:
+
+@examples[#:eval functions-evaluator
+(require (only-in "utils.rkt" append-lists))
+(append-lists (tabulate*/strict (list (λ (x y) (and x y))
+                                      (λ (x y) (or x y)))
+                                '((#f #t) (#f #t))))
+]}
+
 @section{Constructing functions}
 
 @section{Random functions}