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

Hanson-Bawden 展開器を元に、 別名を構文オブジェクトへ置き換えて低レベル・マクロ展開器を作っていきます。

マクロ変換ごとに挿入されていくシンボルの変換世代を自動的に区別する目的で、 今度の展開器は展開前の展開対象式のシンボルにも変換世代マークを付けておきます。 ただし、 シンボルにいちいちマークを付けると効率が悪いので、シンボルを含むリスト全体に世代マークを付けることで、 中に含まれている未マーク・シンボルにマークする代用とします。 そういうわけで、 expand は展開前の展開対象式 form に構文環境でマークをつけてから、 式の展開にとりかかります。

(define (so-expand form env)
 (so-expand-form (so-mark env form) env))

so-mark は、 式 form に構文環境 env でマークします。 マークの際、世代を区別できるようにするため、 空フレームで env を必ず拡張します。 env-wrap-syntax はその 2 のものを使います。

(define (so-mark env form)
 (so-extend-wrap (so-env-extend 'M '() env) form))

構文オブジェクトは、 構文クロージャと同じスロット構成でも良いのですが、 変数リストを使うことがないので取り除いて、 環境と式のスロットの組にします。

(define (make-so-syntax-object env expr) (vector 'so-syntax-object env expr))
(define (so-syntax-object-env obj) (vector-ref obj 1))
(define (so-syntax-object-expr obj) (vector-ref obj 2))

(define (so-syntax-object? x)
 (and (vector? x) (= (vector-length x) 3) (eq? (vector-ref x 0) 'so-syntax-object)))

Hanson-Bawden の sc-expand にあたるのが、 so-expand-form です。 式とキーワードを unwrap-syntax してから、 状況に応じて展開をおこないます。 unwrap-syntax もその 2 のものを使います。 unwrap-syntax により、 世代マークされたペアのときは、 car と cdr をそれぞれ世代マークしたペアを得て、 世代マークされたシンボルへと一歩近づけます。 世代マークされたシンボルのときは、 シンボルになるのではなく、 世代マークされたままとします。 unwrap-syntax さえしてしまえば、 キーワードは Hanson-Bawden の識別子と同じものになるので、 同じ流儀で展開の細部へと進めます。

(define (so-expand-form form env)
 (let* ((form (so-unwrap-syntax form))
        (keyword (if (pair? form) (so-unwrap-syntax (car form)) form)))
  (cond
   ((so-identifier? form)
    (let ((denotation (so-lookup env keyword)))
     (cond
      ((so-subst? denotation) (so-subst-name denotation))
      ((so-special? denotation) (so-special-name denotation))
      ((so-macro? denotation) (so-macro-name denotation))
      (else (error "so-expand cannot happen")))))
   ((and (pair? form) (so-identifier? keyword))
    (let ((denotation (so-lookup env keyword)))
     (cond
      ((so-subst? denotation) (so-expand-list form env))
      ((so-special? denotation) (so-expand-special denotation form env))
      ((so-macro? denotation) (so-expand-macro denotation form env))
      (else (error "so-expand cannot happen")))))
   ((pair? form) (so-expand-list form env))
   (else form))))

マクロ展開のときは、 マクロ変換子の変換手続きを使って式を変換します。 すかさずマクロ変換子の定義時構文環境を拡張した世代で、 変換結果をマークします。 そうして、 マークした式を、 またもや展開時構文環境で再展開します。

(define (so-expand-macro ex form env)
 (so-expand-form
  (so-mark (so-macro-env ex)
   ((so-macro-proc ex) form env (so-macro-env ex))) env))

リストの展開では、 リストのペアを unwrap-syntax しながら、 ペアの car を展開したリストを作ります。

(define (so-expand-list form env)
 (let ((ex (lambda (form) (so-expand-form form env))))
  (so-map* ex ex form)))

ペアごとに構文オブジェクトの unwrap-syntax が必要なので、 so-map* には map* が使えなくなります。 この煩わしさが、 変換ごとに挿入されるシンボルを自動認識するための代償です。

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

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

特殊形式の展開にも unwrap-syntax の煩わしさがちらつきます。

(define (so-expand-special denotation form env)
 (let ((keyword (so-special-name denotation)))
  (case keyword
   ((quote) (list 'quote (so-strip-syntax (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)))))

quote 構文の展開に使う strip-syntax は、 ペアだけでなくシンボルも含めて構文オブジェクトをはぎとった式に戻します。

(define (so-strip-syntax x)
 (cond
  ((so-syntax-object? x) (so-strip-syntax (so-syntax-object-expr 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)))

lambda 構文の展開では、 パターン・マッチングが構文検査に使えなくなるので、 等価な手続きを作って差し替えます。 構文チェック手続きで使っている every* は構文オブジェクトとドッテッド・リスト対応の every 手続きで、 map* に似せた使い方をします。

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

(define (so-lambda-validate form)
 (and (so-pair? (so-cdr form))
  (so-every* so-identifier? (lambda (x) (or (null? x) (so-identifier? x))) (so-cadr form))))

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

let-syntax 構文の展開も、 パターン・マッチングと等価な手続きで構文チェックし、 パターン・マッチングと等価なやりかたでパターン変数の値を求めます。 この構文チェッカは、 let 構文・letrec-syntax とも共通なので、 使いまわしています。 なお、 so-map と so-every は正規リスト専用です。

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

(define (so-bind-syntax keywords forms env)
 (map (lambda (kw form) (cons kw (so-close-macro kw form env))) keywords forms))

(define (so-let-validate x)
 (and (so-pair? x) (so-pair? (so-cdr x))
  (or (so-null? (so-cadr x)) (so-pair? (so-cadr x)))
  (so-every (lambda (x)
    (and (so-pair? x) (so-pair? (so-cdr x)) (so-null? (so-cddr x))
    (so-identifier? (so-car x))))
   (so-cadr x))))

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

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

letrec-syntax は、 ダミー環境のすげ替えでマクロ変換子の定義時構文環境を変換子を含む環境にします。

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

(define (so-macro-unspecified x e d)
 (error "let-syntax unspecified macro"))

(define (so-bind-syntax-dummy keywords env)
 (map (lambda (kw) (cons kw (so-close-macro kw so-macro-unspecified env))) keywords))

lookup はその 2 のものを使います。 lookup が使う assoc-env と assoc は、 指定されたキーワードの比較手続きを使って束縛対を探し、 それを返します。

(define (so-assoc-env x env pred)
 (cond
  ((null? env) #f)
  ((so-assoc x (car env) pred))
  (else (so-assoc-env x (cdr env) pred))))

(define (so-assoc x alis pred)
 (cond
  ((null? alis) #f)
  ((pred x (caar alis)) (car alis))
  (else (so-assoc x (cdr alis) pred))))

identifer? 手続き、 identifier=? 手続きは、 構文オブジェクトを使うようにしただけで、 Hanson-Bawden と同じものを使います。

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

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

今回は低レベル・マクロ展開器なので、 変換手続きはそのまま評価したものを使うようにします。ただし、 R4RS の低レベル展開器を修正して、 展開時構文環境と定義時構文環境も渡しています。 これは、 識別子の意味判定に identifier=? しか用意していないため、 変換手続きに両方の構文環境を渡す必要があるためです。

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

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

syntax-rules マクロから低レベル・マクロへの変換マクロを書くときに必要になるため、 so-macro denotation を変更して、 so-special のように名称シンボルを記録するようにします。 これに伴い、 so-close-macro を変更します。 そして、 so-define-syntax を、 変更した so-close-macro に対応できるようにします。

(define make-so-macro (so-record-denotation 'macro))
(define so-macro? (so-record-denotation-kind? 'macro))
(define so-macro-name cadr)
(define so-macro-proc caddr)
(define so-macro-env cdddr)

(define (so-define-syntax keyword form env)
 (so-define keyword (so-close-macro keyword (so-mark env form) env) env))

(define (so-close-macro keyword form env)
 (let ((proc (if (procedure? form) form (so-eval-macro-form form env))))
  (if (and (procedure? proc) (let ((i (arity proc))) (and (number? i) (= i 3))))
   (make-so-macro (so-strip-syntax keyword) proc env)
   (error "macro must be procedure" form))))

so-macro 以外の denotation 構造体、 generate-uid 手続き、 gen-var 手続きは、 プレフィックスを sc- から so- に変更するだけで、 Hanson-Bawden のものをそのまま使うので省略します。 define 手続き、 define-special 手続きも同様なので省略します。 core-syntactic-environment 手続きも同様です。

or 構文を試すために、 let 構文のマクロ変換手続きをコア構文環境に追加した構文環境を作っておきます。

(define (so-scheme-syntactic-environment)
 (let ((syntactic-env (so-core-syntactic-environment)))
  (so-define-syntax 'let
   '(lambda (x e d)
     (if (so-let-validate x)
      ((lambda (v a b) `((,'lambda ,v ,@b) ,@a))
       (so-map so-car (so-cadr x)) (so-map so-cadr (so-cadr x)) (so-cddr x))
      (error "invalid let" (so-strip-syntax x))))
   syntactic-env)
  syntactic-env))

いつもの例を展開します。 展開器が擬似クォート構文を認識しないので、 シンボルをクォートする小細工は相変わらず必要です。

(define (demo)
 (let ((syntactic-env (so-scheme-syntactic-environment)))
  (so-expand
   '(letrec-syntax
     ((or (lambda (x e d)
       (if (if (so-pair? x) (so-null? (so-cdr x)) #f)
        #f
       (if (if (so-pair? x) (if (so-pair? (so-cdr x)) (so-null? (so-cddr x)) #f))
        (so-cadr x)
       (if (if (so-pair? x) (if (so-pair? (so-cdr x)) (so-pair? (so-cddr x)) #f))
        ((lambda (e1 e2)
          `(,'let ((,'t ,e1)) (,'if ,'t ,'t (,'or ,@e2))))
         (so-cadr x) (so-cddr x))
        (error "no matching or")))))))
     ((lambda (x) (let ((if list) (t x)) (or 1 t))) 2))
    syntactic-env)))

構文オブジェクトで式に変換世代マークを付ける展開器は、 パターン・マッチング部で展開対象式をリスト処理するときに unwrap-syntax が必須です。 その代わり、 テンプレート部の記述は自然です。 そのため、 syntax-rules や syntax-case でパターン・マッチング部の unwrap-syntax を組み込むのが、 この方式の展開器に向いた使い方になります。