RubyでSchemeぽいの書く(2)

明日数値計算の試験なので(まったく関係無い)Scheme実装がよく進んだ。

C:\hoge\docs\rbdsp>ruby rbdsp.rb
> (+ 1 2 3 4)
10
> (eq? 3 (+ 1 2))
#t
> (define ls (list 1 2 3))
ls
> ls
(1 2 3)
> (eq? ls (list 1 2 3))
#f
> ^Z
good bye

このあたりまでわりとあっさり。構文解析が適当なのと、もちろん実行効率は何も考えてませんが。

class Pair
  def initialize(car, cdr)
    @car = car
    @cdr = cdr
  end
  def is_pair(x)
    x.instance_of?(Pair)
  end
  def car
    @car
  end
  def cdr
    @cdr
  end
  def setcar(a)
    List.new(a, @cdr)
  end
  def setcdr(d)
    if(!d.instance_of?(List))
      Pair.new(@car, d)
    else
      List.new(@car, d)
    end
  end 
  def set!(a, d)
    @car = a
    @cdr = d
  end
  def surface
    "("+@car.surface+" . "+@cdr.surface+")"
  end
end
class List < Pair
  NILS = List.new(0,0)
  def initialize(x, xs)
    set!(x, xs)
  end
  def list?(x)
    x.instance_of?(List)
  end
  def append(xs)
    if(xs.instance_of?(List))
      if(@cdr==NILS)
        List.new(@car, xs)
      else
      List.new(@car, @cdr.append(xs))
      end
    else
      Pair.new(@car, xs)
    end
  end
  def surface
    str = "("
    cdr = self
    while(true)
      str += cdr.car.surface
      cddr = cdr.cdr
      if(cddr==NILS)
        break
      else
        str += " "
      end
      cdr = cddr
    end
    str += ")"
  end
  def each &block
    array = []
    cdr = self
    while(cdr!=NILS)
      array.push(block.call(cdr.car))
      cdr = cdr.cdr
    end
    array.to_list
  end
  def length
    len = 0
    each{|x| len+=1}
    len
  end
  include Enumerable
end
class Array
  def to_list
    xs = List::NILS
    self.reverse_each{|x|
      xs = List.new(x, xs)
    }
    xs
  end
  def surface
    "#("+map{|x| x.surface}.join(" ")+")"
  end
end
class Symbol
  def surface
    to_s
  end
end
class String
  def surface
    '"'+self+'"'
  end
end
class Integer
  def surface
    to_s
  end
end
class TrueClass
  def surface
    "#t"
  end
end
class FalseClass
  def surface
    "#f"
  end
end
class NilClass
  def surface
    "#<undef>"
  end
end
class Proc
  def surface
    "#<procedure>"
  end
end
class ParseException < Exception
end
class Parser
  S_INT = /\-?\d+/
  S_STR = /"(?:\.|[^"])*"/
  S_SYM = /[^\s\r\n\(\)\#\'\`\.]+/
  S_LPAR = /\(/
  S_RPAR = /\)/
  S_DOT = /\./
  S_ITEM = /(?:#{S_INT}|#{S_STR}|#{S_SYM}|#{S_LPAR}|#{S_RPAR}|#{S_DOT})/m
  S_COMMENT = /;.*/
  def initialize
    @input = ''
  end
  def input(input)
    @input += input.gsub(S_COMMENT, '')
  end
  def parse
    mat = S_ITEM.match(@input)
    if(!mat)
      return nil
    end
    @input = mat.post_match
    item = mat[0]
    if(item =~ S_INT)
      item.to_i
    elsif(item =~ S_STR)
      item[1..item.length-2]
    elsif(item =~ S_SYM)
      item.intern
    elsif(item =~ S_LPAR)
      array = []
      while((pret = parse)!=S_RPAR)
        if(pret==S_DOT)
          cdr = parse
          rpar = parse
          if(rpar!=S_RPAR)
            raise ParseException.new('. のあとに色々入れすぎ')
          end
          return array.to_list.append(cdr)
        end
        array.push(pret)
      end
      array.to_list
    elsif(item =~ S_RPAR)
      S_RPAR
    elsif(item =~ S_DOT)
      S_DOT
    end
  end
end
class EvalException < Exception
end
class Machine
  ADD = proc{|m, xs|
    sum = 0
    xs.each{|x| sum+=m.eval(x)}
    sum
  }
  SUB = proc{|m, xs|
    if(xs.length==0)
      0
    elsif(xs.length==1)
      -1 *m.eval(xs.car)
    else
      sum = m.eval(xs.car)
      xs.cdr.each{|x| sum-=m.eval(x)}
      sum
    end
  }
  MUL = proc{|m, xs|
    sum = 1
    xs.each{|x| sum*=m.eval(x)}
    sum
  }
  DIV = proc{|m, xs|
    if(xs.length==0)
      1
    else
      sum = m.eval(xs.car)
      xs.cdr.each{|x| sum/=m.eval(x)}
      sum
    end
  }
  PRINT = proc{|m, xs|
    xs.each{|x| print m.eval(x).surface}
    puts
  }
  LIST = proc{|m, xs|
    xs
  }
  LISTP = proc{|m, xs|
    xs.instance_of?(List)
  }
  LAMBDA = proc{|m, xs|
  }
  DEFINE = proc{|m, xs|
    if(xs.length==2)
      sym = xs.car
      if(sym.instance_of?(Symbol))
        val = m.eval(xs.cdr.car)
        m.define(sym, val)
        return
      end
    end
    raise EvalException.new("defineの引数変")
  }
  EQP = proc{|m, xs|
    if(xs.length==2)
      v1 = m.eval(xs.car)
      v2 = m.eval(xs.cdr.car)
      return v1==v2
    end
    raise EvalException.new("eq?の引数変")
  }
  def initialize
    @symtable = Hash.new
    @symtable.store(:+, ADD)
    @symtable.store(:-, SUB)
    @symtable.store(:*, MUL)
    @symtable.store(:/, DIV)
    @symtable.store(:print, PRINT)
    @symtable.store(:define, DEFINE)
    @symtable.store(:eq?, EQP)
    @symtable.store(:list, LIST)
    @symtable.store(:list?, LISTP)
  end
  def define(sym, val)
    @symtable.store(sym, val)
  end
  def eval(item)
    if(item.instance_of?(List))
      proc_sym = item.car
      proc_obj = @symtable[proc_sym]
      proc_obj.call(self, item.cdr)
    elsif(item.instance_of?(Symbol))
      sym_obj = @symtable[item]
      sym_obj
    else
      item
    end
  end
end

begin
  machine = Machine.new

  #input = ARGF.read
  #pars = Parser.new(input)
  pars = Parser.new
  print "> "
  ARGF.each{|line|
    pars.input(line)
    while(item = pars.parse)
      #print "; ", item.surface, "\n"
      print machine.eval(item).surface, "\n"
    end
    print "> "
  }
  puts "good bye"
rescue ParseException => pex
  print pex
end