diff --git a/functions.rkt b/functions.rkt index 9a95d93..c5a4d5d 100644 --- a/functions.rkt +++ b/functions.rkt @@ -19,10 +19,6 @@ pseudovariadic-lambda pvλ pseudovariadic-define pvdefine tabulate* tabulate*/strict tabulate*/pv tabulate tabulate/strict tabulate/pv) - (unsafe-provide - (rename-out [tabulate* tabulate*/untyped] - [tabulate tabulate/untyped])) - (module+ test (require typed/rackunit)) @@ -150,14 +146,50 @@ (test-case "tabulate/pv" (check-equal? (tabulate/pv (pvλ (x y) (and x y)) '((#f #t) (#f #t))) '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t))))) + + (module untyped racket + (module+ test + (require rackunit)) + + (provide + (contract-out [tabulate* (-> (listof procedure?) (listof (listof any/c)) + (listof (listof any/c)))] + [tabulate (-> procedure? (listof (listof any/c)) + (listof (listof any/c)))])) + + (define (tabulate* funcs doms) + (for/list ([xs (in-list (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))))) + + (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)))))) ) (require 'typed) (provide pseudovariadic-lambda pvλ pseudovariadic-define pvdefine - tabulate* tabulate*/strict tabulate*/pv tabulate*/untyped - tabulate tabulate/strict tabulate/pv tabulate/untyped) + tabulate* tabulate*/strict tabulate*/pv + tabulate tabulate/strict tabulate/pv) +(require (rename-in (submod 'typed untyped) + [tabulate tabulate/untyped] + [tabulate* tabulate*/untyped])) (provide ;; Structures diff --git a/scribblings/functions.scrbl b/scribblings/functions.scrbl index d24c178..9b53c61 100644 --- a/scribblings/functions.scrbl +++ b/scribblings/functions.scrbl @@ -112,33 +112,6 @@ Like @racket[tabulate], but @racket[func] (tabulate/pv (pvλ (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)))]{ @@ -193,38 +166,50 @@ are @seclink["pseudovariadic"]{pseudovariadic}. '((#f #t) (#f #t))) ]} -@defproc[(tabulate*/untyped [funcs (listof 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 (list (λ (x y) (and x y)) - (λ (x y) (or 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 (list (λ (x y z) (and x y z))) - '((#f #t) (#f #t)))) -(eval:error (require 'tabulate*/untyped-test)) -]} - @section{Constructing functions} @section{Random functions} @section{Threshold Boolean functions} + +@section[#:tag "fuctions/untyped"]{Untyped definitions} + +@defmodule[(submod dds/functions untyped)] + +@(require (for-label (only-in racket/contract/base listof any/c))) + +This submodule contains some functions which cannot be typed or some functions +for which Typed Racket cannot produce contracts, i.e. polymorphic functions of +variable arity. The definitions in this submodule specifically target untyped +user code. + +@(define functions-evaluator/untyped + (parameterize ([sandbox-output 'string] + [sandbox-error-output 'string] + [sandbox-memory-limit 50]) + (make-evaluator 'racket #:requires '((submod "functions.rkt" typed untyped))))) + +@defproc[(tabulate [funcs procedure?] + [doms (listof list?)]) + (listof list?)]{ + +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/untyped +(tabulate (λ (x y) (and x y)) '((#f #t) (#f #t))) +]} + +@defproc[(tabulate* [funcs (listof procedure?)] + [doms (listof list?)]) + (listof list?)]{ + +Like @racket[tabulate], but @racket[funcs] is a list of functions taking the +same arguments over the same domains. + +@examples[#:eval functions-evaluator/untyped +(tabulate* (list (λ (x y) (and x y)) + (λ (x y) (or x y))) + '((#f #t) (#f #t))) +]}