Add syntax for defining pseudovariadic functions.

functions.rkt

@@ -15,6 +15,7 @@
            (for-syntax syntax/parse))
 
   (provide
+   pseudovariadic-lambda pvλ pseudovariadic-define pvdefine
    tabulate* tabulate*/strict tabulate tabulate/strict)
 
   (unsafe-provide
@@ -24,6 +25,57 @@
   (module+ test
     (require typed/rackunit))
 
+  (begin-for-syntax
+    (require racket (for-syntax syntax/parse))
+
+    (define (make-pseudovariadic-core args bodies tag-stx)
+      (define nargs-stx (datum->syntax args (length (syntax->list args))))
+      #`(λ xs
+          (match xs
+            [(list #,@args) #,@bodies]
+            [_ (error #,tag-stx "invalid arity, expected ~a argument(s)" #,nargs-stx)])))
+
+    (define (make-pseudovariadic-lambda stx)
+      (syntax-parse stx
+        [(_ (args:id ...) bodies:expr ...)
+         (make-pseudovariadic-core #'(args ...)
+                                   #'(bodies ...)
+                                   (datum->syntax stx ''pseudovariadic-lambda))]))
+
+    (define (make-pseudovariadic-define stx)
+      (syntax-parse stx
+        [(_ (name:id args:id ...) bodies:expr ...)
+         #`(define name
+             #,(make-pseudovariadic-core
+                #'(args ...)
+                #'(bodies ...)
+                (datum->syntax #'name `(quote ,(syntax->datum #'name)))))])))
+
+  (define-syntax (pseudovariadic-lambda stx) (make-pseudovariadic-lambda stx))
+  (define-syntax (pvλ stx) (make-pseudovariadic-lambda stx))
+
+  (module+ test
+    (test-case "pseudovariadic-lambda")
+    (check-false ((pseudovariadic-lambda (x y) (and x y)) #t #f))
+    (check-false ((pvλ (x y) (and x y)) #t #f))
+    (check-exn exn:fail? (λ () ((pseudovariadic-lambda (x y) (and x y)) #t #f #f)))
+    (check-exn exn:fail? (λ () ((pvλ (x y) (and x y)) #t #f #f))))
+
+  (define-syntax (pseudovariadic-define stx) (make-pseudovariadic-define stx))
+  (define-syntax (pvdefine stx) (make-pseudovariadic-define stx))
+
+  (module+ test
+    (test-case "pseudovariadic-define")
+    (: f (-> Boolean * Boolean))
+    (pseudovariadic-define (f x y) (and x y))
+    (check-false (f #t #f))
+    (check-exn exn:fail? (λ () (f #t #f #f)))
+
+    (: g (-> Boolean * Boolean))
+    (pvdefine (g x y) (and x y))
+    (check-false (g #t #f))
+    (check-exn exn:fail? (λ () (g #t #f #f))))
+
   (define-syntax (make-tabulate* stx)
     (syntax-parse stx
       [(_ name:id row-op)
@@ -81,6 +133,7 @@
 
 (require 'typed)
 (provide
+ pseudovariadic-lambda pvλ pseudovariadic-define pvdefine
  tabulate* tabulate*/strict tabulate*/untyped tabulate tabulate/strict
  tabulate/untyped)
 

scribblings/functions.scrbl

@@ -48,6 +48,29 @@ when they receive a number of arguments different from a given constant value.
 Such functions are called @italic{pseudovariadic functions} in
 this documentation.
 
+@deftogether[(@defform[(pseudovariadic-lambda (id ...+) body ...+)]
+              @defform[(pvλ (id ...+) body ...+)])]{
+
+Define a pseudovariadic anonymous function.
+
+@examples[#:eval functions-evaluator
+(: f (-> Boolean * Boolean))
+(define f (pseudovariadic-lambda (x y) (and x y)))
+(f #t #f)
+(eval:error (f #t #f #t))
+]}
+
+@deftogether[(@defform[(pseudovariadic-define (name id ...+) body ...+)]
+              @defform[(pvdefine (id ...+) body ...+)])]{
+
+Define a pseudovariadic function called @racket[name].
+
+@examples[#:eval functions-evaluator
+(: g (-> Boolean * Boolean))
+(pseudovariadic-define (g x y) (and x y))
+(g #t #f)
+(eval:error (g #t #f #t))
+]}
 @section[#:tag "tabulating"]{Tabulating functions}
 
 @defproc[(tabulate [func (-> a ... b)]