From e7616684f5b7286dfb9bce18c24a8de52b1b63be Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 6 Mar 2022 23:39:51 +0100 Subject: [PATCH] Add tabulate, tabulate/strict, and tabulate/untyped. --- functions.rkt | 45 ++++++++++++++++++------------ scribblings/functions.scrbl | 55 +++++++++++++++++++++++++++++++++++++ 2 files changed, 82 insertions(+), 18 deletions(-) diff --git a/functions.rkt b/functions.rkt index 7476a63..9b83ed6 100644 --- a/functions.rkt +++ b/functions.rkt @@ -15,10 +15,11 @@ (for-syntax syntax/parse)) (provide - tabulate* tabulate*/strict) + tabulate* tabulate*/strict tabulate tabulate/strict) (unsafe-provide - (rename-out [tabulate* tabulate*/untyped])) + (rename-out [tabulate* tabulate*/untyped] + [tabulate tabulate/untyped])) (module+ test (require typed/rackunit)) @@ -56,11 +57,32 @@ (λ (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)))))) + + (: tabulate (All (b a ...) (-> (-> a ... b) (List (Listof a) ... a) + (Listof (Listof (U Any b)))))) + (define (tabulate func doms) + (tabulate* (list 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))))) + + (: tabulate/strict (All (b a ...) (-> (-> a ... b) (List (Listof a) ... a) + (Listof (List (List a ...) (Listof b)))))) + (define (tabulate/strict func doms) + (tabulate*/strict (list func) doms)) + + (module+ test + (test-case "tabulate/strict" + (check-equal? (tabulate/strict (λ (x y) (and x y)) '((#f #t) (#f #t))) + '(((#f #f) (#f)) ((#f #t) (#f)) ((#t #f) (#f)) ((#t #t) (#t)))))) ) (require 'typed) (provide - tabulate* tabulate*/strict tabulate*/untyped) + tabulate* tabulate*/strict tabulate*/untyped tabulate tabulate/strict + tabulate/untyped) (provide @@ -69,7 +91,6 @@ [struct tbf ((weights (vectorof number?)) (threshold number?))]) ;; Functions (contract-out - [tabulate (-> 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))))] @@ -108,23 +129,11 @@ ;;; 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*/untyped `(,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. (define (tabulate/boolean func) - (tabulate func (make-list (procedure-arity func) '(#f #t)))) + (tabulate/untyped func (make-list (procedure-arity func) '(#f #t)))) (module+ test (test-case "tabulate/boolean" @@ -147,7 +156,7 @@ ;;; function are {0, 1}. func must have a fixed arity. It is an ;;; error to supply a function of variable arity. (define (tabulate/01 func) - (tabulate func (make-list (procedure-arity func) '(0 1)))) + (tabulate/untyped func (make-list (procedure-arity func) '(0 1)))) (module+ test (test-case "tabulate/01" diff --git a/scribblings/functions.scrbl b/scribblings/functions.scrbl index ea1deea..4165490 100644 --- a/scribblings/functions.scrbl +++ b/scribblings/functions.scrbl @@ -20,6 +20,61 @@ Boolean functions, etc.). @section{Tabulating functions} +@defproc[(tabulate [func (-> a ... b)] + [doms (List (Listof a) ... a)]) + (Listof (Listof (U Any b)))]{ + +Given a function @racket[func] and a list of domains @racket[doms] 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. + +@examples[#:eval functions-evaluator +(tabulate (λ (x y) (and x y)) '((#f #t) (#f #t))) +]} + +@defproc[(tabulate/strict [func (-> a ... b)] + [doms (List (Listof a) ... a)]) + (Listof (List (List a ...) (Listof b)))]{ + +Like @racket[tabulate], but the types of the arguments of @racket[func] +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 an element of type @racket[b]. +This is why this function returns a list of lists, each containing first a list +of inputs, and then the output of @racket[func]. + +@examples[#:eval functions-evaluator +(tabulate/strict (λ (x y) (and x y)) '((#f #t) (#f #t))) +]} + +@defproc[(tabulate/untyped [funcs procedure?] + [doms (listof list?)]) + (listof list?)]{ + +A version of @racket[tabulate] without type checking. + +As of 2022-03-06, Typed Racket cannot generate contracts for polymorphic +variable-arity functions. This means that @racket[tabulate] cannot be used +directly in untyped code and should be replaced by @racket[tabulate/untyped], +which is simply an @racket[unsafe-provide] of @racket[tabulate]. + +@examples[#:eval functions-evaluator +(tabulate/untyped (λ (x y) (and x y)) '((#f #t) (#f #t))) +] + +The contracts in the documentation entry are provided for explanatory purposes +and are not actually enforced. Some contracts on the functions +@racket[tabulate] uses internally are still checked. For example, trying to +tabulate a function of wrong arity will still raise an error. + +@examples[#:eval functions-evaluator +(module tabulate/untyped-test racket/base + (require "functions.rkt") + (tabulate/untyped (λ (x y z) (and x y z)) '((#f #t) (#f #t)))) +(eval:error (require 'tabulate/untyped-test)) +]} + @defproc[(tabulate* [funcs (Listof (-> a ... b))] [doms (List (Listof a) ... a)]) (Listof (Listof (U Any b)))]{