健全なマクロ展開 - 構文オブジェクト (その9)

これまで書いてきた展開器を流用しつつ、 Hieb-Dybvig を参考にした展開器を書いてみます。 Gauche 0.95 で動くことを目標にします。 以下、 Beutiful Code 25 章の Dybvig 「構造の抽象化: syntax-case マクロ」(英語版 PDF) と照らし合わせることを考慮し、 対応するコードをなるべく同じ順に並べておきます。

Gist so-expand.scm

これまでの展開器は構文オブジェクトの構文環境から意味束縛を直接参照しており、 今回の展開器も同様に直接参照とします。 一方、 Hieb-Dybvig の syntax-case 展開器は、 構文オブジェクトの構文環境から意味束縛へはシンボリック・リンクによる間接参照を採用している違いがあります。 構文オブジェクトは 2 つのスロットがある構造体です。 form スロットと wrap スロットを持ちます。 form スロットを展開対象式に束縛します。 wrap スロットを構文環境に束縛します。

(define (make-so-syntax-object form wrap) (vector 'so-syntax-object form wrap))
(define so-syntax-object? (so-vector-record-type? 'so-syntax-object 3))
(define (so-syntax-object-form x) (vector-ref x 1))
(define (so-syntax-object-wrap x) (vector-ref x 2))

構文オブジェクトかどうかを判定する述語を補助手続きで作成します。 構造体はベクタであり、 先頭要素を型タグにしています。 型タグと長さの両方が一致すると、 述語が真を返す手続きを作ります。

(define (so-vector-record-type? type len)
 (lambda (x)
  (and (vector? x) (= (vector-length x) len) (eq? (vector-ref x 0) type))))

構文環境はリストです。 リストに、 変換世代マークと環境フレームの 2 種類を並べます。 マーク同士は eq? で同一性を判定できれば良く、 スロットのない構造体にします。

(define (make-so-mark) (vector 'so-mark))
(define so-mark? (so-vector-record-type? 'so-mark 1))

環境フレームには dict スロットがあり、 意味束縛のリストへ束縛します。 letrec-syntax の循環参照を作るには、 構文環境から意味束縛へ直接参照しているので、 どこかで代入しなければなりません。 dict スロットへの代入が最もてっとり早いので、 このスロットへの代入メソッドを設けておきます。

(define (make-so-env dict) (vector 'so-env dict))
(define so-env? (so-vector-record-type? 'so-env 2))
(define (so-env-ref x) (vector-ref x 1))
(define (so-env-set! x y) (vector-set! x 1 y))

意味束縛のキーは、 シンボルとマーク・リストの組です。 シンボルとマーク・リストをそれぞれのスロットへ分けます。 値のスロットも加えて、 3 つのスロットを持つ構造体とします。 sym スロットがキーのシンボル部分、 mark* スロットがキーのマーク・リスト部分、 denotation スロットが値部分です。

; キー:マーク:マーク…:マーク ⇒ 意味
(define (make-so-binding sym mark* denotation) (vector 'so-binding sym mark* denotation))
(define so-binding? (so-vector-record-type? 'so-binding 4))
(define (so-binding-sym x) (vector-ref x 1))
(define (so-binding-mark* x) (vector-ref x 2))
(define (so-binding-denotation x) (vector-ref x 3))

意味を表すものは、 相変わらず 3 つです。 λ構文の変数置換規則、 特殊形式、 マクロ変換子の3種類です。 なお、 これまでの展開器では、 これらはリストの構造体でしたが、 ベクタの構造体に変更しました。

(define (make-so-subst name) (vector 'so-subst name))
(define so-subst? (so-vector-record-type? 'so-subst 2))
(define (so-subst-name x) (vector-ref x 1))
(define (make-so-special name) (vector 'so-special name))
(define so-special? (so-vector-record-type? 'so-special 2))
(define (so-special-name x) (vector-ref x 1))
(define (make-so-macro proc) (vector 'so-macro proc))
(define so-macro? (so-vector-record-type? 'so-macro 2))
(define (so-macro-proc x) (vector-ref x 1))

展開器が新しい変数シンボルを作るとき、 まずユニークな番号を so-generate-uid で生成し、それを使って so-gen-var でシンボルを作ります。 この部分は、 これまでの展開器と同じで、 再掲になります。

(define so-unique-id-counter 0)

(define (so-generate-uid)
 (set! so-unique-id-counter (+ so-unique-id-counter 1))
 so-unique-id-counter)

(define (so-gen-var id uid)
 (string->symbol
  (string-append
   (symbol->string (so-syntax-object-form id)) "." (number->string uid))))

(define (so-reset-unique-id-counter) (set! so-unique-id-counter 0))

quote 構文の展開と、 エラー出力のために、 構文情報を削ります。 この展開器では、 クォートするときに構文情報を削る quote 構文と、 削らない syntax-quote 構文を使い分けます。 そのため、 strip は、 すべての構文情報を削り落とします。 さらに、 すべての構文情報を削ることでエラー出力に構文情報が混じり煩雑な出力になるのを避けることができます。

(define (so-strip-syntax x)
 (cond
  ((so-syntax-object? x) (so-strip-syntax (so-syntax-object-form x)))
  ((pair? x)
   (let ((a (so-strip-syntax (car x))) (b (so-strip-syntax (cdr x))))
    (if (and (eq? a (car x)) (eq? b (cdr x))) x (cons a b))))
  (else x)))

リスト操作用に、 識別子は構文オブジェクトのまま、 ペアは car と cdr に構文環境を連結した構文オブジェクトのペアに作り直します。

(define (so-unwrap-syntax form)
 (if (so-syntax-object? form)
  (let ((x (so-syntax-object-form form))
        (w (so-syntax-object-wrap form)))
   (cond
    ((symbol? x) form)
    ((pair? x) (cons (so-extend-wrap w (car x)) (so-extend-wrap w (cdr x))))
    ((so-syntax-object? x) (so-unwrap-syntax (so-extend-wrap w x)))
    (else x)))
  form))

展開前を表すマークを top-mark として、 他の変換世代を表すマークとは区別します。 top-mark は、 lambda 構文のキーワードである識別子にも使い、 特殊形式を定義するコア構文環境の底に配置します。 その 8 までの展開状況の記述では M0 と書いていたものが top-mark です。

; 展開前世代を表す M0 マーク
(define top-mark (make-so-mark))

識別子を、 シンボルの構文オブジェクトであることと定めます。 ここが Hanson-Bawden の識別子とは違います。 Hanson-Bawden は識別子の構文クロージャも識別子で、 入れ子の構文クロージャを識別子に使うことも許していました。 一方、 Hieb-Dybvig は入れ子の構文オブジェクトを識別子とはみなしません。

(define (so-identifier? x)
 (and (so-syntax-object? x) (symbol? (so-syntax-object-form x))))

構文オブジェクトを除去した残りが定数のとき、 それ自体を展開結果として返すように展開器を書きます。

(define (so-self-expanding? x)
 (or (boolean? x) (number? x) (char? x) (string? x)))

so-add-mark は、 構文環境にマークを追加した構文オブジェクトを作って返します。

(define (so-add-mark mark synobj)
 (so-extend-wrap (list mark) synobj))

so-bind-id-denotation は、 構文環境フレームに意味束縛を追加した構文環境フレームを作って返します。

(define (so-bind-id-denotation id denotation)
 (let ((sym (so-syntax-object-form id))
       (mark* (so-wrap-mark* (so-syntax-object-wrap id))))
  (make-so-binding sym mark* denotation)))

展開対象式は、 構文オブジェクトか、 構文オブジェクトになっていない式のどれかです。 構文オブジェクトに構文環境をくっつけるときは、 既にくっつけてある構文環境を拡張した構文オブジェクトを作ります。 構文オブジェクトではない式にくっつけるときは、 新しく構文オブジェクトを作ります。

(define (so-extend-wrap wrap x)
 (if (so-syntax-object? x)
  (make-so-syntax-object
   (so-syntax-object-form x)
   (so-join-wrap wrap (so-syntax-object-wrap x)))
  (make-so-syntax-object x wrap)))

2 つの構文環境を連結するとき、 append 手続きと同様に、 拡張したい方を左側、 拡張されたい方を右側とします。 さて、 マクロ変換子が新しく挿入した識別子に新しい変換世代マークをくっつけたいわけです。 これを Hieb-Dybvig は、 次の手順でおこないます。 マクロ変換前に、 まず新しいマークを作成します。 このマークを変換前の式に、 つまり既存の識別子にくっつけてマクロ変換手続きを呼びます。 マクロ変換手続きの変換結果では、 既存の識別子にはマークがくっついていて、 マクロ変換手続きが挿入した識別子にはマークがくっついていません。 そこで、 もう一度、 展開器が同じ新しい変換世代マークを変換結果にくっつけます。 構文環境を連結するとき、 同じマーク同士は打ち消しあって連結後に消えるようにします。 こうすることで、 変換前からある識別子からは新しいマークが消えて、 変換結果に挿入された識別子に新しいマークがくっつきます。

; (use srfi-1)
(define (so-join-wrap wrap1 wrap2)
 (cond
  ((null? wrap2) wrap1)
  ((null? wrap1) wrap2)
  (else
   (let ((wrap1 (reverse wrap1)))
    (if (eq? (car wrap1) (car wrap2))
     (fold cons (cdr wrap2) (cdr wrap1))
     (fold cons wrap2 wrap1))))))

so-extend-env は、 構文環境に構文環境フレーム env を追加した構文オブジェクトを作って返します。 この展開器では、 構文環境のすべてが構文オブジェクトの中に入っています。

(define (so-extend-env env synobj)
 (so-extend-wrap (list env) synobj))

識別子の意味束縛は、 識別子である構文オブジェクトでくっつけてある構文環境から探しだします。 これの手順は、 まず、 構文環境からマークを抜き出したリストを作ることから始まります。 次に、 シンボルとマーク・リストをキーとして構文環境から、 このキーに一致する意味束縛を探します。 その際、 マークに出会うと、 そのマークをキーのマーク・リストから消して探索を続けます。 これにより、 変換前から割り当ててある意味も探し出せることになります。 この展開器では、 意味束縛が見つからなかったときは、 変数置換規則を返すようにしています。 ちなみに、 Dybvig の syntax-case では、 すべての組み込みシンボルの変数置換規則を展開器の構文環境に書き込んでおいて、 意味束縛が見つからないときはエラーを発する厳密な動作になっています。

(define (so-lookup id)
 (let ((sym (so-syntax-object-form id))
       (wrap (so-syntax-object-wrap id)))
  (let loop-wrap ((wrap wrap) (mark* (so-wrap-mark* wrap)))
   (cond
    ((null? wrap) (make-so-subst sym))
    ((so-mark? (car wrap)) (loop-wrap (cdr wrap) (cdr mark*)))
    ((so-env? (car wrap))
     (let loop-env ((env (so-env-ref (car wrap))))
      (cond
       ((null? env) (loop-wrap (cdr wrap) mark*))
       ((so-bound? sym mark* (car env)) (so-binding-denotation (car env)))
       (else (loop-env (cdr env))))))
    (else (error "so-lookup cannot happen"))))))

構文環境からマークを抜き出すには filter を使います。

(define (so-wrap-mark* env)
 (filter so-mark? env))

意味束縛のキーはシンボルとマーク・リストの組です。 両方とも一致する意味束縛を求めます。

(define (so-bound? sym mark* binding)
 (and (eq? sym (so-binding-sym binding))
      (so-same-mark? mark* (so-binding-mark* binding))))

マーク・リストの同一性を調べるのに every を使ってはいけません。 リストの末尾まですべて一致することをチェックします。

; (every '(M3 M2 M1) '(M3 M2)) => #t なので、 every は使えません。
(define (so-same-mark? m1* m2*)
 (if (pair? m1*)
  (and (pair? m2*) (eq? (car m1*) (car m2*)) (so-same-mark? (cdr m1*) (cdr m2*)))
  (null? m2*)))

「健全なマクロ展開 - 構文オブジェクト (その10) 」へ続く。