構文オブジェクト (その 3) 展開器では、 Hanson-Bawden の名残りでマクロ定義時構文環境から拡張した変換世代マークだけを式にくっつけていました。 その結果、 identifier=? しか利用できなくなり、 識別子の意味一致判定のためマクロ変換手続きに展開時構文環境と定義時構文環境の両方を渡す他ありませんでした。 一方、 R4RS の低レベル・マクロ展開では、 free-identifier=? を利用可能とし、 マクロ変換手続きに渡すのも展開対象の構文オブジェクトだけです。 この違いを埋めるには展開時構文環境も構文オブジェクトで式にくっつければ良いでしょう。 スロット名の env は定義時構文環境に使ってしまっているので、 やや苦し紛れですけど展開時構文環境のためのスロットに ctx と名づけることにします。
(define (make-so-syntax-object ctx env expr) (vector 'so-syntax-object ctx env expr)) (define (so-syntax-object-ctx obj) (vector-ref obj 1)) (define (so-syntax-object-env obj) (vector-ref obj 2)) (define (so-syntax-object-expr obj) (vector-ref obj 3)) (define (so-syntax-object? x) (and (vector? x) (= (vector-length x) 4) (eq? (vector-ref x 0) 'so-syntax-object)))
so-unwrap-syntax するとき、 ctx スロットの扱いは env スロットとは逆にします。 env スロットは構文オブジェクトが入れ子になっているとき、 最も内側のものを残しました。 ctx スロットは最も外側のものを残します。 展開時構文環境もくっつけた構文オブジェクトを角括弧で囲んで表すと、 次のように入れ子の構文オブジェクトを展開するわけです。
; [[[t:M2 E1]:M4 E3]:M6 E5] -> [t:M2 E5] ; [([f:M2 E1] . [t:M4 E3]):M6 E5] -> ([f:M2 E5] . [t:M4 E5]) (define (so-unwrap-syntax form) (if (so-syntax-object? form) (let ((expr (so-syntax-object-expr form))) (cond ((symbol? expr) form) ((pair? expr) (cons (so-datum->syntax form (car expr)) (so-datum->syntax form (cdr expr)))) (else (so-unwrap-syntax (so-datum->syntax form expr))))) form))
so-datum->syntax は、 2 つの環境をコピーするのに使います。
(define (so-datum->syntax obj x) (so-extend-wrap (so-syntax-object-ctx obj) (so-syntax-object-env obj) x))
2 つの環境は、 上で述べた流儀で必要な方を残します。
(define (so-extend-wrap ctx env x) (cond ((symbol? x) (make-so-syntax-object ctx env x)) ((pair? x) (make-so-syntax-object ctx env x)) ((so-syntax-object? x) (if (eq? ctx (so-syntax-object-ctx x)) x (make-so-syntax-object ctx (so-syntax-object-env x) (so-syntax-object-expr x)))) (else x)))
so-extend-wrap の変更に合わせて so-mark も書き換えます。 so-mark の展開時構文環境は単純化のため、 空環境にしておきます。
(define (so-mark env form) (so-extend-wrap '() (so-env-extend 'M '() env) form))
so-identifier=? を改訂し、 構文オブジェクトから展開時構文環境を取得すると so-free-identifer=? ができあがります。
(define (so-free-identifier=? id1 id2) (and (so-identifier? id1) (so-identifier? id2) (or (eq? id1 id2) (let ((d1 (so-lookup (so-syntax-object-ctx id1) id1)) (d2 (so-lookup (so-syntax-object-ctx id2) id2))) (or (eq? d1 d2) (and (so-subst? d1) (so-subst? d2) (eq? (so-subst-name d1) (so-subst-name d2))))))))
マクロ変換手続きの引数が 3 つから 1 つに減ります。
(define (so-macro-unspecified x) (error "let-syntax unspecified macro")) (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 1)))) (make-so-macro (so-strip-syntax keyword) proc env) (error "macro must be procedure" form))))
マクロでシンボルの意味を調べるとき、 定義時構文環境内で同じ意味かどうか調べたい方が多いぐらいです。 そのために、 変換手続きへ定義時構文環境をくっつけた式を渡すことにします。 so-expand-macro に渡す式は so-unwrap-syntax 済みのペアですから、 そこにくっつけます。 変換手続きが新しく挿入したシンボルにも定義時構文環境をくっつけなければならないため、 変換手続きの前後で 2 度同じ構文環境を式にくっつけることになります。
(define (so-expand-macro ex form env) (let ((mark (so-env-extend 'M '() (so-macro-env ex)))) (so-expand-form (so-extend-wrap env mark ((so-macro-proc ex) (so-extend-wrap env mark form))) env)))
さらに、 let-syntax と letrec-syntax 構文が構文環境を拡張するとき、 構文環境に置くキーワードには展開時構文環境は不要なので、 空リストに削っておきます。
(define (so-bind-syntax-dummy keywords env) (map (lambda (kw) (cons (so-extend-wrap '() (so-syntax-object-env kw) kw) (so-close-macro kw so-macro-unspecified env))) keywords)) (define (so-bind-syntax keywords forms env) (map (lambda (kw form) (cons (so-extend-wrap '() (so-syntax-object-env kw) kw) (so-close-macro kw form env))) keywords forms))
syntax-rules では、 so-env-rename-syntax を so-rename-syntax に変更します。
(define (so-rename-syntax obj id) (so-expand-form id (so-syntax-object-env obj)))
syntax-rules 手続きの引数を 1 つにして、 so-datum->symbol でシンボルをリネームするようにします。 さらに、 これまで低レベル・マクロへの変換結果で so-identifier=? を使っていた箇所を so-free-identifier=? にします。 se-rename-syntax への変更もおこなっておきます。
(define (so-syntax-rules rules) (define counter 0) (define _any (so-datum->syntax rules '_)) (define _dooot (so-datum->syntax rules '...)) (define _quote (so-datum->syntax rules 'quote)) (define _syntax-error (so-datum->syntax rules 'syntax-error)) ;(途中略) (convert rules))
変換結果の低レベル・マクロ手続きの引数も 1 つにします。
(define (convert src) (conv-opt-dooot src (lambda (dooot src) (conv-literal src (lambda (literal? src) (conv-rule-list dooot literal? src (lambda (expr) (list 'lambda (list 'x) (list (list 'lambda (list 'x) (list 'so-take-right ''() 0) 'x) expr)))))))))
これまで低レベル・マクロへの変換結果で so-identifier=? を使っていた箇所を so-free-identifier=? にします。
(define (pat-identifier src x g rank test var k) (if (so-free-identifier=? src _any) (k test var) (if (so-free-identifier=? src _dooot) (error "invalid syntax-rules" (so-strip-syntax rules)) (if (literal? src) (k (pat-and (list 'so-free-identifier=? x (list 'syntax-quote src)) test) var) (if (so-assoc src var so-bound-identifier=?) (error "duplicate pattern variable" (so-strip-syntax src)) (k test (cons (cons* src rank g) var)))))))
同様に se-rename-syntax へ変更します。
(define (tmpl-identifier var src dooot rank k) ((lambda (e) (if e (if (<= (cadr e) rank) (k src) (error "too few ellipsis" (so-strip-syntax rules))) (if (so-free-identifier=? src dooot) (error "invalid syntax-rules" (so-strip-syntax rules)) (k (list 'so-rename-syntax 'x (list 'syntax-quote src)))))) (find (lambda (x) (so-free-identifier=? (car x) src)) var)))
低レベル・マクロで so-free-identifier=? を使ってリテラルの意味比較をする一例です。 低レベル・マクロでは、 展開時構文環境をくっつけない展開器と同じ動作をします。
(define (demo) (so-expand '(letrec-syntax ((cond (lambda (x) (if (so-free-identifier=? (so-cadr (so-cadr x)) (so-wrap-syntax x '=>)) ((lambda (e1 e2) `((,'lambda (,'t) (,'if ,'t (,e2 ,'t))) ,e1)) (so-car (so-cadr x)) (so-caddr (so-cadr x))) ((lambda (e1 e2) `(,'if ,e1 (,'begin ,@e2))) (so-car (so-cadr x)) (so-cdr (so-cadr x))))))) ((lambda (=>) (cond (#t => 'ok))) #f)) (so-core-syntactic-environment)))
syntax-rules での同じ例です。 こちらも、 ほとんどは展開時構文環境をくっつけない場合と同じになります。 ただし、 リテラルをパターンに使ったときに結果は同じになるものの、 意味を探す環境がほんの少し異なります。 展開時構文環境をくっつけない場合は cond 構文の定義時構文環境に空フレームをつけたマーク構文環境で探します。 一方、 こちらではリテラルに展開時構文環境としてくっついている cond 構文の定義時構文環境で探します。
(define (demo) (let ((syntactic-env (so-rules-syntactic-environment))) (so-expand '(letrec-syntax ((cond (syntax-rules (=>) ((cond (e1 => e2)) ((lambda (t) (if t (e2 t) #f)) e1)) ((cond (e1 e2 e3 ...)) (if e1 (begin e2 e3 ...) #f))))) ((lambda (=>) (cond (#t => 'ok))) #f)) syntactic-env)))