Add table->function/pv.

This commit is contained in:
Sergiu Ivanov 2022-04-16 00:17:44 +02:00
parent 1324be292e
commit 4272cd87a8
2 changed files with 36 additions and 2 deletions

View file

@ -19,7 +19,7 @@
pseudovariadic-lambda pvλ pseudovariadic-define pvdefine
tabulate* tabulate*/strict tabulate*/pv tabulate tabulate/strict tabulate/pv
tabulate*/pv/boolean tabulate/pv/boolean tabulate*/pv/01 tabulate/pv/01
table->function/list table->function)
table->function/list table->function table->function/pv)
(module+ test
(require typed/rackunit))
@ -217,6 +217,24 @@
(check-true (negation #f))
(check-false (negation #t))))
(: table->function/pv (All (a) (-> (Listof (Listof a)) (-> a * a))))
(define (table->function/pv table)
(define func (table->function/list table))
(define arity (- (length (car table)) 1))
(λ xs
(if (= arity (length xs))
(func xs)
(error 'pseudovariadic-lambda
"invalid arity, expected ~a argument(s)"
arity))))
(module+ test
(test-case "table->function/pv"
(define negation (table->function/pv '((#t #f) (#f #t))))
(check-true (negation #f))
(check-false (negation #t))
(check-exn exn:fail? (λ () (negation #f #t)))))
(module untyped racket
(module+ test
(require rackunit))
@ -298,7 +316,7 @@
tabulate tabulate/strict tabulate/pv
tabulate*/pv/boolean tabulate/pv/boolean
tabulate*/pv/01 tabulate/pv/01
table->function/list table->function)
table->function/list table->function table->function/pv)
(require (rename-in (submod 'typed untyped)
[tabulate tabulate/untyped]

View file

@ -273,6 +273,22 @@ number of arguments rather than a list of values.
(my-and #t #t)
]}
@defproc[(table->function/pv [table (Listof (Listof a))])
(-> a * a)]{
Like @racket[table->function], but the resulting function raises an explicit
error about invalid arity, instead of the @racket[hash-ref]-related error
raised by the function returned by @racket[table->function]. In other words,
the returned by @racket[table->function/pv] is
@seclink["pseudovariadic"]{pseudovariadic}.
@examples[#:eval functions-evaluator
(define my-and/pv (table->function/pv tab))
(my-and/pv #f #t)
(eval:error (my-and/pv #f))
(eval:error (my-and #f))
]}
@section{Random functions}
@section{Threshold Boolean functions}