[r6rs-discuss] [Formal] Trivial Enhancement of macros in v5.91: capture-syntax

From: Matthew Flatt <mflatt>
Date: Tue Nov 28 07:34:02 2006

At Tue, 28 Nov 2006 04:43:34 -0500, Abdulaziz Ghuloum wrote:
> Of course the library would
> have been not as simple had explicit phases been in place

Wrong. Your code works just fine with explicit phases.

As is typical, no `for' declarations are necessary, mostly because
`r6rs' exports into both run and expand phases

You can even run this code in MzScheme by straightforward translation
of `library' to `module' and `r6rs' to `mzscheme' ---- except that
MzScheme's `let-syntax' isn't splicing, so I provide a splicing version
below.

Matthew

----------------------------------------

(module splicing-let-syntax mzscheme
  (provide splicing-let-syntax)
  (define-syntax (splicing-let-syntax stx)
    (syntax-case stx ()
      [(_ ([id trans] ...) . body)
       ;; Using very low-level, very MzScheme-specific
       ;; syntax operators to implement a splicing
       ;; `let-syntax'...
       (let* ([def-ctx (syntax-local-make-definition-context)]
              [ctx (list (gensym 'intdef))]
              [paint (lambda (x)
                       (syntax-case (local-expand
                                     #`(quote #,x)
                                     ctx
                                     (list #'quote)
                                     def-ctx) ()
                         [(_ e) #'e]))])
         (syntax-local-bind-syntaxes (syntax->list #'(id ...))
                                     #f def-ctx)
         (with-syntax ([(id ...) (map paint
                                      (syntax->list #'(id ...)))]
                       [body (paint #'body)])
           #'(begin
               (define-syntax id trans) ...
               . body)))])))

(module tracers mzscheme
  (require splicing-let-syntax)
   (provide trace-region untrace-region)

   (define print-args
     (lambda (fml* act*)
       (display "Lambda ")
       (display fml*)
       (display " : ")
       (display act*)
       (newline)))
   (define-syntax trace-region
     (lambda (x)
       (syntax-case x ()
         [(kwd b b* ...)
          (with-syntax ([L (datum->syntax-object #'kwd 'lambda)])
            #'(splicing-let-syntax
               ([L
                 (lambda (stx)
                   (syntax-case stx ()
                     [(_ fml* body body* (... ...))
                      #'(lambda act*
                          (print-args 'fml* act*)
                          (apply (lambda fml* body body* (... ...))
                                 act*))]))])
                b b* ...))])))
   (define-syntax untrace-region
     (lambda (x)
       (syntax-case x ()
         [(kwd b b* ...)
          (with-syntax ([L (datum->syntax-object #'kwd 'lambda)])
            #'(splicing-let-syntax
               ([L
                 (lambda (stx)
                   (syntax-case stx ()
                     [(_ fml* body body* (... ...))
                      #'(lambda fml* body body* (... ...))]))])
                b b* ...))]))))

(module FOO mzscheme
  (require tracers)
   (define a (lambda (q) (display "A not traced\n")))
   (trace-region
     (define b (lambda (r) (display "did it work in B?\n")))
     (untrace-region
       (define c (lambda (s) (display "C not traced\n"))))
     (define d (lambda (t) (display "did it work in D?\n"))))
   (a 'a)
   (b 'b)
   (c 'c)
   (d 'd))

(require FOO)
Received on Tue Nov 28 2006 - 07:31:50 UTC