簡略版 S 式の LL(1) 文法による構文

Lisp 処理系以外でも S 式を解釈できると何かと便利だろうと、BNF を書いてみることにしました。簡略版で十分と、リストはクォートとドット対に限り、複合リテラルは扱わず、シンボルと整数・浮動小数点数・文字列を字句にまとめ記号 ATOM として受け入れることにします。ブロックコメントは使わないことにして、空白と行単位コメントは字句解析で読み飛ばすことにします。ドットは、リストの同一レベルには一回だけ使え、左側には一個以上、右側には一個のリストが必要です。ドットを使わないリストはゼロ個以上のリストの並びになります。最初に、素直に EBNF 風に記述します。

input : list* ;
list : '(' list* (list '.' list )? ')'
     | "'" list
     | ATOM
     ;

これを BNF へ書き直していきます。input の書き直しは定石通りです。非終端記号 list では、まず2番目以降を新しく非終端記号 pair を作って追い出します。

input : list input
     | /* empty */
     ;
list : '(' pair
     | "'" list
     | ATOM
     ;
pair : list* (list '.' list )? ')'
     ;

非終端記号 pair の規則を選択肢へ分離します。

pair : ')'
     | list list* ('.' list)? ')'
     ;

非終端記号 pair の規則の2番目を追い出します。

pair : ')'
     | list cdr
     ;
cdr  : list* ('.' list)? ')'
     ;

非終端記号 cdr を選択肢に分離します。

cdr  : ')'
     | '.' list ')'
     | list cdr
     ;

これで BNF へ書き換えが完了しました。各非終端記号のそれぞれの規則の先頭記号集合に重複がなく、LL(1) 文法になっています。

input : list input
     | /* empty */
     ;
list : '(' pair
     | "'" list
     | ATOM
     ;
pair : ')'
     | list cdr
     ;
cdr  : ')'
     | '.' list ')'
     | list cdr
     ;

字句解析は Ruby で書いたものを載せておきます。リストを作るには Lisp 5 関数と intern は最低限必要です。シンボルは Ruby の Symbol オブジェクトが拒絶するようなフリーダムな文字列も扱いたいので、別途 SymbolicAtom クラスを作ることにしました。この実装では NIL の扱いを SymbolicAtom のインスタンスにしています。Pair クラスの inspect はドット対を出力します。

require 'strscan'

class Pair
  attr_accessor :car, :cdr
  def initialize(a, d) @car, @cdr = a, d end
  def inspect() '(%s . %s)' % [@car.inspect, @cdr.inspect] end
end

class SymbolicAtom
  DICT = {}
  def self.[](pname) DICT[pname] ||= new(pname) end
  def initialize(pname) @pname = pname.dup.freeze end
  def inspect() @pname end
end

QUOTE = SymbolicAtom['quote']

def eq(x, y) x.equal?(y) end
def atom(x) not x.respond_to?(:car) end
def cons(x, y) Pair.new(x, y) end
def car(x) x.car end
def cdr(x) x.cdr end
def intern(x) SymbolicAtom[x] end

BACKSLASHED = {
  'a' => "\a", 'b' => "\b", 'e' => "\e", 'f' => "\f",
  't' => "\t", 'n' => "\n", 'r' => "\r", 's' => " ",
}

def next_token(scanner)
  # scanner.is_a?(StringScanner) or raise ArgumentError
  nil while scanner.skip(/(?:\s+|;[^\n]*\n)/)
  if scanner.eos?
    cons(:EOS, '')
  elsif scanner.scan(/[()']|[.](?=\s)/)
    c = scanner.matched
    cons(c, c)
  elsif scanner.scan(/[\#\[\]\{\}`]|,@?/)
    raise "reserved punctuation #{scanner.matched}"
  elsif scanner.scan(/"([^\\"]*(?:\\.[^\\"]*)*)"/)
    cons(:ATOM, scanner[1].gsub(/\\(?:([0-7]{3})|x([0-9a-f]{2})|(.))/) {
        $1 ? $1.oct.chr : $2 ? $2.hex.chr
        : BACKSLASHED.key?($3) ? BACKSLASHED[$3] : $3
    })
  elsif scanner.scan(/
    [+-]?
    (?: [0-9]+(?:[.][0-9]*(?:[eE][+-]?[0-9]+)?|[eE][+-]?[0-9]+)
    |   [.][0-9]+(?:[eE][+-]?[0-9]+)?)
  /x) then
    cons(:ATOM, scanner.matched.to_f)
  elsif scanner.scan(/[+-]?(?:0|[1-9][0-9]*)/)
    cons(:ATOM, scanner.matched.to_i)
  elsif scanner.scan(/[^\x00-\x20\x7f\(\)\[\]\{\};]+/)
    x = scanner.matched
    case x
    when 'nil' then cons(:ATOM, nil)
    when 'true' then cons(:ATOM, true)
    when 'false' then cons(:ATOM, false)
    else cons(:ATOM, intern(x))
    end
  else
    raise "syntax error #{scanner}"
  end
end

LL(1) 構文は簡単に予測分岐型構文解析器を作ることができます。これも Ruby 版を載せておきます。構文解析器にブロックを与えると、リスト1個ごとに yield します。ブロックがないときは、最初のリストを返して、残りは捨てます。

LL1TABLE = {
  :input => {
    :EOS  => [],
    true  => [:list, :yield_list, :input],
  },
  :list => {
    '('   => ['(', :pair],              # { $2 }
    "'"   => ["'", :list, :push_quote], # { (cons 'quote (cons $2 nil)) }
    :ATOM => [:push_atom, :ATOM],       # { $2 }
  },
  :pair => {
    ')'   => [')', :push_nil],          # { nil }
    true  => [:list, :cdr, :push_pair], # { (cons $1 $2) }
  },
  :cdr => {
    '.'   => ['.', :list, ')'],         # { $2 }
    ')'   => [')', :push_nil],          # { nil }
    true  => [:list, :cdr, :push_pair], # { (cons $1 $2) }
  },
  '('   => {'('   => [:TERMINAL]},
  ')'   => {')'   => [:TERMINAL]},
  "'"   => {"'"   => [:TERMINAL]},
  '.'   => {'.'   => [:TERMINAL]},
  :ATOM => {:ATOM => [:TERMINAL]},
}

def read_string(input)
  scanner = StringScanner.new(input)
  token = next_token(scanner)
  stack = [:input, :EOS]
  output = []
  while sym = stack.shift
    case sym
    when :push_atom
      output.push cdr(token)
    when :push_nil
      output.push nil
    when :push_pair
      v = output.pop(2)
      output.push cons(v[0], v[1])
    when :push_quote
      v = output.pop
      output.push cons(QUOTE, (cons(v, nil)))
    when :yield_list
      yield output.last if block_given?
    when :TERMINAL
      token = next_token(scanner)
    when :EOS
      eq(car(token), :EOS) or raise "syntax error #{scanner.inspect}"
      break
    else
      rule = LL1TABLE[sym] or raise "Grammar error #{sym.inspect}"
      alt = rule[car(token)] || rule[true]
      alt or raise "syntax error #{scanner.inspect}"
      stack.unshift *alt
    end
  end
  output.first
end

実行例です。

$ irb
1.9.3-p286 :001 > load 'read_string.rb'
true
1.9.3-p286 :002 > read_string("((a b) . (c d e)) (f g) h") {|e| p e }
((a . (b . nil)) . (c . (d . (e . nil))))
(f . (g . nil))
h
 => ((a . (b . nil)) . (c . (d . (e . nil)))) 
1.9.3-p286 :003 > quit