テンプレート・モナドのシミュレーション

おもしろそうなので、「檜山正幸のキマイラ飼育記 - 圏論やモナドが、どうして文書処理やXMLと関係するのですか?」の 8 つのプログラミング課題を ruby で書いてみました。題材に引きづられてしまって、オブジェクト指向プログラミング言語 ruby という感じではないコーディングになってしまったのは、ご愛嬌。

プログラミング課題 1: お好みのプログラミング言語を使って、与えられたテキスト(文字列)データが、正しく(well-formedな)ネストしたテキスト(nested text)であるかどうかを判定するプログラムを書いてください。

{ と } がバランスして現れているかどうか判定しなさいという問題です。\ でエスケープもやりなさいと。問題からは読み取れませんが、空の括弧は許さないということに勝手に解釈することにしました。こういう問題は、パーサを書くに限ります。LL(1) 文法を使えばいいでしょう。まずは BNF で記述。

WELL_FORMED_NESTED_TEXT : S eos ;
S  : T S | /*empty*/ ;
T  : '{' T S '}' | string ;
string : /\A(?:\\.[^\\\{\}]*)+|[^\\\{\}]+(?:\\.[^\\\{\}]*)*\z/

パーサの出力は次のようにすることにしました。括弧の部分は、先頭と末尾が括弧になっている配列へ変えます。多段でテンプレート処理をする課題が後ほど出てきますので、エスケープ文字は、エスケープされたまま文字列に残すことにしました。括弧がバランスしていないときは、SyntaxError の例外を発生させることにしました。

parse_curly("a") #=> ["a"]
parse_curly("a\\{b\\}c") #=> ["a\\{b\\}c"]
parse_curly("\\{a{b\\}}c") #=> ["\\{a", ['{', "b\\}", '}'], "c"]
parse_curly("a{{b}c}") #=> ["a", ['{', ['{', "b", '}'], "c", '}']]
parse_curly("a{{b}c") #=> raise SyntaxError

パーサは長いので、このエントリの末尾に置いておきます。できたパーサを読み込んで、例外が生じてなければ、正しくネストしているとして、true を表示します。そうでないときは、エラーメッセージを表示します。

require 'parse_curly'

begin
  parse_curly("\\{a{{{b}}c\\}{d}}e")
  puts true
rescue SyntaxError
  $stderr.puts $!
  exit 2
end

プログラミング課題 2: 与えられたテキスト・データが正しくネストしたテキストであるとき(実際は、入力の形式を気にしなくてもよい)、エスケープしてない括弧('{'と'}')を取り去ってしまうプログラムを書いてください。

パーサから配列のツリーが得られたら、根っこから探索していき、文字列を集めて返します。ブロックを扱う際は、先頭と末尾の括弧の処理をスキップさせます。

require 'parse_curly'

def process(template)
  strip_all_curly(parse_curly(template), '')
end

def strip_all_curly(tree, result)
  tree.each do |e|
    if String === e
      result << e
    else
      strip_all_curly(e[1..-2], result)
    end
  end
  result
end

puts process("\\{a{{{b}}c\\}{d}}e")

プログラミング課題 3:(けっこう面倒だから、やらなくていいけど)上記の例を実行できるようなテンプレート処理プログラムを書いてみてください。

プレースホルダとみなすのは、末端ブロックだけだと課題 3 から数段落後に記述がありますので、それに従いました。末端ブロック以外の括弧の扱いの指定がありませんが、残すことにしました。また、テンプレート処理系の多くの流儀に従い、コンテキストに未定義のプレースホルダは空文字列に置き換えることにしました。なお、ruby の Array オブジェクトは to_s メッセージを送ると、かってに入れ子を展開して文字列にしてくれますので、置き換えた配列を作ればいいだけです。楽。

require 'parse_curly'

def process(template, context)
  subst(parse_curly(template), context).to_s
end

def subst(tree, context)
  tree.collect {|e|
    if String === e
      e
    elsif e.size == 3 && e[0] == '{' && String === e[1] && e[2] == '}'
      context[e[1]] || ''
    else
      subst(e, context)
    end
  }
end

p process("\\{a{{{b}}c\\}{d}}e", {'b' => 'HOGE', 'd' => 'FUGA'})

プログラミング課題 4:(これも割と面倒)ネストしたテキストの中から、末端ブロックだけを抜き出して列挙するプログラムを書いてください。

ツリーを探索して末端ブロックを配列に拾い出します。末端ブロックは、要素数 3 の配列で、2番目の要素が文字列であるとして判定しています。先頭と末尾に括弧があるかどうかを判定はなくても動きますが、念のために。

require 'parse_curly'

def process(template)
  extract_leaves(parse_curly(template), [])
end

def extract_leaves(tree, result)
  tree.each do |e|
    next if String === e
    if e.size == 3 && e[0] == '{' && String === e[1] && e[2] == '}'
      result << e.to_s
    else
      extract_leaves(e, result)
    end
  end
  result
end

p process("\\{a{{{b}}{c}\\}{d}}e")

プログラミング課題 5: ネストしたテキストに対して、末端ブロック以外の'{'と'}'(エスケープしてない括弧)を取り去ってしまうプログラムを書いてください。

課題 2 に加えて、末端ブロックを特別扱いさせるだけです。

require 'parse_curly'

def process(template)
  strip_branch_curly(parse_curly(template), '')
end

def strip_branch_curly(tree, result)
  tree.each do |e|
    if String === e
      result << e
    elsif e.size == 3 && e[0] == '{' && String === e[1] && e[2] == '}'
      result << e.to_s
    else
      strip_branch_curly(e[1..-2], result)
    end
  end
  result
end

p process("\\{a{{{b}}c\\}{d}}e")

プログラミング課題 6:与えられたテキスト・データが正しくネストしたテキストであるとき(入力は正しいと仮定してよい)、そのネスト・レベルを求めるプログラムを書いてください。

最大のネストの深さを求めよという意味だと解釈しました。

require 'parse_curly'

def process(template)
  max_nest_level(parse_curly(template), 0)
end

def max_nest_level(tree, result)
  tree.collect {|e|
    if String === e
      result
    else
      max_nest_level(e[1..-2], result + 1)
    end
  }.max
end

p process("\\{a{{{{b}}}c\\}{d}}e")

プログラミング課題 7:お好みの高階関数型言語(なーに、JavaScriptで十分)で、第2引数に関数を受け取るprocessTemplateと、関数としてのコンテキストを拡張する高階関数extを書いてください。

課題 3 のテンプレート展開関数から変わったのは、process だけです。ruby では Proc オブジェクトが角括弧メッセージを受け取ると関数コールになりますので、ハッシュと区別をする必要がありません。

require 'parse_curly'

def process(template, context)
  if String === template
    subst(parse_curly(template), context).to_s
  else
    lambda{|k| process(template[k], context) }
  end
end

def subst(tree, context)
  tree.collect {|e|
    if String === e
      e
    elsif e.size == 3 && e[0] == '{' && String === e[1] && e[2] == '}'
      context[e[1]] || ''
    else
      subst(e, context)
    end
  }
end

template = "{a} {b}"
hash1 = {'a' => 'u {c} w', 'b' => '{d} y z'}
hash2 = {'c' => 'V', 'd' => 'X'}
p process(template, process(hash1, hash2))
p process(process(template, hash1), hash2)
func1 = lambda{|k| hash1[k] }
func2 = lambda{|k| hash2[k] }
p process(template, process(func1, func2))
p process(process(template, func1), func2)

プログラミング課題 8: 言語機能としてモナドをサポートしているプログラミング言語(そう多くはないでしょう :-))で、テンプレート・モナドを書いてみてください。あるいは、お好みの言語で、テンプレート・モナド機構をシミュレートしてください。

課題 7 の 2 つの関数を流用してシミュレートさせてみました。モナド則の 3 つの式は true になります。関数合成の展開は手作業でやっています。

ext = lambda{|con| lambda{|t| process(t, con) }}
unit = lambda{|k| "{#{k}}" }
con1  = lambda{|k| {'a' => 'u {c} w', 'b' => '{d} y z'}[k] }
con2  = lambda{|k| {'c' => 'V', 'd' => 'X'}[k] }
p (ext[unit])["a{b}c"] == "a{b}c"
p (ext[con1])[unit['a']] == con1['a']
p (ext[(ext[con2])[con1]])['{a} {b}'] == ((ext[con2])[ext[con1]])['{a} {b}']

最後に、課題 1 で作ったパーサを。LL(1) 文法の再帰下降型をループで記述した典型的なワンパターンモノなので、説明を省略します。

def parse_curly(s)
  token_list = s.scan(
    /\G(?:\{|\}|(?:\\.[^\\\{\}]*)+|[^\\\{\}]+(?:\\.[^\\\{\}]*)*)/m
  ) + [:eos]
  result = [[]]
  value = nil
  sym_stack = [:S, :eos]
  while sym = sym_stack.shift
    token = token_list.first
    case sym
    when :S   # T S | /*empty*/ ;
      if String === token && '}' != token
        sym_stack.unshift :T, :S
      end
    when :T   # '{' T S '}' | string ;
      if '{' === token
        sym_stack.unshift \
          '{', lambda{ result.push result.last.push([value]).last },
          :T, :S,
          '}', lambda{ result.pop.push value }
      elsif String === token && '}' != token
        sym_stack.unshift :string, lambda{ result.last.push value }
      else
        raise SyntaxError, "expect '{' or string but #{token.inspect}."
      end
    # terminals
    when '{', '}'
      token == sym \
        or raise SyntaxError, "expect '#{sym}' but #{token.inspect}."
      value = token_list.shift
    when :string
      String === token && token != '{' && token != '}' \
        or raise SyntaxError, "expect string but #{token.inspect}."
      value = token_list.shift
    when Proc then sym.call
    when :eos then break
    else raise "grammer error"
    end
  end
  result.first
end