interp3.rb

# coding: utf-8

# irb(main):037:0> (scheme)
# (scheme)
# ==> (* 2 (call_cc (lambda (cc) (set! old_cc cc) 4)))
# 8
# ==> (old_cc 10)
# 20
# ==> (+ 1 (old_cc 10))
# 20

require_relative "interp1"

def interp(x,env,cc)
  if symbolp(x)
    cc.(get_var(x,env))
  elsif atom(x)
    cc.(x)
  else
    case first(x)
    when :quote then
      cc.(second(x))
    when :begin then
      interp_begin(rest(x),env,cc)
    when :set! then
      interp(third(x),env,
             ->(val){cc.(set_var!(second(x),val,env))})
    when :if then
      interp(second(x),env,
             ->(pred){interp(pred ? third(x): fourth(x), env, cc)})
    when :lambda then
      parms = second(x)
      code = maybe_add(:begin,rest2(x))
      cc.(->(cont,*args){
            interp(code,extend_env(parms,args,env),cont)
          })
    else # a procedure application
      interp_call(x,env,cc)
    end
  end
end

# ==============================

def scheme()
  "A Scheme read-eval-print loop (using interp).
  Handles call/cc by explicitly passing continuations."
  init_scheme_interp()
  loop{
    print("\n==> ")
    STDOUT.flush()
    interp(parse(readline()),[],method(:puts))
  }
end

def interp_begin(body,env,cc)
  interp(first(body),env,
         ->(val){
           rest(body).empty? ?
             cc.(val):
             interp_begin(rest(body),env,cc)
         })
end

def interp_call(call,env,cc)
  "Interpret the call (f x...) and pass the result to CC."
  map_interp(call,env,
             ->(fn_and_args){
               # 通常時は最終的にここにくる
               first(fn_and_args).(cc,*rest(fn_and_args))
             })
end

# 読めるようになった
def map_interp(list,env,cc)
  list.empty? ?
    cc.(nil):
    interp(first(list),env,
           ->(x){
             map_interp(rest(list),env,
                        ->(y){
                          cc.(cons(x,y))
                        })})
end           

# ==============================

def init_scheme_proc(f)
  f.is_a?(Array) ?
    set_global_var!(first(f),->(cont,*args){
                      cont.(method(second(f)).(*args))}):
    init_scheme_proc([f,f]) # nice
end

# ==============================

def call_cc(cc,computation)
  computation.(cc,->(cont,val){cc.(val)})
end

set_global_var!(:call_cc,method(:call_cc))
set_global_var!(:call_with_current_continuation,method(:call_cc))