健全なマクロ展開 - syntax-rules (その 1)

現在の syntax-rules 規格は、 互換性がない R6RSSRFI 149 の 2 つが存在しています。 互換性が崩れている箇所は、 パターンとテンプレートで省略記号 (3 ドット) の段数に違いがあるときの扱いです。 違いが現れる典型的なマクロは、 パターン変数 a の入れ子が 1 段で b が 2 段のパターンに対して、 テンプレートで両方が 2 段になっているものです。

(define-syntax exam
 (syntax-rules ()
  ((_ ((a b ...) ...))
   '(((a b) ...) ...))))

R6RS は、 これを次のように扱います。 テンプレートの外と中の両方の map で a と b を繰り返します。 扱い方をわかりやすくするため、 パターン変数に段数をつけて、 1 段 の a を a1、 2 段の b を b2 としましょう。 これを map すると段数が 1 段減り、 a0 と b1 になります。 さらに map するとき a は既に a0 になっていて段数が足りないので、 もう一つ外の a1 を引っ張り出してきます。

; R6RS
(define-syntax exam
 (er-macro-transformer
  (lambda (x r c)
   (let ((a1 (map car (cadr x)))
         (b2 (map cdr (cadr x))))
    `(,(r 'quote) ,(map (lambda (a0 b1) (map (lambda (a0 b0) `(,a0 ,b0)) a1 b1)) a1 b2))))))
; (exam ((x 1 2 3) (y 4 5 6) (z 7 8 9)))
; => '(((x 1) (y 2) (z 3)) ((x 4) (y 5) (z 6)) ((x 7) (y 8) (z 9)))

SRFI 149 では、 中の段数が足りない a は、 a0 になった外側の値を使い、 中の map では b1 のみを繰り返します。

; SRFI 149
(define-syntax exam
 (er-macro-transformer
  (lambda (x r c)
   (let ((a1 (map car (cadr x)))
         (b2 (map cdr (cadr x))))
    `(,(r 'quote) ,(map (lambda (a0 b1) (map (lambda (b0) `(,a0 ,b0)) b1)) a1 b2))))))
; (exam ((x 1 2 3) (y 4 5 6) (z 7 8 9))))
; => '(((x 1) (x 2) (x 3)) ((y 4) (y 5) (y 6)) ((z 7) (z 8) (z 9)))

上のように syntax-rules からコードへ変換する場合、 SRFI 149 の方が簡単です。 パターン変数 a と b から段数を消してもα等価だからです。 R6RS の方は、 パターン変数の段数を消すことができません。 なので、 R6RS で syntax-rules を変換するとき、 変換時環境を作ったパターン変数のシンボル置換が必須です。

ということで、 作るのは SRFI 149 の方とします。

R5RS までの syntax-rules のパターンでは、 省略記号 (3 ドット) は正規リストの末尾にしか導出できませんでした。 一方、 R6RS 以降の syntax-rules のパターンは、 正規リストおよびドッテッド・リストの両方の途中に導出可能です。 ただし、 導出回数はリスト階層につき 1 回に限ります。 途中に導出できるといっても、 R6RS と R7RS は貪欲マッチングでリストを可能な限り伸ばせば良いだけなので、 扱いは楽です。 正規表現のクリーネ閉包の扱いは不要です*1

(syntax-rules ()
 ((_ a b ... c d) '(proper-list a (b ...) c d))
 ((_ a b ... c . d) '(dotted-list a (b ...) c d)))

ところで、 SRFI 149 のサンプル実装の syntax-rules の途中の省略記号 (3 ドット) の処理は独特で、 パターンとマッチング対象式の両方のリストを切り貼りして、 省略記号 (3 ドット) をリストの末尾へ移動してから、 マッチングをおこなっています。 その方式では、 何かうまく動かないときにデバッグするのが大変そうなので、 ここでは別のやりかたを試みます。 貪欲マッチングで良いということは、 パターンの 3 点ドットの後のリストのペア数で drop-right したものを省略記号付きサブパターンで使い、 take-right したものをサブパターンの後でマッチングすれば良いでしょう。

(define (so-drop-right x i)
 (so-split-at-right* x i (lambda (lhs rhs) lhs)))

(define (so-take-right x i)
 (so-split-at-right* x i (lambda (lhs rhs) rhs)))

(define so-split-at-right*
 (let ((memo (vector #f #f #f #f)))
  (define (split-at-right x i k)
   (let ((c (- (so-length* x) i)))
    (and (>= c 0)
     (do ((lhs '() (cons (so-car rhs) lhs)) (rhs x (so-cdr rhs))
          (c c (- c 1)))
         ((<= c 0) (k (reverse lhs) rhs))))))
  (define (memorized x i k)
   (if (and (eq? (vector-ref memo 0) x) (eq? (vector-ref memo 1) i))
    (k (vector-ref memo 2) (vector-ref memo 3))
    (split-at-right x i (lambda (lhs rhs)
     (vector-set! memo 0 x) (vector-set! memo 1 i) (vector-set! memo 2 lhs) (vector-set! memo 3 rhs)
     (k lhs rhs)))))
  memorized))

構文オブジェクトは処理コストが高いことと、 テンプレートで drop-right と take-right を同じリストに対して何度も使うことがあるので、 コンパイラの最適化をあてにせず so-split-at-right* はメモ化してあります。 使い終わったメモはマクロ変換手続きで空リストを空読みすることで消去します。 まともなコンパイラなら、 so-split-at-right* に set! が含まれているので副作用のある手続き扱いになり、 最適化で空読みの摘要を除去せずに残すはずです。 なお、 しっかり最適化をおこなうコンパイラなら、 メモ化をしない split-at-right のままの方が、 インライン展開後に共通式をくくりだして何度も繰り返し摘要をしないよう最適化してくれて、 メモ化するよりも高速に処理するコードを生成してくれるはずです。

(lambda (x e d) ((lambda (x1) (so-take-right '() 0) x1) (proc x e d)))

so-length* は正規リストとドッテッド・リストの両方に対応し、 ペアの個数を求めます。 当初、 unwrap-syntax を使う car、 cdr 等で記述していたのですが、 unwrap-syntax は新しいペアを作って返すので循環参照チェックが働くはずがありません。 strip-syntax も同様の問題があるので、 やはり循環参照のチェックには使えません。 そこで、 構文オブジェクトの式をとりだす循環参照チェック専用の strip を利用するように書き直しました。

(define (so-length* x)
 (define (strip x)
  (if (so-syntax-object? x) (strip (so-syntax-object-expr x)) x))
 (if (not (pair? (strip x)))
  0
  (let loop ((x x) (xx (cdr (strip x))) (c 1))
   (cond
    ((eq? (strip x) (strip xx)) (error "cyclic list"))
    ((and (pair? (strip xx)) (pair? (strip (cdr (strip xx)))))
     (loop (cdr (strip x)) (cdr (strip (cdr (strip xx)))) (+ c 2)))
    (else (if (pair? (strip xx)) (+ c 1) c))))))

これらを使って、 次のようなコードが得られることを目標にします。 なお、 if 構文の条件節の入れ子の if 構文は and 構文を展開したものです。

; (syntax-rules () ((_ a b ... c d) (_ a (b ...) c d))):M1
(lambda (x.1 e.1 d.1)
 ((lambda (x.2) (so-take-right '() 0) x.2)
  (if (if (so-pair? x.1)
      (if (so-pair? (so-cdr x.1))
      (so-split-at-right* (so-cddr x.1) 2 (lambda (x1.3 x2.3)
      (if (so-pair? x2.3)
      (if (so-pair? (so-cdr x2.3))
      (so-null? (so-cddr x2.3)) #f) #f))) #f) #f)
   ((lambda (a.4 b.4 c.4 d.4)
     (list (so-env-rename-syntax d.1 (syntax-quote '_:M1)) a.4 b.4 c.4 d.4))
    (so-cadr x.1)
    (so-drop-right (so-cddr x.1) 2)
    (so-car (so-take-right (so-cddr x.1) 2))
    (so-cadr (so-take-right (so-cddr x.1) 2)))
   (error "no matching" (so-strip-syntax x.1)))))

同様に or 構文の変換目標も考えておきます。

; (syntax-rules ()
;  ((or) #f)
;  ((or e1) e1)
;  ((or e1 e2 ...) (let ((t e1)) (if t t (or e2 ...))))):M1
(lambda (x.1 e.1 d.1)
 ((lambda (x.2) (so-take-right '() 0) x.2)
  (if (if (so-pair? x.1)
      (so-null? (so-cdr x.1)) #f)
   ((lambda () '#f))
  (if (if (so-pair? x.1)
      (if (so-pair? (so-cdr x.1))
      (so-null? (so-cddr x.1)) #f) #f)
   ((lambda (e1.3) e1) (so-cadr x.3))
  (if (if (so-pair? x.1)
      (if (so-pair? (so-cdr x.1))
      (so-split-at-right* (so-cddr x.1) 0 (lambda (x1.4 x2.4)
      (so-null? x2.4))) #f) #f)
   ((lambda (e1.5 e2.5)
     (list (so-env-rename-syntax d.1 (syntax-quote 'let:M1))
      (list (list (so-env-rename-syntax d.1 (syntax-quote 't:M1)) e1.5))
       (list (so-env-rename-syntax d.1 (syntax-quote 'if:M1))
             (so-env-rename-syntax d.1 (syntax-quote 't:M1))
             (so-env-rename-syntax d.1 (syntax-quote 't:M1))
        (cons* (so-env-rename-syntax d.1 (syntax-quote 'or:M1)) e2.5))))
    (so-cadr x.1)
    (so-cddr x.1))
   (error "no matching" (so-strip-syntax x.1)))))))

これらの例で使っている、 syntax-quote 構文はコアの特殊形式で、 so-strip-syntax しないクォート構文です。 これで、 syntax-rules マクロから低レベル・マクロへ変換してもシンボルの意味を損なわずにすみます。

(define (so-expand-special denotation form env)
 (let ((keyword (so-special-name denotation)))
  (case keyword
   ((quote) (list 'quote (so-strip-syntax (so-cadr form))))
   ((syntax-quote) (list 'quote (so-cadr form)))
   ((lambda) (so-expand-lambda form env))
   ((let-syntax) (so-expand-let-syntax form env))
   ((letrec-syntax) (so-expand-letrec-syntax form env))
   ((if set! begin) (cons keyword (so-expand-list (so-cdr form) env)))
   (else (error "so-expand unknown special form" keyword)))))

so-env-rename-syntax 手続きは、 syntax-rules マクロの定義時の意味で識別子を扱えるようにします。 syntax-rules マクロで展開したときに、 展開器が空フレームで拡張した定義時構文環境を変換結果の式にくっつけようとします。 構文オブジェクトのままだとくっつけられないので、 シンボルに変換しておかないといけません。 そのため、 この手続きは識別子を展開したシンボルを返します。 このシンボルは定義時構文環境中で、 識別子と同じ意味を必ずもつことが保証できます。

(define (so-env-rename-syntax defined-env id)
 (so-expand-form id defined-env))

*1:R7RS にはクリーネ閉包のようにふるまうことを期待しているかのような例が記載されていますが、 その前のセマンティクス定義で貪欲マッチングすると定義されています。