pull/2/head
Matthew Butterick 11 years ago
parent 040d7e9f55
commit 22c23f4c8c

@ -12,14 +12,14 @@
;; order of cases matters, of course ;; order of cases matters, of course
;; match more complicated shape first, ;; match more complicated shape first,
;; otherwise second matcher gives false positives ;; otherwise second matcher gives false positives
[(_ (name arg ...) body ...) [(_ (name arg ... . rest-arg) body ...)
#'(begin #'(begin
(provide name) (provide name)
(define (name arg ...) body ...))] (define (name arg ... . rest-arg) body ...))]
[(_ (name . arg) body ...) [(_ (name arg ...) body ...)
#'(begin #'(begin
(provide name) (provide name)
(define (name . arg) body ...))] (define (name arg ...) body ...))]
[(_ name body ...) [(_ name body ...)
#'(begin #'(begin
(provide name) (provide name)
@ -28,19 +28,18 @@
(define-syntax (define/provide/contract stx) (define-syntax (define/provide/contract stx)
(syntax-case stx () (syntax-case stx ()
[(_ (name arg ...) contract body ...) [(_ (name arg ... . rest-arg) contract body ...)
#'(begin #'(begin
(provide (contract-out [name contract])) (provide (contract-out [name contract]))
(define (name arg ...) body ...))] (define (name arg ... . rest-arg) body ...))]
[(_ (name . arg) contract body ...) [(_ (name arg ...) contract body ...)
#'(begin #'(begin
(provide (contract-out [name contract])) (provide (contract-out [name contract]))
(define (name . arg) body ...))] (define (name arg ...) body ...))]
[(_ name contract body ...) [(_ name contract body ...)
#'(begin #'(begin
(provide (contract-out [name contract])) (provide (contract-out [name contract]))
(define name body ...))])) (define name body ...))]))
(define/provide/contract (foo #:what x) (define/provide (foo x y . z)
(#:what integer? . -> . integer?) (+ x y z))
(λ(x) x))
Loading…
Cancel
Save