SECDRマシンのコンパイラを読む

コンパクトなVMベースのScheme処理系としてはSECDR Schemeが有る。というわけで、SECDR Schemeコンパイラを読んでみる。

コンパイラは非常にコンパクトで、VMの命令も19種類しか無い。SECDRマシンの重要な特徴は末尾再帰を直接的にサポートしている点と言える。なのでコンパイラを見るときも、これをどうやって実現しているのかを気にして見ることになる。
SECDRマシンは多値を直接的にはサポートしていないので、これをサポートするのが拡張としては興味深いのではないかと思う。また後述のようにこのコンパイラはletやletrec、beginを直接的にはサポートしていないので、それらの拡張も考えた方が良さそうだ。

SECDRマシンのステートと命令

SECDRはVMの持つステート(レジスタ)の頭文字を取ったもので、PDFでよく説明されている。PDFから説明を引用すると:

  • S : Stack
    • 式の値を計算するときの中間結果を入れる
  • E : Environment
    • 計算の途中で各変数に束縛される値を入れる
  • C : Control list
    • 実行されるべき機械語プログラムを入れる
  • D : Dump
    • 新しい関数呼び出しが起こったときに他のレジスタの内容をしまっておく。スタックの一種。
  • R : Return
    • 戻り値を格納する

Control listで言われている機械語というのは、ここで説明するcompile手続きを通して得たS式を指す。
Dumpレジスタは、C言語的なセンスで言うところのスタックにより近い。末尾呼び出しでは呼び出し元に戻ってくる必要が無いためここにステートをプッシュする必要が無い。
19個の機械語命令はおおよそ6種類に分類できる。

いくつかの命令は対応するScheme構文が存在しない。フレーム構築命令は、call命令のためのフレーム、要するにlambdaの引数を構築するために使用される。特殊命令はRTNを除いてコンパイラが直接生成することは無い。(call/ccの実装等のためにランタイムによって使用される)

コンパイラの入力と出力

コンパイラは以下の特殊形式を含む普通のSchemeコードを入力し、S式で表現されるVM命令列を出力する。

  1. quote
  2. lambda
  3. begin
  4. if - 必ずelse節を持つ
  5. define
  6. global-define - ローカルの束縛を無視する特殊なdefine(ドキュメントを参照)
  7. set!

ただし、internal-defineを持つlambdaは事前に個々のdefineを空リストに束縛するようなコードに変換される。(このコンパイラはletやletrecをサポートしていないことに注意する)

                 ;;; case of internal definition
                 ;;
                 ;; (lambda (<var1> ...)
                 ;;   (define <def-var1> <def-body1>) ...
                 ;;   <body>)
                 ;; ==>
                 ;; (lambda (<var1> ...)
                 ;;   ((lambda (<def-var1> ...)
                 ;;      (define <def-var1> <def-body1>) ...
                 ;;      <body>)
                 ;;    '() ...))
                 ;;

コンパイルループ comp

compはScheme式を受け取ってVM命令を出力する。パラメタは:

  • exp : コンパイル対象のScheme
  • vars : ローカル環境 - lambdaの変数シンボルのlist
  • cont : 継続
  • tail : 末尾式の場合に真

varsはローカル環境を表現するシンボルのリストとなっている。これはlambda構文の変数リストを単に並べただけで、先頭がもっとも内側のlambdaで最も優先されることになる。
contは継続を表現する。ここでは、contは常にcompが生成する機械語次に実行される機械語が指定される。このため、compの最初の呼び出しは

 (comp (macro-expand exp) '() (cons %RTN% '()) #t))

のように、contとして%RTN%、つまりreturn命令が指定されている。
tailはTSEL<=>SEL命令とTAP<=>AP命令の選択にだけ使用される。
'T'の付く方の命令が、末尾位置で使用される命令となっている。これはDumpレジスタにマシンステートをpushするかどうかの差しかない。

;; S E (SEL ct cf . C) D test ==> S E cx (S E C . D) test
;;  where cx = (if test ct cf)
;;
;; S E (TSEL ct cf . C) D test ==> S E cx D test
;;  where cx = (if test ct cf)

末尾位置であった場合はマシンステートをプッシュしない。

quote

        ((eq? (car exp) 'quote)
          (cons %LDC% (cons (cadr exp) cont)))

quoteは非常に単純で、定数ロード命令LDCを出力する。

;; S E (LDC const . C) D R ==> S E C D const

lambdaとbegin

lambdaとbeginは同じLDF命令を出力する。lambdaのformalsがそのまま環境フレームとして使用される。ここではちょっとしたヘルパ手続comp-bodyを定義して、それを使っている。

    (define (comp-body e v c)
     (if (pair? e)
       (if (null? (cdr e)) ;; ← ★ 末尾位置かどうか判定
         (comp (car e) v c #t)
         (comp (car e) v (comp-body (cdr e) v c) #f)) 
       (comp e v c #t)))

comp-bodyは再帰ループになっていて、bodyを後ろからcompしていくループとなる。

        ((eq? (car exp) 'lambda)
          (cons %LDF%
                (cons
                  (comp-body
                    (cddr exp) ;; ← ★ 変数リスト(vars)を読み飛ばす (beginはcdr)
                    (cons (cadr exp) vars) ;;← ★ varsを拡張
                    (cons %RTN% '()))
                  cont)))
        ((eq? (car exp) 'begin)
          (cons %LDF%
                (cons
                  (comp-body
                    (cdr exp) ;; ← ★ beginには変数リストが無いのでcdr
                    (cons '() vars)
                    (cons %RTN% '()))
                  cont)))

... 実は、ここで実装されるbeginはScheme的な意味のbeginではなく、マクロ(macro-expand手続)によって事前に(begin ...) → [(begin ...)] のように変換されている。

;; begin
        ((eq? (car exp) 'begin)
         `((begin
             ,@(tail-map macro-expand (cdr exp)))))

つまり、これはR5RS的に書くと

(define-syntax begin
  (syntax-rules ()
     ((_ form ...)
      ((lambda () form ...)))))

としているのと同じで、このコンパイラは"真のbegin"を実装していないとも言える。

if

ifはSELまたはTSEL命令で実現される。

        ((eq? (car exp) 'if)
          (let
            ((thenpt
               (comp (caddr exp) vars (cons %RTN% '()) #t))
             (elsept
               (comp (car (cdddr exp)) vars (cons %RTN% '()) #t)))
            (comp (cadr exp) ;; ← ★ ifの条件式をコンパイルするので、tailパラメタは常に偽になる
                  vars
                  (cons (if tail %TSEL% %SEL%)
                        (cons thenpt (cons elsept cont)))
                  #f)))

ifを実現するためには、comp手続きを都合3回呼ぶが、then/elseパートは常にtail = 真で呼び、条件式ではtail = 偽で呼ぶことになる。

defineとset!

defineとset!はローカル変数またはグローバル変数に対する値のセットを行う。パラメタの生成のために、ヘルパ手続frame-locを呼び出している。というわけで、まずframe-locを見てみる。個人的にはframe-locがこのコンパイラで一番難解なパートだと思う。

;;  search a position of symbol in frame
    (define (frame-loc f s)
      ;; => ((<フレーム内位置> . <フレーム位置>) . <可変長引数?>)
      ;; => #f シンボルが見つからない (グローバル変数とみなす)
      ;; f : フレーム
      ;; s : 検索対象のシンボル
      (define (iter-list-loc i j l s)
        (if (pair? l)
          (if (eq? (car l) s)
              ;; シンボル名が一致した
              (cons (cons i j) #f)
              ;; シンボル名が一致しなかったので(cdr l)で隣をチェック
              (iter-list-loc i (1+ j) (cdr l) s))
          ;; ペアでなくてシンボルとして一致したならば、可変長引数
          (if (eq? l s) (cons (cons i j) #t) #f)))
      (define (iter-frame-loc i f s)
        (if (pair? f)
          (let ((loc (iter-list-loc i 0 (car f) s)))
            ;; iter-list-locが偽を返したらフレームを(cdr f)で一段上がってまた検索
            (if loc loc (iter-frame-loc (1+ i) (cdr f) s)))
          #f))
      (iter-frame-loc 0 f s))

frame-locは、ここで生成するTASSIGまたはASSIG命令のパラメタを生成する。

;; S E (ASSIG (i . j) . C) D R ==> S E' C D R
;;  where E' is made by
;;    (set-car! (list-tail (list-ref E i) j) R)
;;
;; S E (TASSIG (i . j) . C) D R ==> S E' C D R
;;  where E' is made by
;;    (if (zero? j)
;;      (set-car! (list-tail E i) R)
;;      (set-cdr! (list-tail (list-ref E i) (- j 1)) R))
;;
;; S E (GASSIG sym . C) D R ==> S E C D R
;;  where global value of sym = R

(T)ASSIG命令は、フレーム位置 i とフレーム内位置 j の2つのパラメタを取り、環境Eを変更する。TASSIG命令にはTが付いているが末尾再帰とは関係が無く、可変長引数の末尾パラメタを受ける際に使用される。

        ((eq? (car exp) 'define)
          (let ((loc (frame-loc vars (cadr exp))))
            (comp
              (caddr exp)
              vars
             (if loc ;; ((フレーム位置 . フレーム内位置) . 可変長?) または 偽
               (if (cdr loc)
                 (cons %TASSIG% (cons (car loc) cont))  ;; TASSIG命令でフレームにset!する
                 (cons %ASSIG%  (cons (car loc) cont))) ;; ASSIG命令でフレームにset!する
               (cons %DEF% (cons (cadr exp) cont))) ;; 偽の場合はグローバル変数のdefine
             #f))) ;; 末尾位置にはならない

set!も同様なので略。
... これの上手な説明が思いつかない。。

  • Schemeはレキシカルスコープな言語なので、環境レジスタ E の解釈はコードの場所で静的に決定できる
  • このため、コンパイラは全てのbindされる変数を"N段上がってM個右の変数"という形で出力できる

コンパイラはこの2つのポイントを利用して手続きのapplyやlambdaを実装している。

apply

以上の特殊形式のいづれにもあてはまらないリストはapplyと見做される。これもframe-loc同様ヘルパ手続のcomp-argsに追い出されている:

;;  compile arguments
    (define (comp-args e v c)
      (if (pair? e)
        (comp-args (cdr e) v (comp (car e) v (cons %PUSHCONS% c) #f))
        (comp e v (cons %PUSH% c) #f))) ;; apply中の評価は末尾式となることが無い
        (#t (comp-args (cdr exp)
                       vars
                       (comp (car exp)
                             vars
                             (cons (if tail %TAP% %AP%) cont)
                             #f))))

変数の参照

リストでないものは変数か即値の参照ということになる。

      ;; else (pair? exp)
      (if (symbol? exp)
        (let ((loc (frame-loc vars exp))) ;; シンボルの場合は変数の参照
          (if loc
            (if (cdr loc)
              (cons %TLD% (cons (car loc) cont))
              (cons %LD% (cons (car loc) cont)))
            (cons %GLD% (cons exp cont)))) ;; frame-locが偽を返すならグローバル変数
        (cons %LDC% (cons exp cont))))) ;; それ以外なら即値

シンボルの場合はframe-locを使ってフレーム内の位置を導出し、そうでなければグローバル変数としてGLD命令で参照する。
即値の場合はquoteと同様にLDC命令となる。