Stupid Simple Forth System in Ruby

froth.rb

# Example Usage:  ruby froth.rb ": sq dup * ; 2 sq ."

class Froth
  attr_reader :storage
  attr_accessor :trace

  WordDefinition = Struct.new(:name, :xt, :immediate)
  class WordDefinition
    def immediate?
      immediate
    end
  end

  def initialize
    @dictionary = {}
    @stack = []
    @rstack = []
    @storage = []
    @ip = 0
    @trace = false
    @mode = :interpret
    define_primitives
  end

  def run(string)
    @string = string
    xt = here
    @storage << @dictionary["(top)"].xt
    @storage << @dictionary["bye"].xt
    dump if @trace
    goto(xt)
  end

  private

  def compile(string)
    result = here
    @words = string.split
    while word = @words.shift
      if word_def = @dictionary[word]
        if @mode == :interpret || word_def.immediate?
          execute(word_def.xt)
        else
          @storage << word_def.xt
        end
      elsif word =~ /^\d+$/
        if @mode == :interpret
          @stack.push(word.to_i)
        else
          compile_literal(word.to_i)
        end
      else
        fail "Unknown word '#{word}'"
      end
    end
    result
  end

  def execute(xt)
    old_ip = @ip
    @storage[@execip] = xt
    goto(@execip)
    @ip = old_ip
  end

  def goto(initial_ip)
    @ip = initial_ip
    @running = true
    while @running
      @cp = @storage[@ip]
      puts "STEP: @ip=#{@ip} #{@cp} #{reverse_lookup(@cp)}" if @trace
      @ip += 1
      @storage[@cp].call
    end
  end

  def compile_literal(n)
    @storage << @dictionary["(lit)"].xt
    @storage << n
  end

  def primitive(name, immediate=false, &block)
    n = here
    @storage << lambda { @storage[@cp+1].call }
    @storage << block
    @dictionary[name] = WordDefinition.new(name, n, immediate)
  end

  def define_primitives
    primitive("(stop_running)") { @running = false }
    @execip = here
    @storage << 0
    @storage << @dictionary["(stop_running)"].xt
    primitive("(lit)") { push(@storage[@ip]); @ip += 1 }
    primitive(".") { puts pop }
    primitive("+") { a = pop; b = pop; push(a+b) }
    primitive("-") { a = pop; b = pop; push(a-b) }
    primitive("*") { a = pop; b = pop; push(a*b) }
    primitive("/") { a = pop; b = pop; push(a.to_i/b.to_a) }
    primitive("dup") { a = pop; push(a); push(a) }
    primitive("drop") { pop }
    primitive("rot") { a = pop; b = pop; c = pop; push(b); push(a); push(c) }
    primitive(".s") { puts @stack.join(" ") + " <#{@stack.size}>" }
    primitive("bye") { exit }
    primitive("dump") { dump }
    primitive(":") {
      name = @words.shift
      n = here
      @dictionary[name] = WordDefinition.new(name, n, false)
      @storage << lambda {
        @rstack << @ip
        @ip = @cp + 1
      }
      @mode = :compile
    }
    primitive("(ret)") { @ip = @rstack.pop }
    primitive(";", true) {
      @storage << @dictionary["(ret)"].xt
      @mode = :interpret
    }
    primitive("(top)") {
      compile(@string)
    }
  end

  def here
    @storage.size
  end

  def pop
    @stack.pop
  end

  def push(n)
    @stack.push(n)
  end

  def reverse_lookup(n)
    @dictionary.each do |key, value|
      return key if value.xt == n
    end
    nil
  end

  def dump
    @storage.each_with_index do |w, i|
      puts "#{i}: #{w} #{reverse_lookup(w)}"
    end
  end

end

f = Froth.new
if ARGV.first == '-t'
  f.trace = true
  ARGV.shift
end
command = ARGV.join(" ") + " bye"
f.run(command)