scolobb
/
dds
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add make-tabulate* to factor out the common parts.

This commit is contained in:
Sergiu Ivanov 2022-03-06 21:45:21 +01:00
parent 929bf09299
commit 37dddb190f
1 changed files with 12 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
functions.rkt
View File

@ -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"