“JRM’s Syntax-rules Primer for the Merely Eccentric” メモ(番外)

読んでいるだけではつまらないので、 syntax-rules を実際に使ってみます。

単純な例で、“L.i.S.P”のサンプルに現れる define-class を考えます。

(define-class <name-of-the-class> <name-of-the-superclass>
       ( <name-of-a-Mono-Field>          |
         (= <name-of-a-Mono-Field>)      |
         (* <name-of-a-Poly-Field>)
         ... ) )

これをさらに単純化します。

(defclass <name-of-the-class> (<name-of-the-superclass> ...)
  (<name-of-slot> ...))

;; 例えば以下のように書くことができるようにします。
(defclass <continuation> () (k))
;;-> 展開形は Gauche の `define-class` に展開される以下を目指します。
(define-class <continuation> ()
  ((k :init-keyword (make-keyword (quote k)))))

最初に考えたのがこちら。省略記号の使い方が中途半端なもの。

(define-syntax defclass
  (syntax-rules ()
    ((_ e1 e2 slots)
     (%defclass-expand-slot slots () (e1 e2)))))

(define-syntax %defclass-expand-slot
  (syntax-rules ()
    ((_ () (xs ...) (e1 e2))
     (define-class e1 e2 (xs ...)))
    ((_ (x xs ...) (ys ...) e)
     (%defclass-expand-slot
      (xs ...) (ys ... (x :init-keyword (make-keyword 'x))) e))))

slots を一つずつ処理して ys にコードを貯めていく、ということです。

省略記号の使い方がわかっていなかった、ということがわかるコードになってしまっています。では、省略記号を使わなかったとしたら、ということを考えます。

(define-syntax defclass
  (syntax-rules ()
    ((_ e1 e2 slots)
     (%defclass-expand-slot slots () (e1 e2)))))

(define-syntax %defclass-expand-slot
  (syntax-rules ()
    ((_ () () ks (e1 e2))
     (define-class e1 e2 ks))
    ((_ () (y . ys) ks e)
     (%defclass-expand-slot () ys (y . ks) e))
    ;; 上は４つ
    ;; 下は３つ
    ((_ () () e)
     (%defclass-expand-slot () () () e))
    ((_ () (y . ys) e)
     (%defclass-expand-slot () ys (y) e))
    ((_ (x . xs) ys e)
     (%defclass-expand-slot xs ((x :init-keyword (make-keyword 'x)) . ys) e))))

slots を一旦全て処理します。 (slotname :init-keyword :slotname) というコードを貯めて行く、これが“下は３つ”の所でやっていることです。 slots の処理を終えたら、“上は４つ”に処理を移して、 ys を反転して ks を作ります。ここで、 ys の処理を終えたら (define-class ..) へ展開して終了します。

似たようなことを label をパターンに置く手法を使ってみます。

(define-syntax defclass
  (syntax-rules ()
    ((_ e1 e2 slots)
     (%defclass-expand-slot "collect" slots () (e1 e2)))))

(define-syntax %defclass-expand-slot
  (syntax-rules ()
    ((_ "emit" ks (e1 e2))
     (define-class e1 e2 ks))
    ((_ "reverse" () ks e)
     (%defclass-expand-slot "emit" ks e))
    ((_ "reverse" (y . ys) ks e)
     (%defclass-expand-slot "reverse"
                            ys
                            (y . ks)
                            e))
    ((_ "collect" () () e)
     (%defclass-expand-slot "emit" () e))
    ((_ "collect" () ys e)
     (%defclass-expand-slot "reverse" ys () e))
    ((_ "collect" (x . xs) ys e)
     (%defclass-expand-slot "collect"
                            xs
                            ((x :init-keyword (make-keyword 'x)) . ys)
                            e))))

やりたいことは、 slots を map したいだけなのにひどくめんどうなことになってしまっています。実はこれは省略記号を使うことで簡単、簡潔に実現できることがわかります。

(define-syntax defclass
  (syntax-rules ()
    ((_ e1 e2 (slot-name ...))
     (define-class e1 e2
       ((slot-name :init-keyword (make-keyword 'slot-name)) ...)))))

“JRM’s Syntax-rules Primer for the Merely Eccentric” のおかげで syntax-rules の使い方が少しずつですけれどもわかってきているような気がしています。