Scheme:マクロ:pset!

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) ...)))))))