Add make-tabulate* to factor out the common parts.
This commit is contained in:
parent
929bf09299
commit
37dddb190f
1 changed files with 12 additions and 9 deletions
|
@ -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"
|
||||
|
|
Loading…
Reference in a new issue