最近の成果
以前から、RubyでSchemeのインタプリタを書いていたのですが、
今日ついに、プログラム「( (lambda(a)(a a))(lambda(a)(a a)))」が
正常に動くように(スタックオーバーフローで止まらなく)なりました。
つまり、末尾再帰の最適化が出来てるっぽいです。
class Object def scm_class if self == nil :nil elsif self == true :T else raise end end def scm_str if self == nil "nil" elsif self == true "T" else raise end end end class Integer def scm_class :num end def scm_str to_s end def car self[0] end def cdr self >> 1 end end class String def scm_class :str end def scm_str inspect end def car self[0] end def cdr self[1..-1] end end class Symbol def scm_class :sym end def scm_str to_s end end class Cons include Enumerable def scm_class :cons end def initialize(a,b) @car,@cdr = a,b end attr_accessor :car,:cdr def ==(x) x.class == Cons && @car == x.car && @cdr == x.cdr end def each(&prc) tmp = self while tmp.class == Cons prc.call(tmp.car) tmp = tmp.cdr end self end def each2(&prc) tmp = self fin = false while tmp.class == Cons if tmp.cdr.class != Cons fin = true end prc.call(tmp.car, fin) tmp = tmp.cdr end self end def list? tmp = self while tmp.class == Cons tmp = tmp.cdr end return tmp == nil end def to_s inspect end def scm_str if list? "(" + map{|x| x.scm_str }.join(" ") + ")" else return "(#{@car.scm_str} . #{@cdr.scm_str})" end end def inspect scm_str end end def cons(a=nil,b=nil) Cons.new a,b end class Array def to_list result = cons ptr = cons(nil, result) each do |e| ptr.cdr.car = (e.class==Array ? e.to_list: e) ptr.cdr.cdr = cons ptr = ptr.cdr end ptr.cdr = nil return result end end class Parser class Reader def initialize(str) @str = str @index = 0 end attr_accessor :str,:index def next result = @str[@index].chr @index+=1 return result end def back @index-=1 end def has_next? return 0<=@index && @index<@str.size end end def parse_int(reader) result = "" while reader.has_next? ch = reader.next if ch !~ /\d/ reader.back break end result << ch end return result.to_i end def parse_str(reader) result = "" while reader.has_next? ch = reader.next break if ch=="\"" result << ch end return result end def parse_sym(reader) result = "" while reader.has_next? ch = reader.next if ch =~ /[\s()#]/ reader.back break end result += ch end return result.intern end def parse_ws(reader) while reader.has_next? if reader.next !~ /\s/ reader.back break end end return nil end def parse_comment(reader) while reader.has_next? and reader.next != "\n" end return nil end def parse_quote(reader) foo = _parse(reader) first = foo.shift return [["quote".intern, first], foo] end def _parse(reader) ch = nil tree = [] while reader.has_next? ch = reader.next case ch when /\s/ parse_ws(reader) when "\"" tree << parse_str(reader) when /\d/ reader.back tree << parse_int(reader) when "(" tree << _parse(reader) when ")" return tree when "#" parse_comment(reader) when "'" return parse_quote(reader) else #symbol reader.back tree << parse_sym(reader) end end return tree end def parse(str) return _parse(Reader.new(str)).to_list end end class Scope def initialize(upper=nil) @db = Hash.new @super_scope = upper end def define(sym, val) if @db[sym] raise(sym.to_s+" is already defined.") end @db[sym] = val end def update(sym, val) if @db[sym] return @db[sym] = val elsif @super_scope return @super_scope.update(sym, val) else raise("Scope::update() symbol not found:["+sym+"]") end end def get(sym) x = @db[sym] if x return x elsif @super_scope return @super_scope.get(sym) else raise("Scope::get() symbol not found:["+sym.to_s+"]") end end def [](sym) get(sym) end def set(sym, val) update(sym, val) end def []=(sym,val) update(sym,val) end def sub_scope Scope.new(self) end end class Syntax def initialize(name, proc) @name = name @proc = proc end attr_reader :name def scm_class :syntax end def scm_str @name end def to_s @name end def call(scope,args) @proc.call(scope,args) end end def syntax(name,proc) Syntax.new(name,proc) end class Lambda def initialize(scope, args, body) @args = args @body = body @scope = scope end attr_reader :args, :body, :scope def scm_class :lambda end def to_tree cons(:lambda, cons(@args, cons(@body,nil))) end def to_s to_tree.to_s end def scm_str to_tree.scm_str end end class Macro def initialize(args, body) @args = args @body = body end attr_reader :args, :body def scm_class :macro end def to_tree cons(:macro, cons(@args, cons(@body, nil))) end def to_s toTree.to_s end def scm_str to_tree.scm_str end end class MyError < StandardError def initialize(scope, tree) @scope, @tree = scope, tree end attr_accessor :scope, :tree def inspect "#<MyError: tree:#{tree.inspect}>" end end class Evaluator def initialize @root = Scope.new @root.define(:T, true) @root.define(:nil, nil) self.methods.each do |meth| if meth =~ /^eval_(.+)/ @root.define($1.intern, syntax($1, method(meth))) end end @root.define(:+, syntax("+", method(:eval_add))) @root.define(:-, syntax("-", method(:eval_sub))) end def eval(tree) _eval(@root, tree) end def _eval(scope, code) loop do begin return __eval(scope, code) rescue MyError => e scope = e.scope code = e.tree end end end def __eval(scope, code) #puts "call_lambda(#{code})" case code.scm_class when :num, :str, :t, :nil return code when :sym return scope.get(code) when :cons case code.car.scm_class when :sym, :cons func = _eval(scope, code.car) when :lambda, :macro, :syntax func = code.car else raise end args = code.cdr case func.scm_class when :lambda call_lambda(func, scope, args) when :macro call_macro(func, scope, args) when :syntax call_syntax(func, scope, args) else raise("undefined:"+func.to_s+":"+func.scm_class) end else raise("_eval unknown object") end end def bind_arguments(scope, arg_names, values) arg_names.each do |name| if name.to_s[0] == ?* scope.define(name.to_s[1..-1].intern, values) break else if values != nil scope.define(name, values.car) values = values.cdr else scope.define(name, nil) end end end scope end def call_lambda(lmd, scope, args) evaled_args = args && args.map{|arg|_eval(scope, arg)}.to_list local_scope = scope.sub_scope bind_arguments(local_scope, lmd.args, evaled_args) result = nil lmd.body.each2 do |b,fin| if fin && b.scm_class == :cons #p "raise!" raise MyError.new(local_scope, b) end result = _eval(local_scope, b) end return result end def call_macro(macro, scope, args) local_scope = scope.sub_scope bind_arguments(local_scope, macro.args, args) result = nil macro.body.each2 do |b,fin| if fin && b.scm_class == :cons e = MyError.new(local_scope, b) end result = _eval(local_scope, b) end return _eval(local_scope, result) end def call_syntax(syntax, scope, args) if syntax.name == "if" c = _eval(scope, args.car) next_op = (c != nil) ? args.cdr.car: args.cdr.cdr.car e = MyError.new(scope, next_op) raise e else syntax.call(scope, args) end end def eval_eval(scope, args) return _eval(scope, _eval(scope, args.car)) end def eval_define(scope, args) s = args.car v = _eval(scope, args.cdr.car) scope.define(s, v) return s end def eval_update(scope, args) evaled = _eval(scope, args.cdr.car) scope.update(args.car, evaled) return evaled end def eval_if(scope, args) cond = args.car tcase = args.cdr.car fcase = args.cdr.cdr.car if _eval(scope, cond) != nil _eval(scope, tcase) else _eval(scope, fcase) end end def eval_lambda(scope, args) f_args = args.car f_body = args.cdr Lambda.new(scope.sub_scope, f_args, f_body) end def eval_macro(scope, args) f_args = args.car f_body = args.cdr Macro.new(f_args, f_body) end def eval_cons(scope, args) cons(_eval(scope, args.car), _eval(scope, args.cdr.car)) end def eval_car(scope, args) _eval(scope, args.car).car end def eval_cdr(scope, args) _eval(scope, args.car).cdr end def eval_eq(scope, args) a1 = _eval(scope, args.car) a2 = _eval(scope, args.cdr.car) a1 == a2 ? true: nil end def eval_cmp(scope, args) a1 = _eval(scope, args.car) a2 = _eval(scope, args.cdr.car) a1 <=> a2 end def eval_add(scope, args) a1 = _eval(scope, args.car) a2 = _eval(scope, args.cdr.car) a1 + a2 end def eval_sub(scope, args) a1 = _eval(scope, args.car) a2 = _eval(scope, args.cdr.car) a1 - a2 end def eval_quote(scope, args) args.car end def eval_p(scope, args) evaled = _eval(scope, args.car) p evaled return evaled end end class Interpriter def initialize @parser = Parser.new @evaluator = Evaluator.new end def eval_str(code) src = @parser.parse(code) src.each do |s| puts ">>>"+s.to_s v = @evaluator.eval(s) puts v.scm_str end end end i = Interpriter.new i.eval_str "((lambda(a) (a a)) (lambda(a) (a a)))"