我正在尝试在球拍中编写define-let
宏,“保存”(let ((var value) ...) ...)
的标题,即(var value) ...
部分,并允许稍后重新使用它上。
以下代码按预期工作:
#lang racket
;; define-let allows saving the header part of a let, and re-use it later
(define-syntax (define-let stx1)
(syntax-case stx1 ()
[(_ name [var value] ...)
#`(define-syntax (name stx2)
(syntax-case stx2 ()
[(_ . body)
#`(let ([#,(datum->syntax stx2 'var) value] ...)
. body)]))]))
;; Save the header (let ([x "works]) ...) in the macro foo
(define-let foo [x "works"])
;; Use the header, should have the same semantics as:
;; (let ([x "BAD"])
;; (let ([x "works])
;; (displayln x))
(let ([x "BAD"])
(foo (displayln x))) ;; Displays "works".
问题是宏破坏了卫生:如下面的例子所示,由宏生成的y
中声明的变量define-let
应该是一个新的,未打开的符号,由于卫生,但它设法泄漏出宏,并且(displayln y)
错误地访问它。
;; In the following macro, hygiene should make y unavailable
(define-syntax (hygiene-test stx)
(syntax-case stx ()
[(_ name val)
#'(define-let name [y val])]))
;; Therefore, the y in the above macro shouldn't bind the y in (displayln y).
(hygiene-test bar "wrong")
(let ((y "okay"))
(bar (displayln y))) ;; But it displays "wrong".
如何编写define-let
宏以使其行为与第一个示例相同,但是当宏生成标识符时保留卫生,在第二个示例中给出"okay"
?
答案 0 :(得分:3)
遵循提示"语法参数"来自Chris,这是一个解决方案:
#lang racket
(require racket/stxparam
(for-syntax syntax/strip-context))
(define-syntax (define-let stx1)
(syntax-case stx1 ()
[(_ name [var expr] ...)
(with-syntax ([(value ...) (generate-temporaries #'(expr ...))])
#`(begin
(define-syntax-parameter var (syntax-rules ()))
...
(define value expr)
...
(define-syntax (name stx2)
(syntax-case stx2 ()
[(_ . body)
(with-syntax ([body (replace-context #'stx1 #'body)])
#'(syntax-parameterize ([var (syntax-id-rules () [_ value])] ...)
. body))]))))]))
(define-let foo [x "works"])
(let ([x "BAD"])
(foo (displayln x))) ; => works
(let ([x "BAD"])
(foo
(let ([x "still works"])
(displayln x)))) ; => still works
更新
此解决方案通过了评论中的附加测试。 新解决方案将身体的上下文转移到 要绑定的变量。
#lang racket
(require (for-syntax syntax/strip-context))
(define-syntax (define-let stx1)
(syntax-case stx1 ()
[(_ name [var expr] ...)
#`(begin
(define-syntax (name stx2)
(syntax-case stx2 ()
[(_ . body)
(with-syntax ([(var ...) (map (λ (v) (replace-context #'body v))
(syntax->list #'(var ...)))])
#'(let ([var expr] ...)
. body))])))]))
(define-let foo [x "works"])
(let ([x "BAD"])
(foo (displayln x))) ; => works
(let ([x "BAD"])
(foo
(let ([x "still works"])
(displayln x)))) ; => still works
(let ([z "cool"])
(foo (displayln z))) ; => cool