リスト遊びのための小道具

Ruby でリスト遊びをするときに使ってきた小道具のコーディングを R7RS Scheme に近づけようと見直していました。 Ruby は深い再帰呼び出しが苦手なので、 継続ループで再帰呼び出しをおこなっています。

Ruby のシンボルには、 Ruby の識別子しか使えないので、 Scheme のように多種多様な文字列を利用可能にするべく ListSymbol クラスを追加して、 Symbol と ListSymbol の両方をリストのシンボルとして扱えるようにします。

require 'set'

def string?(x) String === x end
def symbol?(x) Symbol === x or ListSymbol === x end
def number?(x) Numeric === x end
def pair?(x) Pair === x end

OBLIST.intern 手続きで ListSymbol オブジェクトを作るようにしておきます。

class ListSymbol
  ILCHAR = %r/[\x00-\x20"#'(),;\[\\\]`{|}\u007f-\u009f]/

  def initialize(s) @name = s end
  def to_s() ('.' == @name || ILCHAR =~ @name) ? inspect : @name end
  def inspect() '|' + (@name.gsub(ILCHAR) {|c| '\\x%x;' % [c.ord] }) + '|' end
end

def (OBLIST = {}).intern(s)
  self[s] ||= ListSymbol.new(s)
end

Pair オブジェクトでは、 first と second のアクセッサを使えるようにしておきます。

class Pair
  attr_accessor :first, :second
  def self.[](x, y) new(x, y) end
  def initialize(x, y) @first, @second = x, y end
  def inspect() list2string(self) end
end

リストは list 手続きで作成します。

# list(:a, :b, :c) => Pair[:a, Pair[:b, Pair[:c, nil]]]
def list(*a)
  e = nil
  a.reverse_each {|x| e = Pair[x, e] }
  e
end

list の変種で最後の要素に cons アップする、 list* 手続きも良く使います。

# liststar(:a, :b, :c) => Pair[:a, Pair[:b, :c]]
def liststar(*a)
  e = a.pop
  a.reverse_each {|x| e = Pair[x, e] }
  e
end

append 手続きでくっつけるリストは 2 個に絞っています。

# list_append(list(:a, :b), list(:c, :d)) => list(:a, :b, :c, :d)
def list_append(e1, e2)
  r = x = Pair[nil, nil]
  while pair?(e1)
    x.second = Pair[e1.first, nil]
    x = x.second
    e1 = e1.second
  end
  x.second = e2
  r.second
end

リストをひっくり返す reverse 手続きも良く使うので作っておきます。

# list_reverse(list(:a, :b, :c)) => list(:c, :b, :a)
def list_reverse(e1)
  if not pair?(e1)
    e1
  else
    x = nil
    while pair?(e1)
      x = Pair[e1.first, x]
      e1 = e1.second
    end
    x
  end
end

ハッシュを使う方が楽なので出番は少ないのですけど、 ないと困るときがあるので、 連想リストを検索する assoc 手続きを使えるようにしておきます。

# list_assoc(:b, list(list(:a, :A), list(:b, :B), list(:c, :C))) => list(:b, :B)
def list_assoc(x, e)
  while pair?(e)
    return e.first if e.first.first.equal?(x)
    e = e.second
  end
  nil
end

2 つのリストが同一構造になっているかどうかを比較する equal? 手続きも作ります。

def list_equal?(e1, e2)
  r = true
  kont = [e1, e2, nil]
  while r and not kont.nil?
    e1, e2, kont = kont
    if not pair?(e1) and not pair?(e2)
      r = (e1 == e2)
    elsif pair?(e1) and pair?(e2)
      kont = [e1.first, e2.first, [e1.second, e2.second, kont]]
    else
      r = false
    end
  end
  r
end

Andy Wright のパターン言語が便利すぎて慣れ親しみすぎてしまったので、 限定版を使えるようにしておきます。 マクロではなく、 実行時にパターン・マッチングする match? 手続きにしておきます。 この手続きは、 パターンが一致したらハッシュを返し、 一致しないときは false を返します。

# pat : var | _ | () | true | false | string | number | (quote datum)
#     | (pat1 ... patN) | (pat1 ... patN-1 . patN) | (? predicate pat)
#
# list_match?(list(q(:define), Pair[:name, :vars], :body),
#             list(:define, list(:foo, :x), list(:car, :x)))
#=> {:name => :foo, :vars => list(:x), :body => list(:car, :x)}
# list_match?(list(q(:define), pred(:symbol?, :var), :exp),
#             list(:define, list(:foo, :x), list(:car, :x)))
#=> false
# list_match?(list(q(:define), pred(:symbol?, :var), :exp),
#             list(:define, :foo, list(:car, :x)))
#=> {:var => :foo, :exp => list(:car, :x)}

def q(e) list(:quote, e) end
def pred(sym, pat) list(OBLIST.intern('?'), sym, pat) end

def list_match?(pattern, datum)
  r = true
  binding = {}
  kont = [pattern, datum, nil]
  while r and not kont.nil?
    pattern, datum, kont = kont
    if pattern == :_
      #
    elsif symbol?(pattern)
      if binding.key?(pattern)
        r = list_equal?(binding[pattern], datum)
      else
        binding[pattern] = datum
      end
    elsif not pair?(pattern) and not pair?(datum)
      r = (pattern == datum)
    elsif pair?(pattern) and pattern.first == :quote
      if pair?(pattern.second)
        r = list_equal?(pattern.second.first, datum)
      else
        raise "illegal quoted pattern"
      end
    elsif pair?(pattern) and pattern.first == OBLIST.intern('?')
      if pair?(pattern.second)
        r = case pattern.second.first
            when :string? then string?(datum)
            when :number? then number?(datum)
            when :symbol? then symbol?(datum)
            when :pair?   then pair?(datum)
            else raise "unsupported predicate #{pattern.second.first.inspect}"
            end
        if r and pair?(pattern.second.second)
          kont = [pattern.second.second.first, datum, kont]
        end
      else
        raise "illegal predicate pattern"
      end
    elsif pair?(pattern) and pair?(datum)
      kont = [pattern.first, datum.first, [pattern.second, datum.second, kont]]
    else
      r = false
    end
  end
  r and binding
end

最後に、 リストの印字表現を文字列で返す list2string 手続きを作っておきます。 循環参照や単方向グラフを扱うことがあるので、 shared-structure 形式に変換します。 まず、 Pair オブジェクトをマークし、 2 ヶ所以上から参照されている Pair オブジェクトを抜き出します。 その後は、 根から 2 つの内部手続きを交互に再帰呼び出しして文字列へ変換します。

def list2string(root)
  quoted = {:quote => '\'',
            :quasiquote => '`', :unquote => ',', :unquotesplicing => ',@'}
  count = 0
  shared_structure = {}
  visited = {}
  gray = []
  gray.push root if pair?(root)
  while not gray.empty?
    cell = gray.pop
    if not visited[cell.object_id]
      visited[cell.object_id] = true
      gray.push cell.second if pair?(cell.second)
      gray.push cell.first if pair?(cell.first)
    elsif not shared_structure[cell.object_id]
      count += 1
      shared_structure[cell.object_id] = count
    end
  end
  out = ''
  visited.clear
  kont = [:list, root, nil]
  while not kont.nil?
    ctrl, x, kont = kont
    case ctrl
    when :list
      if x.nil?
        out << '()'
      elsif string?(x)
        out << x.inspect
      elsif not pair?(x)
        out << x.to_s
      elsif visited[x.object_id]
        out << '#' << shared_structure[x.object_id].to_s << '#'
      else
        if shared_structure[x.object_id]
          visited[x.object_id] = true
          out << '#' << shared_structure[x.object_id].to_s << '='
        end
        if quoted[car(x)] and pair?(cdr(x)) and null?(cddr(x))
          out << quoted[car(x)]
          kont = [:list, cadr(x), kont]
        else
          out << '('
          kont = [:list, car(x), [:cdlist, cdr(x), kont]]
        end
      end
    when :cdlist
      if x.nil?
        out << ')'
      elsif not pair?(x) or shared_structure[x.object_id]
        out << ' . '
        kont = [:list, x, [:cdlist, nil, kont]]
      else
        out << ' '
        kont = [:list, x.first, [:cdlist, x.second, kont]]
      end
    end
  end
  out
end