lisr.rb

#!/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

tc_lisr.rb

require "test/unit"

require_relative "lisr"

class TestLisp < Test::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