CPSマクロ

assocをマクロで書いたらどうなるか、ということを考えた。これくらいならそんなに難しい話ではなく、以下のように書けるだろう。

(import (scheme base) (scheme write))

(define-syntax assocm
  (syntax-rules ()
    ((_ key (alist ...))
     (letrec-syntax ((foo (syntax-rules (key)
                            ((_ (key . e) res (... ...)) (key . e))
                            ((_ (a . d) res (... ...)) (foo res (... ...))))))
       (foo alist ...)))))

;; a bit of trick to avoid unbound variable
(define (c d) (list 'c d))
(define d 1)

(assocm c ((a b) (b d) (c d) (d d)))
;; -> (c 1)

取り出せるのであれば、その中身も欲しい。つまり、carやcdrだ。これも同じ要領でやればこんな感じで書けるだろう。

(define-syntax cdrm
  (syntax-rules ()
    ((_ (a . d)) d)))

(cdrm (c . d))
;; -> 1

だが、これら二つのマクロはこんな感じでは組み合わせられない。

(cdrm (assocm c ((a b) (b d) (c d) (d d))))
;; -> error

これはcdrmがassocmより先に展開されるからである。あるマクロの展開結果を別のマクロで使いたい状況というのはしばしばある。そういうときにはCPSでマクロを書く。最初のassocmをCPSで書いてみよう。

(define-syntax assocm/cps
  (syntax-rules ()
    ((_ k key (alist ...))
     (letrec-syntax ((foo (syntax-rules (key)
                            ((_ (key . e) res (... ...)) (k (key . e)))
                            ((_ (a . d) res (... ...)) (foo res (... ...))))))
       (foo alist ...)))))

(assocm/cps cdrm c ((a . b) (b . d) (c . d) (d . d)))
;; -> 1

このassocm/cpsは最初の引数に次に展開するマクロを受け取ることで、マクロの展開が終わった際に展開結果(この場合は(key . e))を引数kに渡すことを可能としている。要するに単なるCPSであるがこの状態では割と致命的な欠点がある。それは複数のマクロを組み合わせることができないということである。

例えば上記の例でcadrmはどう書くだろうか？普通に考えれば、carmを定義したのち、cdrmを組み合わせて書きたいところであろう。(もちろんゴリゴリ書いてもいいんだけど。) そう(compose f g)みたいなことがしたわけである。

;; I want to write like this!
(assocm/cps (composem cdrm/cps carm) c ((a . b) (b . d) (c . d) (d . d)))

こうなると、単にマクロを受け取って結果を渡すだけではなく、次のマクロが複合マクロかどうかを判別して上手いことやってくれる何かがほしい。こんな感じだろう。

(define-syntax composem (syntax-rules ()))

;; assume k is CPS macro
(define-syntax extract/cps
  ;; it's a bit awkward to have own name in literals
  ;; but this saves me a lot
  (syntax-rules (composem extract/cps)
    ((_ (composem k) args ...) (k args ...))
    ((_ (composem k ...) args ...)
     (extract/cps "flatten" () (k ...) (args ...)))
    ;; flatten nested composem
    ((_ "flatten" (cps ...) ((composem k ...) k* ...) args)
     (extract/cps "flatten" (cps ... k ...) (k* ...) args))
    ((_ "flatten" (cps ...) (k k* ...) args)
     (extract/cps "flatten" (cps ... k) (k* ...) args))
    ((_ "flatten" (cps ...) () (args ...))
     (extract/cps (extract/cps cps ...) args ...))
    ;; extract/cps keyword
    ((_ (extract/cps (composem k)) args ...) (k args ...))
    ((_ (extract/cps (composem k k* ...)) args ...)
     (k (extract/cps (composem k* ...)) args ...))

    ((_ (extract/cps k) args ...) (k args ...))
    ((_ (extract/cps k k* ...) args ...)
     (k (extract/cps (composem k* ...)) args ...))
    ;; short cut
    ((_ k args ...) (k args ...))))

多少無理やり感があるので(extract/cpsリテラルとか)もう少し綺麗にならないかと思ったりはするのだが、まぁとりあえずこんな感じでいいだろう。これを使って上記のassocm/cpsは以下のように書き換える。

(define-syntax assocm/cps
  (syntax-rules ()
    ((_ k key (alist ...))
     (letrec-syntax ((foo (syntax-rules (key)
                            ((_ (key . e) res (... ...)) 
                             (extract/cps k (key . e)))
                            ((_ (a . d) res (... ...)) (foo res (... ...))))))
       (foo alist ...)))))

さらにcarm/cpsとcdrm/cpsをこんな感じで定義して、最後のkをvaluesmとして定義しよう。CPSマクロの最後に展開されるマクロはCPSではないことに注意しよう。

(define-syntax cdrm/cps
  (syntax-rules ()
    ((_ k (a . d)) (extract/cps k d))))

(define-syntax carm/cps
  (syntax-rules ()
    ((_ k (a . d)) (extract/cps k a))))

(define-syntax valuesm
  (syntax-rules ()
    ((_ args) args)
    ;; this isn't really values...
    ((_ args ...) (args ...))))

こうするとassocmから見つかった値のcadr部分をとるマクロは以下のように書ける。

(assocm/cps (composem cdrm/cps carm/cps valuesm) c ((a b) (b d) (c d) (d d)))
;; -> 1

ちなみに、このコードGaucheでは(まだ)動かないので(すぐ直されると思うけど)、実際に動かしてみたい場合はSagittarius、Chibi、Larcenyのいずれかを使うといいだろう。

ちなみに、この手のコードは3日もすると自分でも理解不能になる危険を孕んでいるので使用する際は十分に留意した方がいいだろう。こういったマクロはだいたOleg氏がまとめているので、メタプログラミングの深淵を覗きたい方はそちらを参照されたい。この辺とか。