継続渡しを使わずに A 正規形

論文、Flanagan 等 The Essence of Compiling with Continuations (以下 FLA1993) 図 2 の CEK マシンを直接動かしてみる遊びを以前やってみたのですが、この論文の肝は言うまでもなく、コンパイラの中間表現である A 正規形の提唱にあります。A 正規形は静的単一代入形式の N アドレスコードの一つであり、継続渡しスタイルに変換したものをさらにβ簡約したものと等価であることがこの論文で証明されています。

さて、FLA1993 の図 9 に型なしラムダ式であるコア Scheme のデータムを A 正規形に変換するアルゴリズムが記載されており、継続渡しを使ってエレガントに記述してあります。このアルゴリズムは線形時間で処理できて綺麗なのですけど、C 言語などで継続渡しを記述するのはめんどくさいため、処理時間を犠牲にして、継続渡しを使わずに A 正規形を得るやりかたを考えてみました。

今回は素朴なやりかたを採用しました。データムの部分木を A 正規形に変換すると、入れ子の let が得られるため、複数の入れ子 let を適切につなげば良いわけです。つなぎかえが必要になるのは、let 形式、if0 形式、アプリケーションのそれぞれです。

let 形式では束縛対の項 M を変換したものと、本体の項 N をそれぞれまず変換します。そして、項 M を変換した項の底に let 形式を追加し、さらにその本体に項 N を変換したものをつなぎます。

A-NORM[(let (x M) N)]
  A-NORM[M] => (let (t1 n1) (let (t2 n2) (let (t3 n3) n8)))
  A-NORM[N] => (let (t4 n4) (let (t5 n5) (let (t7 n7) n9)))
  A-NORM[(let (x M) N)]
    => (let (t1 n1) (let (t2 n2) (let (t3 n3)
         (let (x n8)
           (let (t4 n4) (let (t5 n5) (let (t7 n7) n9)))))))

if0 形式では、条件項 M1 を変換した項の底に if0 形式を追加し、真のときの項 M2 と偽のときの項 M3 をそれぞれ変換して埋め込みます。

A-NORM[(if0 M1 M2 M3)]
  A-NORM[M1] => (let (t1 n1) (let (t2 n2) n7))
  A-NORM[M3] => (let (t3 n3) (let (t4 n4) n8))
  A-NORM[M4] => (let (t5 n5) (let (t6 n6) n9))
  A-NORM[(if0 M1 M2 M3)]
    => (let (t1 n1) (let (t2 n2)
         (let (t7 n7)
           (if0 t7
             (let (t3 n3) (let (t4 n4) n8))
             (let (t5 n5) (let (t6 n6) n9)))))

アプリケーションは、実引数の let の入れ子を外に追い出し、適宜、let を追加します。

A-NORM[(M1 M2 M3)]
  A-NORM[M1] => f
  A-NORM[M2] => (let (t1 n1) (let (t2 n2) n5))
  A-NORM[M3] => (let (t3 n3) (let (t4 n4) n6))
  A-NORM[(M1 M2 M3)]
   => (let (t1 n1) (let (t2 n2)
        (let (t5 n5)
          (let (t3 n3) (let (t4 n4)
            (let (t6 n6)
              (f t5 t6)))))))

データムを作るために Atom クラスと Pair クラスを使います。nil には Rubynil を使います。なお newvar で作るシンボルは、伝統的マクロの gensym と同じやりかたで入力データム中のシンボルと衝突しないようにしています。

リファクタリングしたもの ⇒ 継続渡しを使わずに A 正規形 (改訂版)

class Atom
  DICT = {}
  attr_reader :pname
  def symbol?() true end
  def self.[](s) DICT[s] ||= new(s) end
  def self.newvar
    @@counter ||= 0
    @@counter += 1
    new('t' + @@counter.to_s)
  end
  def initialize(pname) @pname = pname.dup.freeze end
  def inspect() @pname end
end

class Pair
  attr_accessor :first, :last
  def self.[](a, d) new(a, d) end
  def initialize(a, d) @first, @last = a, d end
  def inspect() '(%s . %s)' % [@first.inspect, @last.inspect] end
end

def intern(name) Atom[name] end

QUOTE = intern('quote')
LAMBDA = intern('lambda')
LET = intern('let')
IF0 = intern('if0')

def list(*a)
  r = e = Pair[nil, nil]
  a.each do |x|
    e.last = Pair[x, nil]
    e = e.last
  end
  r.last
end

def a_normalize(m)
  if not Pair === m
    return m
  end
  case m.first
  when QUOTE
    return m
  when LAMBDA
    params = m.last.first
    m1 = m.last.last.first
    n1 = a_normalize(m1)
    return list(LAMBDA, params, n1)
  when LET
    x = m.last.first.first
    n1 = a_normalize(m.last.first.last.first)
    n2 = a_normalize(m.last.last.first)
    bindings = []
    while Pair === n1 and LET === n1.first
      bindings.push n1.last.first
      n1 = n1.last.last.first
    end
    n = list(LET, list(x, n1), n2)
    bindings.reverse_each{|xm| n = list(LET, xm, n) }
    return n
  when IF
    n1 = a_normalize(m.last.first)
    bindings = []
    while Pair === n1 and LET === n1.first
      bindings.push n1.last.first
      n1 = n1.last.last.first
    end
    if Pair === n1 and n1.first != LAMBDA and n1.first != QUOTE
      x = Atom.newvar
      bindings.push list(x, n1)
      n1 = x
    end
    n2 = a_normalize(m.last.last.first)
    n3 = a_normalize(m.last.last.last.first)
    n = list(IF, n1, n2, n3)
    bindings.reverse_each{|xm| n = list(LET, xm, n) }
    return n
  else
    bindings = []
    n0 = n1 = Pair[nil, nil]
    while not m.nil?
      n = a_normalize(m.first)
      m = m.last
      if Pair === n and n.first != LAMBDA and n.first != QUOTE
        while Pair === n and LET === n.first
          bindings.push n.last.first
          n = n.last.last.first
        end
        x = Atom.newvar
        bindings.push list(x, n)
        n = x
      end
      n1.last = Pair[n, nil]
      n1 = n1.last
    end
    n = n0.last
    bindings.reverse_each{|xm| n = list(LET, xm, n) }
    return n
  end
end