Wirth VM で 1960 年代の S 式構文解析

Niklaus Wirth 表駆動解析法 (Compiler Construction) は、 LL (1) 文法を認識する再帰下降型の構文解析をグラフ・データ構造で表現したものです。 それを命令コード化して VM にしたものを、 暫定的に Wirth VM と呼ぶことにします。 VM の命令は 4 つです。

    終端記号命令    -  terminal 字句シンボル   成功時番地  失敗時番地
    非終端記号命令  -  nonterminal 番地        成功時番地  失敗時番地
    成功命令        -  empty                   成功時番地
    合成属性命令    -  yield 手続きシンボル    成功時番地

Wirth VM は、 バックトラックを使わない Parsing Expression Grammar (PEG) のサブセットをコンパイルして動かすのに向いています。 いまどき、 そのような構文は少なくなっているので、 1960 年代の LISP-1、 LISP-1.5 の S 式を解析してみます。 当時の S 式は素朴で構文解析を作る遊びの素材に向いています。 それでも、 S 式の字句の認識に先読みが必要なので、 そこは字句解析におしつけることにします。 すると、 構文からバックトラックがなくなって LL(1) 文法になります。

expr <- ATOM / ['] expr / '(' ( ')' / expr+ ('.' expr)? ')' )

この構文に合成属性を追加し、 Wirth VM コードにハンド・コンパイルします。 先頭は番地、 続いて、 命令コード、 シンボル・オペランド、 成功時ジャンプ先オペランド、 失敗時と並べます。 先頭の番地はなくても良いのですが、 あった方が読みやすいのでいれています。 ゼロ番地の命令は穴埋めで、 実行開始番地は 1 です。 ジャンプ先がゼロの場合は、 飛び先なしとします。

#@<GRAMMAR@>=
  GRAMMAR = [
    [ 0, :empty, 0,          0,  0],
  # expr <- atom {gotatom}
    [ 1, :terminal, :ATOM,   2,  3],
    [ 2, :yield, :gotatom,   0,  0],
  # expr <- "'" expr {gotquote}
    [ 3, :terminal, "'",     4,  6],
    [ 4, :nonterminal, 1,    5,  0],
    [ 5, :yield, :gotquote,  0,  0],
  # expr <- '(' ')' {gotnil}
    [ 6, :terminal, '(',     7,  0],
    [ 7, :terminal, ')',     8,  9],
    [ 8, :yield, :gotnil,    0,  0],
  # expr <- '(' expr {gotlist} (expr {pushexpr})* ( ')' {revnil} / '.' expr ')' {revstar} )
    [ 9, :empty, 0,         10,  0],
    [10, :nonterminal, 1,   11,  0],
    [11, :yield, :gotlist,  12,  0],
    [12, :terminal, ')',    17, 13],
    [13, :terminal, '.',    18, 14],
    [14, :empty, 0,         15,  0],
    [15, :nonterminal, 1,   16,  0],
    [16, :yield, :pushexpr, 12,  0],
    [17, :yield, :revnil,    0,  0],
    [18, :nonterminal, 1,   19,  0],
    [19, :terminal, ')',    20,  0],
    [20, :yield, :revstar,   0,  0],
  ]

リストの項目を左から右へと導出していくため、 リストの合成は append 手続きと同じです。 pushexpr 合成属性で 1 個ずつ項目をリストの先頭に追加し、 revnil 合成属性で並べ直します。 revstar は並べ直しの最後の cdr 部にドット対の右 expr を使う変種です。
ペアは Struct、 シンボルは String のラッパとします。

#@<Symb and Pair>=
class Symb
  def initialize(s) @pname = s end
  def inspect() @pname end
end

QUOTE = Symb.new('quote')

Pair = Struct.new(:head, :tail)
class Pair
  def inspect() "(#{self.head.inspect} . #{self.tail.inspect})" end
end

S 式記述から datum を作るために、 合成属性手続きに 2 つの引数を与えることにします。 引数の 1 つ目はリストでペアか nil です。 このリストの car 部が datum になるように合成していきます。 引数の 2 つ目は終端記号の値です。 構文解析器の値リストの初期値は nil です。

#@<actions>=
  def gotatom(value, dollar)
    # V D => (D . V) D
    Pair[dollar, value]
  end

  def gotquote(value, _)
    # (x . V) => ((quote x) . V)
    Pair[Pair[QUOTE, Pair[value.head, nil]], value.tail]
  end

  def gotnil(value, _)
    # V => (nil . V)
    Pair[nil, value]
  end

  def gotlist(value, _)
    # (x . V) => ((x) . V)
    Pair[Pair[value.head, nil], value.tail]
  end

  def pushexpr(value, _)
    # (x y . V) => ((x . y) . V)
    x = value.head; value = value.tail
    Pair[Pair[x, value.head], value.tail]
  end

  def revnil(value, _)
    # ((z y x) . V) => ((x y z) . V)
    Pair[reverse(value.head, nil), value.tail]
  end

  def revstar(value, _)
    # (t (z y x) . V) => ((x y z . t) . V)
    x = value.head; value = value.tail
    Pair[reverse(value.head, x), value.tail]
  end

  def reverse(e, r=nil)
    while not e.nil?
      r, e = Pair[e.head, r], e.tail
    end
    r
  end

破壊操作を解禁すると、 Pair オブジェクトの消費をおさえることができます。

  def gotquote(value, _)
    # #1=(x . V) => #1=((quote x) . V)
    value.head = Pair[QUOTE, Pair[value.head, nil]]
    value
  end

  def pushexpr(value, _)
    # #1=(x . #2=(y . V)) => #2=(#1=(x . y) . V)
    t = value; value = value.tail
    t.tail = value.head; value.head = t
    value
  end

  def revnil(value, _)
    # #1=(#2=(z . #3=(y . #4=(x . nil))) . V) => #1=(#4=(x . #3=(y . #2=(z . nil))) . V)
    value.head = reverse!(value.head, nil)
    value
  end

  def revstar(value, _)
    # (t . #1=(#2=(z . #3=(y . #4=(x . nil))) . V)) => #1=(#4=(x . #3=(y . #2=(z . t))) . V)
    x = value.head; value = value.tail
    value.head = reverse!(value.head, x)
    value
  end

  def reverse!(e, r=nil)
    while not e.nil?
      # #1=(x . #2#) r => #2# #1=(x . r)
      t = e.tail; e.tail = r; r = e; e = t
    end
    r
  end

字句解析と構文解析ループでこれらを駆動します。

#!/usr/bin/env ruby

require 'strscan'

#@<Symb and Pair>

class SexprParser
#@<GRAMMAR@>

  # 余談  Perl 5.x : [^()[^:graph:]]+ は "abc" の "abc" にマッチします。
  #       Ruby 2.x : "a" にしかマッチしてくれません。 仕様? バグ?
  def next_token(scanner)
    scanner.scan(/\s+/)
    if scanner.scan(/[()']/)
      [scanner[0], scanner[0]]
    elsif scanner.scan(/[.](?=[\s()'])/)
      ['.', scanner[0]]
    elsif scanner.scan(/[+-]?[0-9]+/)
      [:ATOM, scanner[0].to_i]
    elsif scanner.scan(/[!$%&*+,\-.\/0-9:<=>?@A-Z\[\\\]^_`a-z{|}~]+/)
      [:ATOM, Symb.new(scanner[0])]
    end
  end

#@<actions>

  def parse(source)
    scanner = StringScanner.new(source)
    token_kind, token_value = next_token(scanner)
    value = dollar = kont = nil
    match = true
    goal = 1
    while goal > 0
      _, op, sym, gsuc, galt = GRAMMAR[goal]
      case op
      when :empty
        match = true
        goal = gsuc
      when :yield
        value = send(sym, value, dollar)
        goal = gsuc
      when :terminal
        match = (sym == token_kind)
        if match
          dollar = token_value
          token_kind, token_value = next_token(scanner)
        end
        goal = match ? gsuc : galt
      when :nonterminal
        kont = [goal, kont]
        goal = sym
      end
      while goal == 0 and not kont.nil?
        goal, kont = kont
        _, op, sym, gsuc, galt = GRAMMAR[goal]
        goal = match ? gsuc : galt
      end
    end
    match or raise SyntaxError
    value.head
  end

  def example
    p parse("a")                #=> a
    p parse("()")               #=> nil
    p parse("(a)")              #=> (a . nil)
    p parse("(a b)")            #=> (a . (b . nil))
    p parse("(a b c d)")        #=> (a . (b . (c . (d . nil))))
    p parse("(a . b)")          #=> (a . b)
    p parse("(a . (b . c))")    #=> (a . (b . c))
    p parse("(a b . (c . d))")  #=> (a . (b . (c . (d . nil))))
    p parse("'a")               #=> (quote . (a . nil))
    p parse("'()")              #=> (quote . (nil . nil))
    p parse("'(a)")             #=> (quote . ((a . nil) . nil))
  end
end

SexprParser.new.example