interp1.rb

# coding: utf-8

# irb(main):286:0> (scheme)

# ==> (+ 1 2)
# 3

# ==> ((if (equal 1 1) * +) 2 3)
# 6

# ==> (set! fact (lambda (n) (if (equal n 1) 1 (* n (fact (- n 1))))))
# #<Proc:0x0000000270fe20@c:/home/ha2ne2/Dropbox/PAIP/interp1.rb:50 (lambda)>

# ==> (fact 5)
# 120

# ==> (set! Y (lambda (f) ((lambda (g) (g g)) (lambda (g) (lambda (m) (f (g g) m))))))
# #<Proc:0x000000026e5e90@c:/home/ha2ne2/Dropbox/PAIP/interp1.rb:50 (lambda)>

# ==> (set! fact (Y (lambda (f x) (if (equal x 1) 1 (* x (f (- x 1)))))))
# #<Proc:0x000000026df3d8@c:/home/ha2ne2/Dropbox/PAIP/interp1.rb:50 (lambda)>

# ==> (fact 5)
# 120

$global = Hash.new

def parse(sexp)
  sexp.gsub!(/\n/,'')
  sexp.gsub!(/[_a-zA-Z\+\*\-\/][_a-zA-Z0-9\+\*\-\/]*/, ':\\0')
  sexp.gsub!(/\s+/, ',')
  sexp.gsub!(/\(/, '[')
  sexp.gsub!(/\)/, ']')
  Kernel.eval(sexp)
end

def symbolp(x)
  x.is_a?(Symbol)
end

def atom(x)
  x.is_a?(Numeric)
end

def first(x)  x[0] end
def second(x) x[1] end
def third(x)  x[2] end
def fourth(x) x[3] end
def last1(x)  x[-1] end
def rest(x)   x.drop(1) end
def rest2(x) rest(rest(x)) end

def interp(x,env=nil)
  if symbolp(x)
    get_var(x,env)
  elsif atom(x)
    x
  else
    case (first x)
    when :quote then
      (second x)
    when :begin then
      last1(rest(x).map{|y| interp(y,env)})
    when :set! then
      set_var!(second(x),interp(third(x),env),env)
    when :if then
      if interp(second(x),env)
        interp(third(x),env)
      else
        interp(fourth(x),env)
      end
    when :lambda then
      parms = second(x)
      code = maybe_add(:begin,rest2(x))
      lambda{|*args|
        interp(code,(extend_env(parms,args,env)))
      }
    else # a procedure application
      interp(first(x),env).(*rest(x).map{|v| interp(v,env)})
    end
  end
end

def maybe_add(op,exps,if_nil=nil)
  exps.empty? ? if_nil:
  exps.length==1 ? first(exps):
  cons(op,exps)
end


def find_var(var,env)
  env.each{|e|
    if e.has_key?(var)
      return e
    end
  }
  return nil
end

def set_var!(var,val,env)
  e = find_var(var,env)
  if e
    e[var] = val
  else
    set_global_var!(var,val)
  end
  val
end

def get_var(var,env)
  e = find_var(var,env)
  if e
    e[var]
  else
    get_global_var(var)
  end
end

def set_global_var!(var,val)
  $global[var] = val
end

def get_global_var(var)
  if $global.has_key?(var)
    $global[var]
  else
    raise "Unbound scheme variable: #{var}"
  end
end

def extend_env(vars,vals,env)
  e = Hash.new
  vars.zip(vals){|(var,val)|
    e[var] = val
  }
  [e]+env
end

def sub(a,b) a-b end
def add(a,b) a+b end
def mult(a,b) a*b end
def div(a,b) a/b end
def equal(a,b) a==b end
def cons(a,b) b ? [a]+b : [a] end

$scheme_procs = [[:+,:add],[:-,:sub],[:*,:mult],[:/,:div],:equal,:cons,[:car,:first],[:cdr,:rest],
                 [:write,:print]]

def init_scheme_proc(f)
  if f.is_a?(Array)
    set_global_var!(first(f),method(second(f)))
  else
    set_global_var!(f,method(f))
  end
end
  
def init_scheme_interp()
  $scheme_procs.each{|f| init_scheme_proc(f)}
  set_global_var!(:t,:t)
  set_global_var!(:nil, :nil)
end

def scheme()
  init_scheme_interp()
  loop{
    print("\n==> ")
    STDOUT.flush()
    puts(interp(parse(readline()), []))
  }
end