[racket] define-syntax-rule/id

> I meant in the argument to `datum->syntax'...
>

Ah, great, this is even better.
I can't believe its so small in the end...

For the sake of it, here is what we have now:

#lang racket

(provide define-syntax-rule/id)

;;; By Jon Rafkind (+ tweakings)

;; Like define-syntax-rule, but takes an additional ([id id-rename] ...) set
;; where the id can be used in body,
;; and each id in body is replaced by the result of the id-rename
expression.
(define-syntax (define-syntax-rule/id stx)
  (syntax-case stx ()
    [(_ (name arg ...)
        ([id id-rename] ...)
        body ...)
     #'(define-syntax (name stx2)
         (syntax-case stx2 ()
           [(_ arg ...) ; This comes from above!
            ; We want the defined ids to have the same lexical scope as
            ; the defined macro itself.
            (with-syntax ([id (datum->syntax
                               stx2
                               (string->symbol
                                ; id-rename is an expression that comes from
above.
                                ; it will be replaced by its code in the
first expansion
                                ; (the first syntax-case),
                                ; and this code will be executed in the
second expansion.
                                (let ([arg (syntax-e #'arg)] ...)
                                  id-rename))
                               stx2 stx2 stx2
                               )]
                          ...)
              ; id is correctly bound in body here because
              ; body is replaced by the full expression (containing id)
              ; in this submacro (just like for id-rename).
              #'(begin body ...))]))
       ]))

#| TESTS: |#

; use the macro stepper to see how it is expanded
(define-syntax-rule/id (make-getter-setter xid1 xid2)
  ([getter (format "get-~a-~a" xid1 xid2)]
   [setter (format "set-~a-~a" xid1 xid2)]
   [xchger (format "xch-~a-~a" xid1 xid2)])
  (define (getter) (values xid1 xid2))
  (define (setter v1 v2) (set! xid1 v1) (set! xid2 v2))
  (define (xchger) (setter xid2 xid1))
  )

(define x1 5)
(define x2 6)
(make-getter-setter x1 x2)
(get-x1-x2)
(set-x1-x2 10 11)
(get-x1-x2)
(xch-x1-x2)
(get-x1-x2)

;|#
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20110419/987a2e00/attachment.html>