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

構文環境をくっつけてある式を展開する so-expand-form は Clinger-Rees のものと同じです。 Hieb-Dybvig の方がチェックが厳しく作ってあって、 ペアの構文オブジェクトか識別子でないときは、 空リストか、 定数であることをチェックします。

(define (so-expand-form form)
 (cond
  ((so-identifier? form)
   (let ((d (so-lookup form)))
    (cond
     ((so-subst? d) (so-subst-name d))
     ((so-special? d) (so-special-name d))
     ((so-macro? d) (so-expand-macro (so-macro-proc d) form))
     (else (error "so-expand-form id cannot happen")))))
  ((and (so-syntax-pair? form) (so-identifier? (so-syntax-car form)))
   (let ((d (so-lookup (so-syntax-car form))))
    (cond
     ((so-subst? d) (cons (so-subst-name d) (so-expand-list (so-syntax-cdr form))))
     ((so-special? d) (so-expand-special (so-special-name d) form))
     ((so-macro? d) (so-expand-macro (so-macro-proc d) form)))))
  ((so-syntax-pair? form) (so-expand-list form))
  ((so-syntax-null? form) '())
  (else
   (let ((datum (so-strip-syntax form)))
    (if (so-self-evaluating? datum)
     datum
     (error "invalid syntax" datum))))))

マクロの展開は、 so-join-wrap で説明したように、 変換の前後で新しい変換世代マークをくっつけます。

(define (so-expand-macro proc form)
 (let ((mark (make-so-mark)))
  (so-expand-form (so-add-mark mark (proc (so-add-mark mark form))))))

リストの展開では、 この展開器ではドッテッド・リストも許しています。 これは、 まじめにすべてのマクロを記述するのが大変なので、 一部をホスト環境のマクロに肩代わりさせてるためで、 マクロ展開をすべて展開器でおこなうなら、 正規リストしか許さないようにしておくべきでしょう。

(define (so-expand-list form)
 (so-syntax-map* so-expand-form so-expand-form form))

特殊形式の展開では、 quote 構文は構文情報を削って、 syntax-quote は構文情報を残したままにします。 if 構文、 set! 構文、 begin 構文は手抜きでリストの展開でごまかします。 Hieb-Dybvig の syntax-case は、 展開器は構文チェックと意味チェックを備えておくべきとのDybvig 先生の信念に従って、 厳密なチェックを組み込んであり、 マクロ変換でもチェックできるように仕掛けを盛り込めるようになっています。 この展開器は、 そこはザルも良いところで、 構文チェックと意味チェックはコンパイラに丸投げして、 健全なマクロ展開だけをおこないます。

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

λ構文の展開はドッテッド・リストの変数リストを扱う煩雑さを除くと、やっていることは単純です。 新しい束縛変数を作成し、 識別子から変数への置換規則を構文環境に登録して、 本体の展開に取りかかります。

(define (so-expand-lambda form)
 (if (so-lambda-validate form)
  (let* ((uid (so-generate-uid))
         (gen-var (lambda (id) (if (so-identifier? id) (so-gen-var id uid) '())))
         (bind (lambda (id x.i) (so-bind-id-denotation id (make-so-subst x.i))))
         (tail-bind (lambda (id x.i) (if (so-syntax-null? id) '() (list (bind id x.i)))))
         (vars (so-syntax-map* gen-var gen-var (so-syntax-cadr form)))
         (env (make-so-env (so-syntax-map* bind tail-bind (so-syntax-cadr form) vars))))
   (cons* 'lambda vars (so-expand-list (so-extend-env env (so-syntax-cddr form)))))
  (error "so-expand invalid lambda form")))

λ構文のチェックは、 簡略版パターン・マッチング述語を使うように変更しました。

(define (so-lambda-validate form)
 (and (so-syntax-match? form '(lambda vars body _ ...))
  (so-syntax-every* so-identifier?
   (lambda (x) (or (so-syntax-null? x) (so-identifier? x)))
   (so-syntax-cadr form))))

このパターン・マッチング述語はパターン変数に値を取得せずに、 リストの形が同じかどうかだけを調べます。

(define (so-syntax-match? form pattern)
 (cond
  ((null? pattern) (so-syntax-null? form))
  ((and (pair? pattern) (pair? (cdr pattern)) (eq? (cadr pattern) '...))
   (so-syntax-every* (lambda (x) (so-syntax-match? x (car pattern)))
                     (lambda (x) (so-syntax-match? x (cddr pattern))) form))
  ((pair? pattern) (and (so-syntax-pair? form)
    (so-syntax-match? (so-syntax-car form) (car pattern))
    (so-syntax-match? (so-syntax-cdr form) (cdr pattern))))
  (else #t)))

let-syntax 構文の展開は、 構文束縛リストのマクロ定義をそのまま展開して評価しマクロ手続きにします。 構文束縛リストのキーワードもそのまま識別子のままで、 キーワードとマクロ変換子の意味束縛を作り、 構文環境を拡張します。 そして、 拡張した構文環境で let-syntax 構文の本体を展開します。 マクロ手続きに含まれるリテラル識別子の構文環境は、 let-syntax で拡張されていない一つ外側の構文環境になっています。 構文束縛のキーワード識別子の構文環境も同じです。

(define (so-expand-let-syntax form)
 (if (so-let-validate form)
  (let ((keywords (so-syntax-map so-syntax-car (so-syntax-cadr form)))
        (body (so-syntax-cddr form)))
  (let ((env (make-so-env '())))
   (so-env-set! env (so-bind-let-syntax keywords (so-syntax-map so-syntax-cadr (so-syntax-cadr form))))
   (if (so-syntax-null? (so-syntax-cdr body))
    (so-expand-form (so-extend-env env (so-syntax-car body)))
    (cons 'begin (so-expand-list (so-extend-env env body))))))
  (error "invalid let-syntax")))

(define (so-bind-let-syntax keywords forms)
 (map (lambda (keyword form) (so-bind-id-denotation keyword (so-close-macro form)))
  keywords forms))

それに対して、 letrec-syntax 構文では、 マクロ定義の展開を拡張した構文環境でおこないます。 その際、 ダミーの構文フレームで展開します。 そして、 マクロ手続きを作成した後に、 キーワードとマクロ手続きの意味束縛から構文フレームを作り直します。 構文束縛のキーワード識別子では、 let-syntax と同じで拡張する前の構文環境を使います。

(define (so-expand-letrec-syntax form)
 (if (so-let-validate form)
  (let ((keywords (so-syntax-map so-syntax-car (so-syntax-cadr form)))
        (body (so-syntax-cddr form)))
  (let ((env (make-so-env '())))
   (so-env-set! env (so-dummy-letrec-syntax keywords))
   (so-env-set! env (so-bind-let-syntax keywords
    (so-syntax-map (lambda (x) (so-extend-env env (so-syntax-cadr x))) (so-syntax-cadr form))))
   (if (so-syntax-null? (so-syntax-cdr body))
    (so-expand-form (so-extend-env env (so-syntax-car body)))
    (cons 'begin (so-expand-list (so-extend-env env body))))))
  (error "invalid letrec-syntax")))

(define (so-macro-unspecified x)
 (error "letrec-syntax unspecified macro"))

(define (so-dummy-letrec-syntax keywords)
 (map (lambda (keyword) (so-bind-id-denotation keyword (make-so-macro so-macro-unspecified)))
      keywords))

let 系統の構文チェックも簡略版パターン・マッチング述語を使って、 リストの形を調べた上で、 束縛リストの先頭が識別子であることをチェックします。

(define (so-let-validate x)
 (and (so-syntax-match? x '(let ((x a) ...) body _ ...))
  (so-syntax-every (lambda (x) (so-identifier? (so-syntax-car x))) (so-syntax-cadr x))))

この展開器では、 構文環境をくっつけたリテラル識別子をマクロ手続きに含める必要があるため、 マクロ定義式を必ず展開しなければなりません。 展開しなくても良いマクロ手続きは、 上のダミー手続きのようにリテラル識別子を使わないものに限ります。 通常のマクロ手続きは、 変換結果にリテラル識別子を使うでしょうから、 展開は必須です。

(define so-macro-proc-environment (interaction-environment))

(define (so-close-macro form)
 (let ((proc (so-eval-macro-form form)))
  (if (and (procedure? proc) (eqv? (arity proc) 1))
   (make-so-macro proc)
   (error "macro must be procedure x->x" proc))))

(define (so-eval-macro-form form)
 (eval (so-expand-form form) so-macro-proc-environment))

構文オブジェクトのリスト操作のために、 最小限の手続きを揃えておきます。

(define (so-syntax-null? x) (null? (so-unwrap-syntax x)))
(define (so-syntax-pair? x) (pair? (so-unwrap-syntax x)))
(define (so-syntax-car x) (car (so-unwrap-syntax x)))
(define (so-syntax-cdr x) (cdr (so-unwrap-syntax x)))
(define (so-syntax-cadr x) (car (so-unwrap-syntax (so-syntax-cdr x))))
(define (so-syntax-cddr x) (cdr (so-unwrap-syntax (so-syntax-cdr x))))
(define (so-syntax-caddr x) (car (so-unwrap-syntax (so-syntax-cddr x))))
(define (so-syntax-cdddr x) (cdr (so-unwrap-syntax (so-syntax-cddr x))))
(define (so-syntax-cadddr x) (car (so-unwrap-syntax (so-syntax-cdddr x))))
(define (so-syntax-cddddr x) (cdr (so-unwrap-syntax (so-syntax-cdddr x))))

(define (so-syntax-map* f g . args)
 (let vamap* ((args args))
  (cond
   ((every so-syntax-pair? args)
    (cons (apply f (map so-syntax-car args)) (vamap* (map so-syntax-cdr args))))
   (else (apply g args)))))

(define (so-syntax-map f . args)
 (let vamap ((args args))
  (cond
   ((every so-syntax-pair? args)
    (cons (apply f (map so-syntax-car args)) (vamap (map so-syntax-cdr args))))
   ((every so-syntax-null? args) '())
   (else "so-syntax-map improper list"))))

(define (so-syntax-every* f g x)
 (if (so-syntax-pair? x)
  (and (f (so-syntax-car x)) (so-syntax-every* f g (so-syntax-cdr x)))
  (g x)))

(define (so-syntax-every f x) (so-syntax-every* f so-syntax-null? x))

(define (so-syntax-fold-right f i x)
 (if (so-syntax-pair? x)
  (f (so-syntax-car x) (so-fold-right f i (so-syntax-cdr x)))
  i))

例えば、 cond 構文のマクロで else キーワードかどうかを判定するときに使うため、 2 つの識別子が同じ意味を持つかどうかを調べる述語を用意します。 なお、 この展開器は so-lookup が意味束縛を見つけられなかったとき、 新しく変数置換規則を作成して返すようにしています。 そのため、 eq? だけでなく、 同じシンボルへの変数置換かどうかも調べています。

(define (so-free-identifier=? id1 id2)
 (and (so-identifier? id1) (so-identifier? id2)
  (let ((d1 (so-lookup id1)) (d2 (so-lookup id2)))
   (or (eq? d1 d2)
       (and (so-subst? d1) (so-subst? d2)
        (eq? (so-subst-name d1) (so-subst-name d2)))))))

例えば、 let 構文のマクロで、 変数がすべて異なる識別子であるかどうかを判定するため、 2つの識別子の同一性を調べる述語を用意します。 ここで、 識別子の同一性とは、 so-lookup が意味束縛のキーとして、 2 つを同じキーとして扱えるかどうかということです。 なので、 同じシンボルと同じマーク・リストを持つ識別子を同一とみなします。

(define (so-bound-identifier=? id1 id2)
 (and (so-identifier? id1) (so-identifier? id2)
  (eq? (so-syntax-object-form id1) (so-syntax-object-form id2))
  (so-same-mark?
   (so-wrap-mark* (so-syntax-object-wrap id1))
   (so-wrap-mark* (so-syntax-object-wrap id2)))))

構文環境のくっついていない式に、 構文環境をくっつけます。 構文環境は、 識別子からとってくることにします。 逆に、 構文環境を取り除いた式に戻す手続きも作っておきます。

(define (so-datum->syntax template-id x)
 (make-so-syntax-object x (so-syntax-object-wrap template-id)))

(define so-syntax->datum so-strip-syntax)

展開をおこなうときも構文環境をくっつけた識別子を指定することにします。 コアの構文環境を持つ識別子に特殊形式を登録し、 トップ・マークを底に置きます。 特殊形式のマーク・リストはトップ・マーク一個のリストにします。

(define (so-core-syntax-object)
 (let ((id (make-so-syntax-object 'core (list (make-so-env '()) top-mark))))
  (so-define-special id 'quote)
  (so-define-special id 'syntax-quote)
  (so-define-special id 'lambda)
  (so-define-special id 'let-syntax)
  (so-define-special id 'letrec-syntax)
  (so-define-special id 'if)
  (so-define-special id 'begin)
  (so-define-special id 'set!)
  id))

特殊形式の登録では、 テンプレート識別子の構文環境を破壊操作して、 意味定義を登録することにします。

(define (so-define-special template-id keyword)
 (so-define template-id keyword (make-so-special keyword)))

(define (so-define template-id keyword denotation)
 (let ((wrap (so-syntax-object-wrap template-id)))
  (so-env-set! (car wrap)
   (cons (so-bind-id-denotation (so-extend-wrap wrap keyword) denotation)
    (so-env-ref (car wrap))))))

マクロもテンプレート識別子に破壊操作して登録できるようにしておきます。

(define (so-define-syntax template-id keyword form)
 (so-define template-id keyword
  (so-close-macro (so-datum->syntax template-id form))))

これで、 最小限の仕組みができあがりました。

(define (so-expand x template-id)
 (so-expand-form (so-datum->syntax template-id x)))

この段階で、 いつもの式の展開を試します。 let 構文を定義し、 それを使って、 or 構文の定義それ自体を展開してから or マクロ手続きを作成します。 そして、 or 構文を使って、 いつもの式を展開します。

(define (demo1)
 (so-expand
  '(let-syntax
    ((let (lambda (x)
      (if (so-let-validate x)
       ((lambda (vars args body)
         (cons (cons* (syntax-quote lambda) vars body) args))
        (so-syntax-map so-syntax-car (so-syntax-cadr x))
        (so-syntax-map so-syntax-cadr (so-syntax-cadr x))
        (so-syntax-cddr x))
      (error "invalid let" (so-syntax->datum x))))))
    (letrec-syntax
     ((or (lambda (x)
       (if (so-syntax-match? x '(_)) #f
       (if (so-syntax-match? x '(_ e1)) (so-syntax-cadr x)
       (if (so-syntax-match? x '(_ e1 e2 ...))
        (let ((e1 (so-syntax-cadr x)) (e2 (so-syntax-cddr x)))
         (list (syntax-quote let) (list (list (syntax-quote t) e1))
          (list (syntax-quote if) (syntax-quote t) (syntax-quote t)
           (cons (syntax-quote or) e2))))
       ;else
        (error "no matching" (so-syntax->datum x))))))))
     ((lambda (x) (let ((if list) (t x)) (or 1 t))) 2)))
  (so-core-syntax-object)))