class RbScheme::Compiler
Public Instance Methods
collect_free(vars, env, nxt)
click to toggle source
# File lib/rb-scheme/compiler.rb, line 242 def collect_free(vars, env, nxt) return nxt if vars.null? collect_free(vars.cdr, env, compile_refer(vars.car, env, list(intern("argument"), nxt))) end
compile(exp, env, sets, nxt)
click to toggle source
# File lib/rb-scheme/compiler.rb, line 6 def compile(exp, env, sets, nxt) case exp when LSymbol compile_refer(exp, env, sets.member?(exp) ? list(intern("indirect"), nxt) : nxt) when LCell case exp.car when intern("quote") check_length!(exp.cdr, 1, "quote") obj = exp.cadr list(intern("constant"), obj, nxt) when intern("lambda") check_min_length!(exp.cdr, 2, "lambda") param_info = parse_parameters(exp.cadr) vars = param_info[:vars] *body = exp.cddr.to_a local_bound = Set.new(vars) global_bound = Set.new(Global.variables) free = convert_to_list(find_free_body(body, local_bound.union(global_bound))) sets_body = find_sets_body(body, Set.new(vars)) c = compile_lambda_body(body, cons(vars, free), sets_body.union(sets.intersection(free)), list(intern("return"), vars.count)) collect_free(free, env, list(intern("close"), vars.count, param_info[:variadic?] ? 1 : 0, free.count, make_boxes(sets_body, vars, c), nxt)) when intern("begin") check_min_length!(exp.cdr, 1, "begin") *body = exp.cdr.to_a compile_lambda_body(body, env, sets, nxt) when intern("if") check_length!(exp.cdr, 3, "if") test, then_exp, else_exp = exp.cdr.to_a thenc = compile(then_exp, env, sets, nxt) elsec = compile(else_exp, env, sets, nxt) compile(test, env, sets, list(intern("test"), thenc, elsec)) when intern("set!") check_length!(exp.cdr, 2, "set!") var, x = exp.cdr.to_a compile_lookup(var, env, lambda { |n| compile(x, env, sets, list(intern("assign-local"), n, nxt)) }, lambda { |n| compile(x, env, sets, list(intern("assign-free"), n, nxt)) }, lambda { |k| compile(x, env, sets, list(intern("assign-global"), k, nxt)) }) when intern("define") check_length!(exp.cdr, 2, "define") var, x = exp.cdr.to_a Global.put(var, nil) compile(x, env, sets, list(intern("assign-global"), var, nxt)) when intern("call/cc") check_length!(exp.cdr, 1, "call/cc") x = exp.cadr cn = tail?(nxt) ? list(intern("shift"), 1, nxt.cadr, list(intern("apply"), 1)) : list(intern("apply"), 1) c = list(intern("conti"), list(intern("argument"), compile(x, env, sets, cn))) tail?(nxt) ? c : list(intern("frame"), nxt, c) else args = exp.cdr cn = tail?(nxt) ? list(intern("shift"), exp.cdr.count, nxt.cadr, list(intern("apply"), args.count)) : list(intern("apply"), args.count) c = compile(exp.car, env, sets, cn) args.each do |arg| c = compile(arg, env, sets, list(intern("argument"), c)) end tail?(nxt) ? c : list(intern("frame"), nxt, c) end else list(intern("constant"), exp, nxt) end end
compile_lambda_body(body, env, sets, ret)
click to toggle source
# File lib/rb-scheme/compiler.rb, line 123 def compile_lambda_body(body, env, sets, ret) c = ret body.reverse_each do |exp| c = compile(exp, env, sets, c) end c end
compile_lookup(var, env, return_local, return_free, return_global)
click to toggle source
# File lib/rb-scheme/compiler.rb, line 260 def compile_lookup(var, env, return_local, return_free, return_global) unless env.null? locals = env.car locals.each_with_index do |l, n| return return_local.call(n) if l == var end free = env.cdr free.each_with_index do |f, n| return return_free.call(n) if f == var end end if Global.defined?(var) return return_global.call(var) end raise "#{var.name} isn't found in environment" end
compile_refer(var, env, nxt)
click to toggle source
# File lib/rb-scheme/compiler.rb, line 252 def compile_refer(var, env, nxt) compile_lookup(var, env, lambda { |n| list(intern("refer-local"), n, nxt) }, lambda { |n| list(intern("refer-free"), n, nxt) }, lambda { |k| list(intern("refer-global"), k, nxt) }) end
find_free(exp, bound_variables)
click to toggle source
# File lib/rb-scheme/compiler.rb, line 199 def find_free(exp, bound_variables) case exp when LSymbol bound_variables.member?(exp) ? Set.new : Set.new(list(exp)) when LCell case exp.car when intern("quote") Set.new when intern("lambda") check_min_length!(exp.cdr, 2, "find_free") vars, *body = exp.cdr.to_a find_free_body(body, bound_variables.union(Set.new(vars))) when intern("if") check_length!(exp.cdr, 3, "find_free(if)") test_x, then_x, else_x = exp.cdr.to_a find_free(test_x, bound_variables) .union(find_free(then_x, bound_variables)) .union(find_free(else_x, bound_variables)) when intern("set!") check_length!(exp.cdr, 2, "find_free(set!)") var, exp = exp.cdr.to_a free = find_free(exp, bound_variables) bound_variables.member?(var) ? free : Set[var].union(free) when intern("define") raise "Only top level define is supported" when intern("call/cc") check_length!(exp.cdr, 1, "find_free(call/cc)") x = exp.cadr find_free(x, bound_variables) else exp.inject(Set.new) do |result, item| result.union(find_free(item, bound_variables)) end end else Set.new end end
find_free_body(body, bound_variables)
click to toggle source
# File lib/rb-scheme/compiler.rb, line 193 def find_free_body(body, bound_variables) body.reduce(Set.new) do |whole_free, exp| whole_free.union(find_free(exp, bound_variables)) end end
find_sets(exp, vars)
click to toggle source
# File lib/rb-scheme/compiler.rb, line 137 def find_sets(exp, vars) case exp when LSymbol Set.new when LCell case exp.car when intern("quote") Set.new when intern("lambda") check_min_length!(exp.cdr, 2, "find_sets(lambda)") new_vars, *body = exp.cdr.to_a find_sets_body(body, vars.subtract(new_vars)) when intern("if") check_length!(exp.cdr, 3, "find_sets(if)") test, then_x, else_x = exp.cdr.to_a [test, then_x, else_x].inject(Set.new) do |res, x| res.union(find_sets(x, vars)) end when intern("set!") check_length!(exp.cdr, 2, "find_sets(set!)") var, x = exp.cdr.to_a s = vars.member?(var) ? Set.new([var]) : Set.new s.union(find_sets(x, vars)) when intern("define") raise "Only top level define is supported" when intern("call/cc") check_length!(exp.cdr, 1, "find_sets(call/cc)") x = exp.cadr find_sets(x, vars) else exp.inject(Set.new) do |res, x| res.union(find_sets(x, vars)) end end else Set.new end end
find_sets_body(body, sets_vars)
click to toggle source
# File lib/rb-scheme/compiler.rb, line 131 def find_sets_body(body, sets_vars) body.reduce(Set.new) do |whole_sets, exp| whole_sets.union(find_sets(exp, sets_vars)) end end
make_boxes(sets, vars, nxt)
click to toggle source
# File lib/rb-scheme/compiler.rb, line 180 def make_boxes(sets, vars, nxt) n = vars.count - 1 res = nxt vars.reverse_each do |v| if sets.member?(v) res = list(intern("box"), n, res) end n -= 1 end res end
parse_parameters(param)
click to toggle source
# File lib/rb-scheme/compiler.rb, line 100 def parse_parameters(param) case param when LSymbol return { vars: list(param), variadic?: true } when LCell return { vars: list, variadic?: false } if param.null? result = [] target = param loop do result.push(target.car) target = target.cdr if !target.is_a?(LCell) result.push(target) return { vars: convert_to_list(result), variadic?: true } elsif target.null? return { vars: convert_to_list(result), variadic?: false } end end else raise "error" end end
tail?(nxt)
click to toggle source
# File lib/rb-scheme/compiler.rb, line 96 def tail?(nxt) nxt.car == intern("return") end