Add apply-op as a parameter to make-tabulate*.

This commit is contained in:
Sergiu Ivanov 2022-04-22 14:39:57 +02:00
parent d958c5822d
commit cf49a6f087

View file

@ -84,15 +84,15 @@
(check-false (g #t #f)) (check-false (g #t #f))
(check-exn exn:fail? (λ () (g #t #f #f)))) (check-exn exn:fail? (λ () (g #t #f #f))))
(define-syntax-parse-rule (make-tabulate* name:id row-op:id) (define-syntax-parse-rule (make-tabulate* name:id row-op:id apply-op:id)
(define (name funcs doms) (define (name funcs doms)
(for/list ([xs (in-list (apply cartesian-product doms))]) (for/list ([xs (in-list (apply cartesian-product doms))])
(row-op xs (for/list ([f funcs]) : (Listof b) (row-op xs (for/list ([f funcs]) : (Listof b)
(apply f xs)))))) (apply-op f xs))))))
(: tabulate* (All (b a ... ) (-> (Listof (-> a ... b)) (List (Listof a) ... a) (: tabulate* (All (b a ... ) (-> (Listof (-> a ... b)) (List (Listof a) ... a)
(Listof (Listof (U Any b)))))) (Listof (Listof (U Any b))))))
(make-tabulate* tabulate* append) (make-tabulate* tabulate* append apply)
(module+ test (module+ test
(test-case "tabulate*" (test-case "tabulate*"
@ -106,7 +106,7 @@
(: tabulate*/strict (All (b a ...) (-> (Listof (-> a ... b)) (List (Listof a) ... a) (: tabulate*/strict (All (b a ...) (-> (Listof (-> a ... b)) (List (Listof a) ... a)
(Listof (List (List a ...) (Listof b)))))) (Listof (List (List a ...) (Listof b))))))
(make-tabulate* tabulate*/strict list) (make-tabulate* tabulate*/strict list apply)
(module+ test (module+ test
(test-case "tabulate*/strict" (test-case "tabulate*/strict"
@ -119,7 +119,7 @@
(: tabulate*/pv (All (a b) (-> (Listof (-> a * b)) (Listof (Listof a)) (: tabulate*/pv (All (a b) (-> (Listof (-> a * b)) (Listof (Listof a))
(Listof (Listof (U a b)))))) (Listof (Listof (U a b))))))
(make-tabulate* tabulate*/pv append) (make-tabulate* tabulate*/pv append apply)
(module+ test (module+ test
(test-case "tabulate*/pv" (test-case "tabulate*/pv"