diff --git a/functions.rkt b/functions.rkt index 9b83ed6..a2bc77f 100644 --- a/functions.rkt +++ b/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) diff --git a/scribblings/functions.scrbl b/scribblings/functions.scrbl index c3a943c..d4c59cd 100644 --- a/scribblings/functions.scrbl +++ b/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)]