From c2f558042d0064bf0d0879ad0d726f83909bba20 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 15 Feb 2014 18:29:04 -0800 Subject: [PATCH] simplify --- define.rkt | 34 +++++++--------------------------- 1 file changed, 7 insertions(+), 27 deletions(-) diff --git a/define.rkt b/define.rkt index e7133b2..1920ade 100644 --- a/define.rkt +++ b/define.rkt @@ -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)) \ No newline at end of file + (define name body ...))])) \ No newline at end of file