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

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