# See
http://www.latrobe.edu.au/philosophy/phimvt/joy.html
# and
http://factor.sourceforge.net/wiki/
require 'set'
class Joy
attr_reader :stack,
ptions
Instructions = {
:false => lambda { |env| env.stack << false },
:true => lambda { |env| env.stack << true },
:maxint => lambda { |env| env.stack << env.options[:maxint] },
:setsize => lambda { |env| env.stack << env.options[:setsize] },
:stack => lambda { |env| env.stack << env.stack },
:conts => lambda { |env| callcc { |cc| env.stack << cc } }, # ?
:time => lambda { |env| env.stack << Time.now.to_i },
:rand => lambda { |env| env.stack << rand(env.options[:maxint]) },
:stdin => lambda { |env| env.stack << env.options[:stdin] },
:stdout => lambda { |env| env.stack << env.options[:stdout] },
:stderr => lambda { |env| env.stack << env.options[:stderr] },
:id => lambda { |env| },
:dup => lambda { |env| env.stack << env.stack.last },
:swap => lambda { |env| env.stack.insert(-2, env.stack.pop) },
:rollup => lambda { |env| env.stack.insert(-3, env.stack.pop) },
:rolldown => lambda { |env| env.stack << env.stack.slice!(-3) },
:rotate => lambda do |env|
env.stack[-1], env.stack[-3] = env.stack[-3], env.stack[-1]
end,
opd => lambda { |env| ?? },
:dupd => lambda { |env| ?? },
:swapd => lambda { |env| ?? },
:rollupd => lambda { |env| ?? },
:rolldownd => lambda { |env| ?? },
:rotated => lambda { |env| ?? },
op => lambda { |env| env.stack.pop },
:choice => lambda do |env|
condi, theni, elsei = env.stack.slice!(-3 .. -1)
env.stack << (env.true?(condi) ? theni : elsei)
end,
r => lambda do |env|
env.stack << env.stack.pop | env.stack.pop
end,
:xor => lambda do |env|
env.stack << env.stack.pop ^ env.stack.pop
end,
:and => lambda do |env|
env.stack << env.stack.pop & env.stack.pop
end,
:not => lambda do |env|
# TODO: should be set complement for sets
env.stack << !env.stack.pop
end,
:+ => lambda { |env| env.stack << env.stack.pop + env.stack.pop },
:- => lambda { |env| env.stack << env.stack.pop - env.stack.pop },
:* => lambda { |env| env.stack << env.stack.pop * env.stack.pop },
:/ => lambda { |env| env.stack << env.stack.pop / env.stack.pop },
:rem => lambda { |env| env.stack << env.stack.pop % env.stack.pop },
:div => lambda { |env| env.stack += env.stack.pop.divmod(env.stack.pop) },
:sign => lambda { |env| env.stack << 0 <=> env.stack.pop },
:neg => lambda { |env| env.stack << -env.stack.pop },
:concat => lambda do |env|
x, y = env.stack.slice!(-2 .. -1)
env.stack << x + y
end,
:i => lambda do |env|
list = env.stack.pop
env.interpret_list list
end,
:map => lambda do |env|
list, handler = env.stack.slice!(-2 .. -1)
old_stack = env.stack.slice!(0 .. -1)
list.each do |item|
env.stack << item
env.interpret_list handler
end
env.stack.replace(old_stack + [env.stack.dup])
end
}
def true?(obj) obj end
def initialize(options = {}, stack = [], instructions = Instructions)
@options = {
:maxint => 2 ** 32,
:setsize => 2 ** 32,
:stdin => STDIN,
:stdout => STDOUT,
:stderr => STDERR
}.merge(options)
@stack, @instructions = stack, instructions
end
def string_unescape(string)
string.gsub(/\\(?:\d{1,3}|.)/) do |match|
escape = match[1 .. -1]
case escape
when "n" then "\n"
when "t" then "\t"
when "b" then "\b"
when "r" then "\r"
when "f" then "\f"
when /^\d+$/ then escape.to_i(8).chr
end
end
end
def parse(string)
string = string.dup
count = 0
accum = nil
states = [:code]
lex_re = /^[$#].+$ # Comment or shell command
|\(\*(?:\n|.)+?\*\) # Multi-line comment
|\s+ # White space
|-?\d[\d.\-\w]*\b # Numeric constant (lax)
|\b[A-Za-z]+[A-Za-z0-9=_\-]\b # Atomic symbol (word)
|==|.
/x
string.scan(lex_re) do |token|
p [states, accum, token] if $DEBUG
case states.last
when :code then
case token
when /^[$#]|^\(\*|^\s+$/ then
# Comments, shell commands and whitespace are all ignored for now.
when /^-?\d/ then
yield((Integer(token) rescue Float(token)))
when "[" then
states << :list
accum = ""
count = 1
when "{" then
states << :set
accum = ""
count = 1
when '"' then
states << :string
accum = ""
when "'" then
states << :char
else
yield token.intern
end
when :list, :set then
open = {:list => "[", :set => "{"}[states.last]
close = {:list => "]", :set => "}"}[states.last]
case token
when open then
accum << token
count += 1
when close then
count -= 1
if count != 0 then
accum << token
else
list = {:list => [], :set => Set.new}[states.last]
parse(accum) { |token| list << token }
yield list
states.pop
end
else
accum << token
end
when :string then
case token
when "\\" then
count = 1
when '"' then
if count == 0 then
yield string_unescape(accum)
states.pop
else
accum << token
count = 0
end
else
accum << token
count = 0
end
end
end
end
def interpret_token(token)
case token
when Numeric, Array, Set
@stack << token
when Symbol
@instructions[token].call(self)
end
end
def interpret_list(list)
list.each { |token| interpret_token token }
end
def execute(string)
parse(string) { |token| interpret_token token }
end
end
