Remove tabulate* from functions.rkt.

This temporarily breaks networks, but all breakages are easy to fix
with tabulate*/untyped.
This commit is contained in:
Sergiu Ivanov 2022-03-06 22:58:16 +01:00
parent 31d6275229
commit fcf21c51aa

View file

@ -108,21 +108,6 @@
;;; Tabulating ;;; Tabulating
;;; ========== ;;; ==========
;;; Like tabulate, but takes a list of functions taking
;;; the same arguments over the same domains.
(define (tabulate* funcs doms)
(for/list ([xs (apply cartesian-product doms)])
(append xs (for/list ([f funcs]) (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)))))
;;; Given a function and a list of domains for each of its arguments, ;;; 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 ;;; in order, produces a list of lists giving the values of arguments
;;; and the value of the functions for these inputs. ;;; and the value of the functions for these inputs.
@ -150,7 +135,7 @@
;;; arity. ;;; arity.
(define (tabulate*/boolean funcs) (define (tabulate*/boolean funcs)
(define doms (make-list (procedure-arity (car funcs)) '(#f #t))) (define doms (make-list (procedure-arity (car funcs)) '(#f #t)))
(tabulate* funcs doms)) (tabulate*/untyped funcs doms))
(module+ test (module+ test
(test-case "tabulate*/boolean" (test-case "tabulate*/boolean"
@ -171,7 +156,7 @@
;;; Like tabulate/01, but takes a list of functions of the same arity. ;;; Like tabulate/01, but takes a list of functions of the same arity.
(define (tabulate*/01 funcs) (define (tabulate*/01 funcs)
(tabulate* funcs (make-list (procedure-arity (car funcs)) '(0 1)))) (tabulate*/untyped funcs (make-list (procedure-arity (car funcs)) '(0 1))))
(module+ test (module+ test
(test-case "tabulate*/01" (test-case "tabulate*/01"
@ -395,7 +380,7 @@
(define funcs (for/list ([tbf tbfs]) (define funcs (for/list ([tbf tbfs])
(λ in (apply-tbf tbf (list->vector in))))) (λ in (apply-tbf tbf (list->vector in)))))
(define nvars (vector-length (tbf-w (car tbfs)))) (define nvars (vector-length (tbf-w (car tbfs))))
(tabulate* funcs (make-list nvars '(0 1)))) (tabulate*/untyped funcs (make-list nvars '(0 1))))
(module+ test (module+ test
(test-case "tbf-tabulate*" (test-case "tbf-tabulate*"
@ -420,7 +405,7 @@
(define funcs (for/list ([tbf tbfs]) (define funcs (for/list ([tbf tbfs])
(λ in (apply-tbf/boolean tbf (list->vector in))))) (λ in (apply-tbf/boolean tbf (list->vector in)))))
(define nvars (vector-length (tbf-w (car tbfs)))) (define nvars (vector-length (tbf-w (car tbfs))))
(tabulate* funcs (make-list nvars '(#f #t)))) (tabulate*/untyped funcs (make-list nvars '(#f #t))))
(module+ test (module+ test
(test-case "tbf-tabulate*/boolean" (test-case "tbf-tabulate*/boolean"