NotReallyFORTH

forth.rb

class Proc
  def prim_call(stack)
    forth_arity = self.arity - 1
    if stack.size < forth_arity
      puts "Buffer underrun"
      return stack.clear
    end
    forth_arity > 0 ? self.call(stack, *stack.pop(forth_arity)) : call(stack)
  end
end

stack = []
functions = {}
primitives = {
  ":"   => ->(_, (name, *body)) { functions[name] = body },
  "+"   => ->(stack, x, y) { stack << (x + y) },
  "-"   => ->(stack, x, y) { stack << (x - y) },
  "*"   => ->(stack, x, y) { stack << (x * y) },
  "/"   => ->(stack, x, y) { stack << (x / y) },
  "dup" => ->(stack) { stack << stack.last },
  "rot" => ->(stack) { stack[-2..-1] = stack[-2..-1].reverse },
  "."   => ->(_, x) { puts x },
  ".S"  => ->(stack) { puts "<#{stack.size}> #{stack.join(' ')} " },
  ".F"  => ->(_) { functions.each { |n, b| puts "#{n}: #{b.join(' ')}"} },
  "clearstack" => ->(stack) { stack.clear }
}

parse = ->(input, main=true) do
  tokens = main ? input.split(/\s+/) : input
  return primitives[":"].call(stack, tokens[1..-2]) if tokens.first == ":"
  tokens.each do |token|
    if (primitive = primitives[token])
      primitive.prim_call(stack)
    elsif (function = functions[token])
      parse.call(function, false)
    else
      begin
        stack << Integer(token)
      rescue ArgumentError
        puts "Undefined word <<<#{token}>>>"
        stack.clear
      end
    end
  end
  puts "  ok" if main
end

puts <<EOF
NotReallyFORTH
Type 'bye' to exit
EOF
until (input = gets.chomp) == 'bye'
  parse.call(input)
end

gistfile1.txt

NotReallyFORTH 0.1
Type 'bye' to exit
4 5 
  ok
.S
<2> 4 5 
  ok
+
  ok
.S
<1> 9 
  ok
dup + .
18 
  ok
1 2 3 rot .S
<3> 1 3 2 
  ok
clearstack
  ok
: square dup * ;
5 square .
25 
  ok
.F
square: dup *
bye