contvm.rb

# contvm.rb

=begin
instruction set:

push object
pushclosure closure
pop
defvar symbol
getvar symbol
call argc
ret
=end

class VM
  def initialize(iseq, env)
    @iseq = iseq
    @stack = []
    @env = env
  end
  
  def run
    while insn = @iseq.shift
      # puts "insn: #{insn}"
      case insn.opcode
      when :push
        @stack.push(insn.operand)
      when :pushclosure
        closure = insn.operand
        closure.setenv(@env)
        @stack.push(closure)
      when :pop
        @stack.pop
      when :defvar
        symbol = insn.operand
        value = @stack.last
        @env.defvar(symbol, value)
      when :getvar
        symbol = insn.operand
        value = @env.getvar(symbol)
        @stack.push(value)
      when :call
        argc = insn.operand
        args = @stack.pop(argc)
        func = @stack.pop
        func.call(self, args)
      when :ret
        retval = @stack.pop
        cont = @stack.pop
        setcc(cont.iseq, cont.stack, cont.env)
        @stack.push(retval)
      else
        raise "unknown instruction: #{insn}"
      end
      # puts "stack: #{@stack}"
    end
  end
  
  def push(object)
    @stack.push(object)
  end
  
  def getcc
    unless @iseq.empty?
      if @iseq.first.opcode == :ret
        cont = @stack.last
        return cont
      end
    end
    Cont.new(@iseq, @stack, @env)
  end
  
  def setcc(iseq, stack, env)
    @iseq = iseq
    @stack = stack
    @env = env
  end
end

class Insn
  attr_reader :opcode, :operand
  
  def initialize(opcode, operand)
    @opcode = opcode
    @operand = operand || "-"
  end
  
  def to_s
    inspect
  end
  
  def inspect
    "(#{@opcode} #{@operand})"
  end
end

class Env
  def initialize
    @frames = []
  end
  
  def initialize_copy(env)
    @frames = @frames.dup
  end
  
  def push_frame(frame)
    @frames.push(frame)
  end
  
  def defvar(symbol, value)
    @frames.last[symbol] = value
  end
  
  def getvar(symbol)
    @frames.reverse_each do |frame|
      if value = frame[symbol]
        return value
      end
    end
    raise "unbound variable: #{symbol}"
  end
end


class Subr
  def initialize(name, proc)
    @name = name
    @proc = proc
  end
  
  def call(vm, args)
    @proc.call(vm, *args)
  end
  
  def to_s
    inspect
  end
  
  def inspect
    "#<subr #{@name}>"
  end
end

class Closure
  def initialize(params, iseq)
    @params = params
    @iseq = iseq
  end
  
  def setenv(env)
    @env = env
  end
  
  def call(vm, args)
    iseq = @iseq.dup
    cont = vm.getcc
    frame = {}
    @params.each_with_index do |param, i|
      if arg = args[i]
        frame[param] = arg
      else
        raise "wrong number of arguments for #{self}: #{args}"
      end
    end
    env = @env.dup
    env.push_frame(frame)
    vm.setcc(iseq, [cont], env)
  end
  
  def to_s
    inspect
  end
  
  def inspect
    "#<closure #{@params}>"
  end
end

class Cont
  attr_reader :iseq, :stack, :env
  
  def initialize(iseq, stack, env)
    @iseq = iseq
    @stack = stack
    @env = env
  end
  
  def initialize_copy(cont)
    @iseq = @iseq.dup
    @stack = @stack.dup
    @env = @env.dup
  end
  
  def call(vm, args)
    vm.setcc(@iseq.dup, @stack.dup, @env.dup)
    vm.push(args[0])
  end
  
  def inspect
    "#<cont 0x#{object_id.to_s(16)}>"
  end
end

class GlobalFrame < Hash
  def initialize
    self[:add] = Subr.new("add", lambda{|vm, a, b| vm.push(a + b) })
    self[:sub] = Subr.new("sub", lambda{|vm, a, b| vm.push(a - b) })
    self[:mul] = Subr.new("mul", lambda{|vm, a, b| vm.push(a * b) })
    self[:div] = Subr.new("div", lambda{|vm, a, b| vm.push(a / b) })
    self[:lt] = Subr.new("lt", lambda{|vm, a, b| vm.push(a < b) })
    self[:eq] = Subr.new("eq", lambda{|vm, a, b| vm.push(a == b) })
    self[:gt] = Subr.new("gt", lambda{|vm, a, b| vm.push(a > b) })
    self[:le] = Subr.new("le", lambda{|vm, a, b| vm.push(a <= b) })
    self[:ge] = Subr.new("ge", lambda{|vm, a, b| vm.push(a >= b) })
    self[:print] = Subr.new("print", lambda{|vm, n| vm.push(puts(n)) })
    call_if = lambda do |vm, cond, thunk|
      if cond
        thunk.call(vm, [])
      else
        vm.push(nil)
      end
    end
    self[:call_if] = Subr.new("call_if", call_if)
    call_cc = lambda do |vm, func|
      cont = vm.getcc.dup
      func.call(vm, [cont])
    end
    self[:call_cc] = Subr.new("call_cc", call_cc)
  end
end

def insn(opcode, operand=nil)
  Insn.new(opcode, operand)
end

def exec(iseq)
  env = Env.new
  env.push_frame(GlobalFrame.new)
  vm = VM.new(iseq, env)
  vm.run
end

# simple:
#
# (print (- (+ 1 (* 2 3)) 4))
#
iseq = [
  insn(:getvar, :print),
  insn(:getvar, :sub),
  insn(:getvar, :add),
  insn(:push, 1),
  insn(:getvar, :mul),
  insn(:push, 2),
  insn(:push, 3),
  insn(:call, 2),
  insn(:call, 2),
  insn(:push, 4),
  insn(:call, 2),
  insn(:call, 1),
  insn(:pop),
]
puts("simple:")
exec(iseq)

# recursion:
#
# (define loop
#   (lambda (i)
#     (call-if (<= i 10)
#       (lambda ()
#         (print i)
#         (loop (+ i 1))))))
# (loop 0)
#
body_iseq = [
  insn(:getvar, :print),
  insn(:getvar, :i),
  insn(:call, 1),
  insn(:pop),
  insn(:getvar, :loop),
  insn(:getvar, :add),
  insn(:getvar, :i),
  insn(:push, 1),
  insn(:call, 2),
  insn(:call, 1),
  insn(:ret),
]
loop_iseq = [
  insn(:getvar, :call_if),
  insn(:getvar, :le),
  insn(:getvar, :i),
  insn(:push, 10),
  insn(:call, 2),
  insn(:pushclosure, Closure.new([], body_iseq)),
  insn(:call, 2),
  insn(:ret),
]
iseq = [
  insn(:pushclosure, Closure.new([:i], loop_iseq)),
  insn(:defvar, :loop),
  insn(:pop),
  insn(:getvar, :loop),
  insn(:push, 0),
  insn(:call, 1),
  insn(:pop),
]
puts("recursion:")
exec(iseq)

# call/cc:
#
# (print (+ 1 (* (call/cc (lambda (k) (+ 2 (k 3)))) 4)))
#
proc_iseq = [
  insn(:getvar, :add),
  insn(:push, 2),
  insn(:getvar, :k),
  insn(:push, 3),
  insn(:call, 1),
  insn(:call, 2),
  insn(:ret),
]
iseq = [
  insn(:getvar, :print),
  insn(:getvar, :add),
  insn(:push, 1),
  insn(:getvar, :mul),
  insn(:getvar, :call_cc),
  insn(:pushclosure, Closure.new([:k], proc_iseq)),
  insn(:call, 1),
  insn(:push, 4),
  insn(:call, 2),
  insn(:call, 2),
  insn(:call, 1),
  insn(:pop),
]
puts("call/cc:")
exec(iseq)