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

@ -2,44 +2,24 @@
(require (for-syntax racket/base))
(require racket/contract)
(provide define/provide define/provide/contract)
;; todo: these won't handle nested forms like (define ((foo x) y))
(define-syntax (define/provide stx)
(syntax-case stx ()
;; order of cases matters, of course
;; match more complicated shape first,
;; otherwise second matcher gives false positives
[(_ (name arg ... . rest-arg) body ...)
#'(begin
(provide name)
(define (name arg ... . rest-arg) body ...))]
[(_ (name arg ...) body ...)
#'(begin
(provide name)
(define (name arg ...) body ...))]
[(_ (proc arg ... . rest-arg) body ...)
#'(define/provide proc
(λ(arg ... . rest-arg) body ...))]
[(_ name body ...)
#'(begin
(provide name)
(define name body ...))]))
(define-syntax (define/provide/contract stx)
(syntax-case stx ()
[(_ (name arg ... . rest-arg) contract body ...)
#'(begin
(provide (contract-out [name contract]))
(define (name arg ... . rest-arg) body ...))]
[(_ (name arg ...) contract body ...)
#'(begin
(provide (contract-out [name contract]))
(define (name arg ...) body ...))]
[(_ (proc arg ... . rest-arg) contract body ...)
#'(define/provide/contract proc contract
(λ(arg ... . rest-arg) body ...))]
[(_ name contract body ...)
#'(begin
(provide (contract-out [name contract]))
(define name body ...))]))
(define/provide (foo x y . z)
(+ x y z))
Loading…
Cancel
Save