健全なマクロ展開 - reversed syntactic closures (その3)

Clinger-Rees 展開器に構文クロージャを加え、 rename denotation を取り除いて Hanson-Bawden の展開器を作ってみました。

Gist tociyuki/rsc-expand.scm

展開器のトップで symbol?sc-identifier? に変更し、 構文クロージャの展開処理を追加します。

(use util.match)

(define (sc-expand form env)
 (cond
  ((sc-identifier? form)
   (let ((denotation (sc-lookup form env)))
    (cond
     ((sc-macro? denotation) (sc-expand-macro denotation form env))
     ((sc-subst? denotation) (sc-subst-name denotation))
     ((sc-special? denotation) (sc-special-name denotation))
     (else (error "sc-expander: cannot happen" denotation)))))
  ((syntactic-closure? form)
   (sc-expand (syntactic-closure-form form) (syntactic-closure-extend form env)))  
  ((and (pair? form) (sc-identifier? (car form)))
   (let ((denotation (sc-lookup (car form) env)))
    (cond
     ((sc-macro? denotation) (sc-expand-macro denotation form env))
     ((sc-special? denotation) (sc-expand-special denotation form env))
     (else (sc-expand-list form env)))))
  ((pair? form) (sc-expand-list form env))
  (else form)))

(define (sc-expand-list form* env)
 (map (lambda (form) (sc-expand form env)) form*))

マクロ・アプリケーションの変換手続きが返した展開対象式を、 展開時構文環境で展開を続行するようにします。

(define (sc-expand-macro mac form env)
 (sc-expand ((sc-macro-proc mac) form env (sc-macro-env mac)) env))

展開器で識別子を扱えるようにします。 識別子は、 シンボルか、 または識別子を閉じ込めた構文クロージャです。

(define (sc-identifier? x)
 (or (symbol? x)
  (and (syntactic-closure? x) (sc-identifier? (syntactic-closure-form x)))))

識別子の意味が同じかどうかは、 識別子を束縛している denotation を探し、 それが同じかどうかを調べます。 置換規則のときは、 置換された後のシンボルが同じなら意味も同じです。 それ以外のときは、 denotation が同じオブジェクトのときに意味を同じとします。

(define (sc-identifier=? env1 x1 env2 x2)
 (and (sc-identifier? x1) (sc-identifier? x2)
  (let ((denotation1 (sc-lookup x1 env1))
        (denotation2 (sc-lookup x2 env2)))
   (or (eq? denotation1 denotation2)
    (and (sc-subst? denotation1) (sc-subst? denotation2)
     (eq? (sc-subst-name denotation1) (sc-subst-name denotation2)))))))

相変わらず構文環境はフレームのリストで、 フレームは連想リストにしてあります。 sc-define は、 構文環境の先頭フレームへ束縛対を追加します。

; Syntactic-Environment = (((Symbol . Denotation) ...) ...)
(define (sc-define x denotation env)
 (set-car! env (cons (cons x denotation) (car env)))
 x)

識別子の意味を表す denotation を、 sc-lookup 手続きで探します。 まず、 展開時構文環境から eq? で一致する束縛対を探します。 見つかったら、 それの右側を返します。 見つからなかったとき、 シンボルだったらシンボルそれ自身への置換規則を返します。 構文クロージャだったらそれに閉じ込めた環境から、 閉じ込めた識別子を探します。

(define (sc-lookup x env)
 (cond
  ((not (sc-identifier? x)) (error "sc-lookup requires identifier" x))
  ((sc-assoc-env x env) => cdr)
  ((symbol? x) (make-sc-subst x))
  (else (sc-lookup (syntactic-closure-form x) (syntactic-closure-env x)))))

(define (sc-assoc-env x env)
 (let loop ((env env))
  (cond
   ((null? env) #f)
   ((pair? env) (or (assq x (car env)) (loop (cdr env))))
   (else (error "sc-assoc-env - cannot happen")))))

構文クロージャのデータ構造は Bawden-Rees 展開器と同じです。 ベクタに、 環境、 変数リスト、 置換対象式が並びます。

(define (make-syntactic-closure env vars form)
 (vector 'syntactic-closure env vars form))

(define (syntactic-closure? x)
 (and (vector? x) (= (vector-length x) 4) (eq? (vector-ref x 0) 'syntactic-closure)))

(define (syntactic-closure-env x)
 (vector-ref x 1))

(define (syntactic-closure-form x)
 (vector-ref x 3))

(define (syntactic-closure-extend x env)
 (cons
  (map (lambda (v) (cons v (sc-lookup v env))) (vector-ref x 2))
  (syntactic-closure-env x)))

denotation は Clinger-Rees 展開器のものと同じですが、 rename が不要なので削除します。 リネームされたシンボルを新しく生成したシンボルとして、 元のシンボルとの対応付けを構文環境でおこなうのが、 Clinger-Rees 展開器で、 そのために rename denotation を使っていました。 Hanson-Bawden 展開器では、 構文環境を使わずに、 リネームされたシンボルを構文クロージャとして、 元のシンボルの別名として展開対象式に埋め込みます。

; Denotation = ('subst . binding-variable-symbol)
;            | ('special keyword . defined-syntactic-env)
;            | ('macro macro-procedure . defined-syntactic-env)
; where defined-denotation is (cr-lookup renamed-symbol defined-syntactic-env)
(define (sc-record-denotation kind)
 (lambda spec
  (cons kind (apply cons* spec))))

(define (sc-record-denotation-kind? kind)
 (lambda (x)
  (and (pair? x) (eq? (car x) kind))))

(define make-sc-subst (sc-record-denotation 'subst))
(define sc-subst? (sc-record-denotation-kind? 'subst))
(define sc-subst-name cdr)
(define make-sc-special (sc-record-denotation 'special))
(define sc-special? (sc-record-denotation-kind? 'special))
(define sc-special-name cadr)
(define sc-special-env cddr)
(define make-sc-macro (sc-record-denotation 'macro))
(define sc-macro? (sc-record-denotation-kind? 'macro))
(define sc-macro-proc cadr)
(define sc-macro-env cddr)

特殊形式の展開はほとんど同じですけど、 quote に構文クロージャ除去が入ります。

(define (sc-expand-special denotation form env)
 (let ((keyword (sc-special-name denotation))
       (def-env (sc-special-env denotation)))
  (case keyword
   ((quote) `(quote ,(sc-strip (cadr form))))
   ((lambda) (sc-expand-lambda form env))
   ((let-syntax) (sc-expand-let-syntax form env def-env))
   ((letrec-syntax) (sc-expand-letrec-syntax form env def-env))
   ((if set! begin) `(,keyword ,@(sc-expand-list (cdr form) env)))
   (else (error "unknown special form" form)))))

sc-strip は、 木を再帰的にたどって構文クロージャに閉じ込めてある式へ置き換えて、 式から構文クロージャを取り除きます。

(define (sc-strip form)
 (cond
  ((pair? form)
   (let ((a (sc-strip (car form)))
         (b (sc-strip (cdr form))))
    (if (eq? a b) form (cons a b))))
  ((syntactic-closure? form) (sc-strip (syntactic-closure-form form)))
  (else form)))

λ構文の展開手続きの見た目は変わらないものの、 仮引数の識別子がシンボルだけでなく構文クロージャになることがあります。 識別子が構文クロージャのときは、 strip して束縛変数シンボルを生成します。

(define (sc-expand-lambda form env)
 (match form
  ((_ (idents ...) body ...)
   (sc-syntactic-env-subst idents env (lambda (vars env)
    `(lambda ,vars ,@(sc-expand-list body env)))))))

(define (sc-syntactic-env-subst idents env kont)
 (let* ((uid (sc-generate-uid))
        (vars (map (lambda (x) (sc-gen-var (sc-strip x) uid)) idents))
        (frame (map (lambda (x x.i) (cons x (make-sc-subst x.i))) idents vars)))
  (kont vars (cons frame env))))

Hanson-Bawden が新しくシンボルを作るのは束縛変数だけです。 このふるまいは Bawden-Rees と同じです。

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

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

(define (sc-gen-var sym uid)
 (string->symbol
  (string-append
   (symbol->string sym)
   "."
   (number->string uid))))

局所マクロを定義して展開をおこなう let-syntax と letrec-syntax は、 Clinger-Rees と変わりません。 letrec-syntax の局所マクロ定義中のダミー・フレームにはキーワード自身への置換規則を並べておきます。

(define (sc-expand-let-syntax form exp-env def-env)
 (match form
  ((_ ((keywords transformers) ...) body ...)
   (let ((frame (sc-bind-syntax keywords transformers exp-env)))
   (let ((exp-env (cons frame exp-env)))
    (if (null? (cdr body))
     (sc-expand (car body) exp-env)
     `(begin ,@(sc-expand-list body exp-env))))))))

(define (sc-expand-letrec-syntax form exp-env def-env)
 (match form
  ((_ ((keywords transformers) ...) body ...)
   (let ((exp-env (cons (sc-bind-dummy-frame keywords exp-env) exp-env)))
   (let ((frame (sc-bind-syntax keywords transformers exp-env)))
    (set-car! exp-env frame)
    (if (null? (cdr body))
     (sc-expand (car body) exp-env)
     `(begin ,@(sc-expand-list body exp-env))))))))

(define (sc-bind-dummy-frame keywords exp-env)
 (map
  (lambda (kw)
   (let ((x (sc-expand kw exp-env)))
    (cons x (make-sc-subst x))))
  keywords))

(define (sc-bind-syntax keywords transformers exp-env)
 (map cons
  (map (lambda (kw) (sc-expand kw exp-env)) keywords)
  (map (lambda (form) (sc-close-macro form exp-env)) transformers)))

sc-define-special はコア構文環境に特殊形式を定義するのに使います。 特殊形式の定義時構文環境は、 それが定義されるコア構文環境とします。

(define (sc-define-special kw env)
 (sc-define kw (make-sc-special kw env) env))

(define (sc-core-syntactic-environment)
 (let ((env (list '())))
  (sc-define-special 'quote env)
  (sc-define-special 'lambda env)
  (sc-define-special 'let-syntax env)
  (sc-define-special 'letrec-syntax env)
  (sc-define-special 'if env)
  (sc-define-special 'set! env)
  (sc-define-special 'begin env)
  env))

マクロ定義は、 sc-close-macro で変換子を作成し、 束縛対を先頭フレームへ追加します。

(define (sc-define-syntax kw form env)
 (sc-define kw (sc-close-macro form env) env))

変換子は変換手続きと展開時構文環境を閉じ込めて作ります。 sc-close-macro の定義時構文環境は、 let-syntax 特殊形式等を定義したコア構文環境を選んでおきます。

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

マクロ定義はそれ自身が展開対象式なので、 展開してからホスト処理系で評価して手続きにします。

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

(define (sc-eval-macro-form form exp-env)
 (eval (sc-expand form exp-env) sc-macro-proc-environment))

この展開器が扱える変換手続きは、 syntactic closures、 reversed syntactic closures、 明示リネーミング・マクロの 3 種類あります。 それぞれの流儀の変換手続きを、 この展開器が扱える形式に手続きでラップします。

syntactic closures では、 変換手続きへ展開時構文環境を渡して、 戻ってきた展開対象式を変換子の定義時構文環境で構文クロージャに閉じ込めます。

(define (sc-macro-transformer proc)
 (lambda (form exp-env def-env)
  (make-syntactic-closure def-env '() (proc form exp-env))))

reversed syntactic closures では、 変換手続きへ定義時構文環境を渡しして、 戻ってきた展開対象式を展開時構文環境で展開を続けます。

(define (rsc-macro-transformer proc)
 (lambda (form exp-env def-env)
  (proc form def-env)))

もう一方の構文環境を捉えるのに使われる capture-syntactic-environment は、 構文クロージャをキーワードにしてある使い捨てのマクロ・アプリケーションを作って返します。 その際、 このマクロ・アプリケーションを展開したタイミングで、 変換手続きが渡した継続を摘要するトランポリンをマクロ変換手続きにしておきます。

(define (sc-capture-syntactic-environment kont)
 `(,(make-syntactic-closure
     `(((foo ,@(make-sc-macro (lambda (form exp-env def-env) (kont exp-env)) '()))))
     '()
     'foo)))

明示リネーミング・マクロでは、 (その1) に記した作法通りに変換手続きへ渡す rename 手続きと compare 手続きを変換ごとに作ります。 戻ってきた展開対象式は展開時構文環境で展開を続けます。

(define (er-macro-transformer proc)
 (lambda (form exp-env def-env)
  (let ((table '()))
   (let ((rename (lambda (x)
          (cond
           ((assq x table) => cdr)
           (else
            (let ((alias_x (make-syntactic-closure def-env '() x)))
             (set! table (cons (cons x alias_x) table))
             alias_x)))))
         (compare (lambda (x y) (sc-identifier=? exp-env x exp-env y))))
    (proc form rename compare)))))

デフォルトの構文環境には let 構文を定義しておきます。 この定義のように、 この展開器では syntactic closures を使ってマクロを書くこともできます。

(define (sc-scheme-syntactic-environment)
 (let ((syntactic-env (sc-core-syntactic-environment)))
  (sc-define-syntax 'let
   '(sc-macro-transformer
     (lambda (form exp-env)
      ((lambda (vars args body)
        `((,'lambda ,vars
           ,@(map (lambda (e) (make-syntactic-closure exp-env vars e)) body))
          ,@(map (lambda (e) (make-syntactic-closure exp-env vars e)) args)))
       (map car (cadr form))
       (map cadr (cadr form))
       (cddr form))))
   syntactic-env)
  syntactic-env))

rsc-macro-transfomer で簡易版 cond を局所マクロへ定義して展開に使ってみます。

(define (demo2)
 (let ((syntactic-env (sc-scheme-syntactic-environment)))
  (sc-reset-unique-id-counter)
  (sc-expand
   '(letrec-syntax
     ((cond
       (rsc-macro-transformer
        (lambda (form def-env)
         (sc-capture-syntactic-environment (lambda (exp-env)
          (let ((alias_let (make-syntactic-closure def-env '() 'let))
                (alias_temp (make-syntactic-closure def-env '() 'temp))
                (alias_if (make-syntactic-closure def-env '() 'if))
                (alias_cond (make-syntactic-closure def-env '() 'cond))
                (alias_begin (make-syntactic-closure def-env '() 'begin)))
           (if (and (pair? (cdr form)) (pair? (cadr form)) (null? (cdadr form)))
            (let ((pred (caadr form)) (rest (cddr form)))
             `(,alias_let ((,alias_temp ,pred))
               (,alias_if ,alias_temp ,alias_temp (,alias_cond ,@rest))))
            (if (and (pair? (cdr form)) (pair? (cadr form)) (pair? (cdadr form)))
             (let ((pred (caadr form)) (form1 (cdadr form)) (rest (cddr form)))
              (if (sc-identifier=? exp-env pred def-env 'else)
               `(,alias_begin ,@form1)
               `(,alias_if ,pred (,alias_begin ,@form1) (,alias_cond ,@rest))))
             ''unspecified)))))))))
     ((lambda (x) (let ((if list) (temp x)) (cond (1) (else temp)))) 2))
   syntactic-env)))