Skip to content

Instantly share code, notes, and snippets.

@melborne
Last active September 24, 2015 04:57
Show Gist options
  • Save melborne/670793 to your computer and use it in GitHub Desktop.
Save melborne/670793 to your computer and use it in GitHub Desktop.
List(Scheme) Interpreter in Ruby
#!/opt/local/bin/ruby1.9
#-*-encoding: utf-8-*-
class Env < Hash
def initialize(parms=[], args=[], outer=nil)
h = Hash[parms.zip(args)]
self.merge!(h)
@outer = outer
end
def find(key)
self.has_key?(key) ? self : @outer.find(key)
end
end
def add_globals(env)
env.merge!({
:+ => ->x,y{x+y}, :- => ->x,y{x-y},
:* => ->x,y{x*y}, :/ => ->x,y{x/y},
:not => ->x{!x}, :> => ->x,y{x>y},
:< => ->x,y{x<y}, :>= => ->x,y{x>=y},
:<= => ->x,y{x<=y}, :'=' => ->x,y{x==y},
:equal? => ->x,y{x.equal?(y)},
:eq? => ->x,y{x.eql? y}, :length => ->x{x.length},
:cons => ->x,y{[x,y]}, :car => ->x{x[0]},
:cdr => ->x{x[1..-1]}, :append => ->x,y{x+y},
:list => ->*x{[*x]},
:list? => ->x{x.instance_of?(Array)},
:null? => ->x{x.empty?},
:symbol? => ->x{x.instance_of?(Symbol)}
})
env
end
$global_env = add_globals(Env.new)
def evaluate(x, env=$global_env)
case x
when Symbol
env.find(x)[x]
when Array
case x.first
when :quote
_, exp = x
exp
when :if
_, test, conseq, alt = x
evaluate((evaluate(test, env) ? conseq : alt), env)
when :set!
_, var, exp = x
env.find(var)[var] = evaluate(exp, env)
when :define
_, var, exp = x
env[var] = evaluate(exp, env)
nil
when :lambda
_, vars, exp = x
lambda { |*args| evaluate(exp, Env.new(vars, args, env)) }
when :begin
x[1..-1].inject(nil) { |val, exp| val = evaluate(exp, env) }
else
proc, *exps = x.inject([]) { |mem, exp| mem << evaluate(exp, env) }
proc[*exps]
end
else
x
end
end
def read(s)
read_from tokenize(s)
end
alias :parse :read
def tokenize(s)
s.gsub(/[()]/, ' \0 ').split
end
def read_from(tokens)
raise SytaxError, 'unexpected EOF while reading' if tokens.length == 0
case token = tokens.shift
when '('
l = []
until tokens[0] == ')'
l.push read_from(tokens)
end
tokens.shift
l
when ')'
raise SyntaxError, 'unexpected )'
else
atom(token)
end
end
def brute_parse(s)
s = tokenize(s).map { |token|
if token =~ /[()]/ then token.tr('()', '[]')
elsif token == '=' then ":'='"
elsif atom(token).instance_of?(Symbol) then ":#{token}"
else token
end
}.join(",").gsub('[,', '[')
eval s
end
module Kernel
def Symbol(obj); obj.intern end
end
def atom(token, type=[:Integer, :Float, :Symbol])
send(type.shift, token)
rescue ArgumentError
retry
rescue => e
puts "unexpected error: #{e.message}"
end
def to_string(exp)
puts (exp.instance_of?(Array)) ? '(' + exp.map(&:to_s).join(" ") + ')' : "#{exp}"
end
require "readline"
def lepl
while line = Readline.readline("lisr> ", true)
val = evaluate(brute_parse line)
to_string(val) unless val.nil?
end
end
if __FILE__ == $0
lepl
end
require "minitest/autorun"
require_relative "lisr"
class TestLisp < MiniTest::Unit::TestCase
def setup
@list = {
"(+ 2 (* 3 4))" => [:+, 2, [:*, 3, 4]],
"(define square (lambda (r) (* r r)))" => [:define, :square, [:lambda, [:r], [:*, :r, :r]]],
"(define count (lambda (item l) (if l (+ (equal? item (car l)) (count item (cdr l))) 0)))" => [:define, :count, [:lambda, [:item, :l], [:if, :l, [:+, [:equal?, :item, [:car, :l]], [:count, :item, [:cdr, :l]]], 0]]]
}
end
def test_parse
@list.each { |exp, ans| assert_equal(ans, parse(exp)) }
end
def test_blute_parse
@list.each { |exp, ans| assert_equal(ans, brute_parse(exp)) }
end
def test_calc
list = {"(+ 5 6)" => 11, "(* 2 (/ 12 3))" => 8, "(> 10 5)" => true,
"(/ 3.0 4.0)" => 0.75, "(= 3 3)" => true, "(eq? (* 2 3) (/ 12 2))" => true,
"(car (cons 1 2))" => 1, "(cdr (cons 1 2))" => [2],
"(list 1 2 3)" => [1,2,3], "(list? (list 1 2 3))" => true,
"(length (list 1 2 3))" => 3, "(null? (cdr (cons 1 2)))" => false}
list.each { |exp, ans| assert_equal(ans, evaluate(parse(exp))) }
end
def test_define
exp1 = "(define area (lambda (r) (* 3.1415 (* r r))))"
exp2 = "(define count (lambda (item l) (if l (+ (equal? item (car l)) (count item
(cdr l))) 0)))"
exp3 = "(define count (lambda (item L) (if (= 0 (length L) 0 (if (= item (car L))(+ 1 (count item (cdr L)))(cout item (cdr L)))))))"
assert_equal(nil, evaluate(parse(exp3)))
end
end
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment