Shiro(2010/05/25 01:48:28 PDT): Common LispのpsetqをSchemeでどう書く、という話が Chaton/twitter方面で出て、ちらっと書いたんだけど、 後で役に立つかもしれないのでこっちにも写しておく。
psetqは複数の代入を「並列に」行う。並列っていっても並列計算じゃなくて、 それぞれの代入が他の代入に影響を与えないってこと。
(let ((x 0)) (y 1))
(psetq x y
y x)
(list x y)) => (1 0)
普通にsetfを並べるだけだと最初のx <- y の代入でxが上書きされちゃうからね。
この機能だけならR5RSマクロで書ける (エッセンスを示すためにchatonに書いたのより さらに簡略化した)。
(define-syntax pset!
(syntax-rules ()
[(_ v0 e0 more ...)
(pset!-aux (v0) (e0) (t0) (more ...))]))
(define-syntax pset!-aux
(syntax-rules ()
[(_ (vs ...) (es ...) (ts ...) ())
(begin (let ((ts es) ...) (set! vs ts) ...))]
[(_ (vs ...) (es ...) (ts ...) (v e more ...))
(pset!-aux (vs ... v) (es ... e) (ts ... t) (more ...))]))
やりたいのは、
(pset! v0 e0
v1 e1
v2 e2)
これを、
(let ((t0 e0)
(t1 e1)
(t2 e2))
(set! v0 t0)
(set! v1 t1)
(set! v2 t2))
こう変換すること。Lispのlegacy macroならここで「一時変数をgensymして mapして…」と考えちゃうんだけど、R5RSマクロはちと面倒。 pset!-auxという補助マクロで再帰しながら、vとeを取り出して一時変数tを積んでいってる。
こういうスタイルが良いかどうかはScheme界でも賛否両論ある。 まあ個人的には、元のフォームにmapかけたくなったらもうその時点で R5RSマクロはふさわしい道具じゃ無いだろうなと思う。 出来なくはないってだけで。
なおGaucheで展開結果を見るのはちょっと不便。普通にmacroexpandすると、 シンボルがidentifierに置き換えられたものが得られる。
gosh> (macroexpand '(pset! v0 e0
v1 e1
v2 e2))
(#<identifier user#begin>
(#<identifier user#let>
((#0=#<identifier user#t0> e0) (#2=#<identifier user#t> e1)
(#3=#<identifier user#t> e2))
(#1=#<identifier user#set!> v0 #0#)
(#1# v1 #2#)
(#1# v2 #3#)))
unwrap-syntaxするとまともなS式になるけど、一時変数の名前が同じだから 変数衝突が起きてるんじゃないのか? と思ってしまう (実際は、同じtでも 上の結果でわかるように実体が別のidentifierなんだけど)。
gosh> (unwrap-syntax (macroexpand '(pset! v0 e0
v1 e1
v2 e2)))
(begin (let ((t0 e0) (t e1) (t e2)) (set! v0 t0) (set! v1 t) (set! v2 t)))
このへんの不便さはそのうちなんとかしたい。
R6RSマクロのsyntax-caseによる実装は読者への課題としておく、 と書いとけばだれかやってくれるに違いない。
齊藤(2010/05/25 06:33:23 PDT): やってみました。 R5RS より簡潔に書けなきゃ甲斐がないと思って頑張ってみたんですが、まだ改善の余地は残ってそうな予感。
(define-syntax pset!
(lambda(x)
(define (group x)
(syntax-case x ()
(() #'())
((v e rest ...) #`((v e) . #,(group #'(rest ...))))))
(syntax-case x ()
((_ v1 e1 rest ...)
(with-syntax ((((vs es) ...) (group #'(v1 e1 rest ...))))
(with-syntax (((ts ...) (generate-temporaries #'(vs ...))))
#'(let ((ts es) ...) (set! vs ts) ...)))))))