For loop 展开';对于';环进球拍/方案?
我正在尝试在racket/scheme中编写一个宏,它像一个For loop 展开';对于';环进球拍/方案?,for-loop,macros,scheme,racket,For Loop,Macros,Scheme,Racket,我正在尝试在racket/scheme中编写一个宏,它像一个for循环一样在一些任意代码中运行,这样循环的主体就展开了。例如,下面的代码 (macro-for ((i '(0 1 2 3)) (another-macro (with i) (some (nested i)) (arguments (in (it (a b c i)))))) 应该具有与编写代码时相同的结果 (another-macro (with 0) (some (nested 0))
for
循环一样在一些任意代码中运行,这样循环的主体就展开了。例如,下面的代码
(macro-for ((i '(0 1 2 3))
(another-macro
(with i)
(some (nested i))
(arguments (in (it (a b c i))))))
应该具有与编写代码时相同的结果
(another-macro
(with 0)
(some (nested 0))
(arguments (in (it (a b c 0))))))
(another-macro
(with 1)
(some (nested 1))
(arguments (in (it (a b c 1))))))
(another-macro
(with 2)
(some (nested 2))
(arguments (in (it (a b c 2))))))
我曾尝试过实现它,但我对宏还不熟悉,它们似乎不像我期望的那样工作。这里是我的尝试-它没有编译,因为match
显然不允许在宏中使用-但希望它传达了我试图实现的想法
(module test racket
(require (for-syntax syntax/parse))
(begin-for-syntax
(define (my-for-replace search replace elem)
(if (list? elem)
(map (lambda (e) (my-for-replace search replace e)) elem)
(if (equal? elem search)
replace
elem))))
(define-syntax (my-for stx)
(syntax-case stx ()
((my-for args-stx body-stx)
(let ((args (syntax-e #'args-stx)))
(if (list? args)
(map (lambda (arg)
(match arg
((list #'var #'expr)
(my-for-replace #'var #'expr #'body))
(else
(raise-syntax-error #f
"my-for: bad variable clause"
stx
#'args))))
args)
(raise-syntax-error #f
"my-for: bad sequence binding clause"
stx
#'args))))))
(define-syntax (my-func stx)
(syntax-parse stx
((my-func body)
#'body)))
(my-for ((i '(0 1 2)))
(my-func (begin
(display i)
(newline))))
)
如果要在编译时计算for循环,可以使用内置的for循环
#lang racket/base
(require (for-syntax syntax/parse
racket/base)) ; for is in racket/base
(define-syntax (print-and-add stx)
(syntax-parse stx
[(_ (a ...))
; this runs at compile time
(for ([x (in-list (syntax->datum #'(a ...)))])
(displayln x))
; the macro expands to this:
#'(+ a ...)]))
(print-and-add (1 2 3 4 5))
输出:
1
2
3
4
5
15
1
2
3
4
更新
这是一个更新版本
#lang racket
(require (for-syntax syntax/parse racket))
(define-syntax (macro-for stx)
(syntax-parse stx
[(_macro-for ((i (a ...))) body)
(define exprs (for/list ([x (syntax->list #'(a ...))])
#`(let-syntax ([i (λ (_) #'#,x)])
body)))
(with-syntax ([(expr ...) exprs])
#'(begin expr ...))]))
(macro-for ((i (1 2 3 4)))
(displayln i))
输出:
1
2
3
4
5
15
1
2
3
4
下面是我如何写的(如果我要写这样的东西): 首先,我们需要一个helper函数,它在一个语法对象中替换另一个语法对象中出现的标识符。注意:绝不对您打算作为表达式(或包含表达式或定义等)处理的内容使用
语法->数据。相反,使用syntax-e
递归地展开,并在处理后像以前一样将其重新组合在一起:
(require (for-syntax racket/base))
(begin-for-syntax
;; syntax-substitute : Syntax Identifier Syntax -> Syntax
;; Replace id with replacement everywhere in stx.
(define (syntax-substitute stx id replacement)
(let loop ([stx stx])
(cond [(and (identifier? stx) (bound-identifier=? stx id))
replacement]
[(syntax? stx)
(datum->syntax stx (loop (syntax-e stx)) stx stx)]
;; Unwrapped data cases:
[(pair? stx)
(cons (loop (car stx)) (loop (cdr stx)))]
;; FIXME: also traverse vectors, etc?
[else stx]))))
在实现类似绑定的关系(如替换)时,请使用boundidentifier=?
。(这是一种罕见的情况;通常自由标识符=?
是正确的比较。)
现在,宏只解释for子句,进行替换,并汇编结果。如果确实希望替换的术语列表是编译时表达式,请使用racket/syntax
中的syntax local eval
(require (for-syntax racket/syntax))
(define-syntax (macro-for stx)
(syntax-case stx ()
[(_ ([i ct-sequence]) body)
(with-syntax ([(replaced-body ...)
(for/list ([replacement (syntax-local-eval #'ct-sequence)])
(syntax-substitute #'body #'i replacement))])
#'(begin replaced-body ...))]))
下面是一个使用示例:
> (macro-for ([i '(1 2 3)]) (printf "The value of ~s is now ~s.\n" 'i i))
The value of 1 is now 1.
The value of 2 is now 2.
The value of 3 is now 3.
请注意,它替换了引号下出现的i
,因此您永远不会在输出中看到符号i
。这就是你所期望的吗
免责声明:这不代表典型的球拍宏。通常,以未展开的形式进行搜索和替换是个坏主意,通常会有更惯用的方法来实现您想要的结果。Ryan Culpeper的仅支持使用一个归纳变量,因此这里有一个支持多个归纳变量的扩展:
(begin-for-syntax
;; syntax-substitute : Syntax Identifier Syntax -> Syntax
;; Replace id with replacement everywhere in stx.
(define (instr-syntax-substitute stx id replacement index)
(let loop ([stx stx])
(cond [(and (identifier? stx)
(bound-identifier=? stx id))
replacement]
[(syntax? stx)
(datum->syntax stx (loop (syntax-e stx)) stx stx)]
;; Special handling of (define-instruction id ...) case
[(and (pair? stx)
(syntax? (car stx))
(equal? (syntax-e (car stx)) 'define-instruction))
(let ((id-stx (car (cdr stx))))
(cons (loop (car stx))
(cons (datum->syntax id-stx
(string->symbol
(format "~a_~a"
(symbol->string
(syntax-e id-stx))
index))
id-stx
id-stx)
(loop (cdr (cdr stx))))))]
;; Unwrap list case
[(pair? stx)
(cons (loop (car stx)) (loop (cdr stx)))]
;; Do nothing
[else stx]))))
(begin-for-syntax
(define instr-iter-index 0)
(define (instr-iter-arg body arg argrest)
(let loop ([body body]
[arg arg]
[argrest argrest])
(let ([i (car (syntax-e arg))]
[ct-sequence (cadr (syntax-e arg))]
[replaced-bodies '()])
(for ([replacement (syntax-e ct-sequence)])
(let ([new-body (instr-syntax-substitute body
i
replacement
instr-iter-index)])
(if (null? argrest)
(begin
(set! replaced-bodies
(append replaced-bodies (list new-body)))
(set! instr-iter-index (+ instr-iter-index 1)))
(let* ([new-arg (car argrest)]
[new-argrest (cdr argrest)]
[new-bodies (loop new-body
new-arg
new-argrest)])
(set! replaced-bodies
(append replaced-bodies new-bodies))))))
replaced-bodies))))
(provide instr-for)
(define-syntax (instr-for stx)
(syntax-case stx ()
[(instr-for args body)
(with-syntax ([(replaced-body ...)
(let ([arg (car (syntax-e #'args))]
[argrest (cdr (syntax-e #'args))])
(instr-iter-arg #'body arg argrest))])
#'(begin replaced-body ...))]))
我想我应该更详细地回答我的问题,因为这不是我想要的。请看更新的问题。我得到一个错误:申请:不是一个程序;需要一个可应用于给定参数的过程:0参数…:12上下文…:/usr/racket/collects/racket/syntax.rkt:191:0:syntax-local-eval26/home/ghb/dump/scheme/test.rkt:49:0/usr/racket/collects/syntax/wrap modbeg.rkt:46:4没关系,我用syntax-e
替换syntax-local eval
解决了这个问题;我不需要在编译时对表达式求值。