A正規化（A-normalization）と CPS変換 - Scheme VM を書く

scheme

ここに書いてある内容は古いです。A正規形まとめをご参照ください。
The Essence of Compiling with Continuations を読んで理解したことをまとめた。僕は専門家でないので間違いが含まれている可能性があることに注意。

CPS

CPSの特徴はすべての手続きが継続を引数にとること。
CPS変換はプログラムサイズをとても大きくするので、CPSコンパイラはよりサイズの小さい中間表現にしようと簡約を試みる。このステップは概念的にはCPS変換とは別のフェーズであるが、変換と同時に行われることが多い。

CPS の利点は

  • 中間表現として多くの変換が可能である
  • 様々な実マシンのアセンブリ言語への変換が容易である

この利点により CPS を利用すればコンパイラの構造をシンプルにできる。

A正規化

CPS変換 => 簡約 とおおよそ同じ結果を得るのに、A正規化という方法がある。これはダイレクトに変換を行うので、CPS変換 => 簡約よりも直感的で（おそらく）時間や空間の使用が少ない。
A正規化は、計算の途中経過に対して変数を明示的に割り当てる変換であり、この変換前後でのソースコードの意味（？）は同じであることが証明されている。
この変換では言語が statically typed か dynamically typed かは関係ない。
A正規化は論文で説明されているある一定のルールでコードを変換することで実現できる。（サンプルコードも付属している）

A Linear A-Normalizations

論文に付属している変換のサンプルコード。対象は Core Scheme という Scheme の一種。
変換の前に、Alpha reduction が済ませていることが必要。
またコードの肥大化を防ぐために conditional な式(if0)を、含む場合は evaluation context の複製をしていないと書いてある。

以下はひげぽんが Core Scheme -> Scheme, if0 -> if など脳内変換した結果の変換例とコードである。あまり真に受けないように。

let1

let1 は以下のような形式。

(let1 x M1 M2)

変換例

(let1 a 3 a)
=>
(let1 a 3 a)

(let1 a (let1 b 3 b) a)
=>
(let1 b 3 (let1 a b a))

ちなみに論文では、let には body が1つという前提が見えるが僕のコードでは body は複数使えるようにしてある。

if

論文では if0 だが if でやる。これ正しいのだろうか？。

変換例

(if 3 4 5)
=>
(if 3 4 5)

(if (let1 a 3 a) 4 5)
=>
(let1 a 3 (if a 4 5))
lambda
(lambda (a b) a)
=>
(lambda (a b) a)
手続き呼び出し
(+ 1 2)
=>
(+ 1 2)

((lambda (a) a) 3)

(- (let1 a 3 a) 2)
=>
(let1 a 3 (- a 2))

((lambda (a b) (+ a b)) 3 2)
=>
((lambda (a b) (+ a b)) 3 2)
特殊な例 set! / define

論文では出てこない特殊フォーム third の位置のものを変換すれば良いのではないかと推測。

(set! x (let1 a 3 a))
=>
(let1 a 3 (set! x a))
コード
(define (normalize-name m k)
  (define (value? v) ;; constant, variables and procedures
    (if (pair? v)
        (eq? (first v) 'lambda)
        #t))
  (normalize m
             (lambda (n) (if (value? n)
                             (k n)
                             (let1 t (gensym)
                               `(let1 ,t, n ,(k t)))))))

(define (normalize-name* m* k)
  (if (null? m*)
      (k '())
      (normalize-name (car m*) (lambda (t) (normalize-name* (cdr m*)
                                                            (lambda  (t*) (k `(,t . ,t*))))))))

(define (normalize-term m)
  (normalize m (lambda (x) x)))

(define (let->let1 sexp)
  (let ([vars (second sexp)]
        [body (cddr sexp)])
    (let loop ([vars vars])
      (if (null? vars)
          body
          `(let1 ,(first (car vars)) ,(second (car vars)) ,@(if (null? (cdr vars)) body (list (loop (cdr vars)))))))))

(define (normalize m k)
  (match m
    [('lambda params body)
     (k `(lambda ,params ,(normalize-term body)))]
    [('let . m*)
     (normalize (let->let1 m) k)]
    [('let* . m*)
     (normalize (let->let1 m) k)]
    [('let1 x m1 . m2*)
     (let loop ([body m2*]
                [ret '()])
       (if (null? body)
           (normalize m1 (lambda (n1) `(let1 ,x ,n1 ,@ret)))
           (loop (cdr body) (append ret (list (normalize (car body) k))))))]
    [('if m1 m2 m3)
     (normalize m1 (lambda (t) (k `(if ,t ,(normalize-term m2) ,(normalize-term m3)))))]
    [('set! x m)
     (normalize m (lambda (t) (k `(set! ,x ,t))))]
    [('define x m)
     (normalize m (lambda (t) (k `(define ,x ,t))))]
    [(fn . m*)
     (if (eq? fn '+)
         (normalize-name* m* (lambda (t*) (k `(,fn . ,t*)))))
         (normalize-name fn (lambda (t) (normalize-name* m* (lambda (t*) (k `(,t . ,t*))))))]
    [else (k m)]))

ここを通る方へ

日本語の資料の少なさからこの文章は検索結果上位に来ることが予想されます。もし間違いに気付かれたり、補足などがありましたらコメントをいただけると助かります。これがいつか誰かの役にたつと良いな。