bus-scheme 0.7.5 → 0.7.6

data/lib/scheme/core.scm

@@ -1,35 +1,38 @@
-(define intern
-  (lambda (sym) (send sym (quote intern))))
+(define string->symbol
+  (lambda (sym) (send sym 'sym)))
+
+(define number->string
+  (lambda (number) (send number 'to_s)))
 
 (define substring
   (lambda (string to from) (send string (quote []) to from)))
 
 (define null?
-  (lambda (expr) (= expr ())))
+  (lambda (expr) (or 
+		  (= expr ()) ;; hacky?
+		  (= expr (ruby "nil")))))
 
 (define >
-  (lambda (x y) (send x (intern ">") y)))
+  (lambda (x y) (send x '> y)))
 
 (define <
-  (lambda (x y) (send x (intern "<") y)))
+  (lambda (x y) (send x '< y)))
 
 (define =
-  (lambda (x y) (send x (intern "==") y)))
-
-(define and
-  (lambda (x y) (if x (if y y #f) #f)))
-
-(define or
-  (lambda (x y) (if x x (if y y #f))))
+  (lambda (x y) (send x '== y)))
 
 (define not
   (lambda (expr) (if expr #f #t)))
 
 (define car
-  (lambda (lst) (send lst (quote first))))
+  (lambda (lst) (send lst 'first)))
 
 (define cdr
-  (lambda (lst) (send lst (quote rest))))
+  (lambda (lst) (send lst 'rest)))
 
+;; and friends
 (define cadr
-  (lambda (lst) (car (cdr lst))))
+  (lambda (lst) (car (cdr lst))))
+
+;; cond
+(define else #t)

data/lib/scheme/list.scm

@@ -0,0 +1,12 @@
+(define length (lambda (l)
+   (if (null? l) 0 (+ 1 (length (cdr l))))))
+
+(define append
+  (lambda (l1 l2)
+    (if (null? l1) 
+	l2 
+	(cons (car l1) (append (cdr l1) l2)))))
+
+(define reverse
+  (lambda (l)
+    (if (null? l) '() (append (reverse (cdr l)) (list (car l))))))

data/lib/scheme/predicates.scm

@@ -0,0 +1,19 @@
+(define isa? (lambda (x type)
+	       (send x 'is_a? (ruby type))))
+
+(define boolean? (lambda (x) (or (= x #t)
+				 (= x #f))))
+(define symbol? (lambda (x) (isa? x "Sym")))
+(define cons? (lambda (x) (isa? x "Cons")))
+(define pair? cons?)
+
+(define string? (lambda (x) (and (isa? x "String")
+				 (not (isa? x "Sym")))))
+(define number? (lambda (x) (isa? x "Fixnum")))
+(define vector? (lambda (x) (isa? x "Array")))
+(define procedure? (lambda (x) (isa? x "Lambda")))
+(define char? (lambda (x) (and (isa? x "String")
+			       (= 1 (length x)))))
+
+;;; TODO:
+;;; port?

data/lib/scheme/test.scm

@@ -0,0 +1,12 @@
+(define assert 
+  (lambda (bool)
+    (if bool
+	#t
+	(fail "Assertion failed."))))
+
+(define assert-equal 
+  (lambda (expected actual)
+    (if (= expected actual)
+	#t
+	(fail (concat "Expected " (send expected 'inspect) ", got " 
+		      (send actual 'inspect))))))

data/lib/stack_frame.rb

@@ -0,0 +1,57 @@
+module BusScheme
+  class StackFrame < Hash
+    attr_reader :called_as, :file, :line, :called_from
+    
+    # takes a hash and a parent
+    def initialize(locals, parent, called_as)
+      @parent, @called_as = [parent, called_as]
+      @file = @called_as.respond_to?(:file) ? @called_as.file : '(eval)'
+      @line = @called_as.respond_to?(:line) ? @called_as.line : 0
+      @called_as = '(anonymous)' if called_as.is_a?(Cons) or called_as.is_a?(Array)
+
+      @called_from = if BusScheme.stack.empty? or !BusScheme.stack.last.respond_to? :called_as
+                       '(top-level)'
+                     else
+                       BusScheme.stack.last.called_as
+                     end
+      
+      locals.each { |k, v| immediate_set k, v }
+    end
+
+    alias_method :immediate_has_key?, :has_key?
+    alias_method :immediate_set, :[]=
+    alias_method :immediate_lookup, :[]
+
+    # Just your regular hash stuff, only it takes the parent into account
+    def has_key?(symbol)
+      immediate_has_key?(symbol) or @parent && @parent.has_key?(symbol)
+    end
+
+    def [](symbol)
+      if immediate_has_key?(symbol)
+        immediate_lookup(symbol)
+      else
+        @parent && @parent[symbol]
+      end
+    end
+
+    def []=(symbol, value)
+      if !immediate_has_key?(symbol) and @parent && @parent.has_key?(symbol)
+        @parent[symbol] = value
+      else
+        immediate_set symbol, value
+      end
+    end
+
+    def trace
+      "#{@file}:#{@line} in #{@called_from}" unless filtered?
+    end
+
+    # special forms should not be shown in stack traces
+    # neither should 'begin'
+    def filtered?
+      return false unless @called_as
+      @called_as.special_form or @called_as == :begin.sym
+    end
+  end
+end

data/test/test_core.rb

@@ -14,30 +14,18 @@ class CoreTest < Test::Unit::TestCase
   end
 
   def test_string_functions
-    assert_evals_to :hi, [:intern, 'hi']
-    assert_evals_to 'lo', [:substring, 'hello', 3, 5]
+    assert_evals_to :hi.sym, ['string->symbol'.sym, 'hi']
+    assert_evals_to 'lo', [:substring.sym, 'hello', 3, 5]
   end
 
   def test_list_functions
-    assert_evals_to :foo, "(car (cons (quote foo) (quote bar)))"
-    assert_evals_to :bar, "(cdr (cons (quote foo) (quote bar)))"
-    assert_equal(BusScheme::Cons.new(:foo, BusScheme::Cons.new(:bar, nil)),
-                 [:foo, :bar].to_list)
-    assert_evals_to(BusScheme::Cons.new(2, BusScheme::Cons.new(3, nil)),
+    assert_evals_to :foo.sym, "(car (cons (quote foo) (quote bar)))"
+    assert_evals_to :bar.sym, "(cdr (cons (quote foo) (quote bar)))"
+    assert_equal(Cons.new(:foo.sym, Cons.new(:bar.sym, nil)),
+                 [:foo.sym, :bar.sym].to_list)
+    assert_evals_to(Cons.new(2, Cons.new(3, nil)),
                     "(list 2 3)")
-    assert_evals_to "bar", "(cadr (list \"foo\" \"bar\")"
-    assert_evals_to [1, :foo].to_list, "(list 1 'foo)"
-  end
-
-  def test_boolean_logic
-    assert_evals_to true, "(and #t #t)"
-    assert_evals_to false, "(and #t #f)"
-    assert_evals_to false, "(and #f #t)"
-    assert_evals_to false, "(and #f #f)"
-
-    assert_evals_to true, "(or #t #t)"
-    assert_evals_to true, "(or #t #f)"
-    assert_evals_to true, "(or #f #t)"
-    assert_evals_to false, "(or #f #f)"
+    assert_evals_to "bar", "(cadr (list \"foo\" \"bar\"))"
+    assert_evals_to [1, :foo.sym].to_list, "(list 1 'foo)"
   end
 end

data/test/test_eval.rb

@@ -1,5 +1,6 @@
 $LOAD_PATH << File.dirname(__FILE__)
 require 'test_helper'
+require 'timeout'
 
 class BusSchemeEvalTest < Test::Unit::TestCase
   def test_eval_empty_list
@@ -12,13 +13,13 @@ class BusSchemeEvalTest < Test::Unit::TestCase
   end
 
   def test_set_symbol
-    BusScheme::Lambda.scope[:hi] = 'hi'
-    assert BusScheme::Lambda.scope[:hi]
+    BusScheme.current_scope[:hi] = 'hi'
+    assert BusScheme.current_scope[:hi]
   end
   
   def test_eval_symbol
-    BusScheme::Lambda.scope[:hi] = 13
-    assert_evals_to 13, :hi
+    BusScheme.current_scope[:hi.sym] = 13
+    assert_evals_to 13, :hi.sym
   end
 
   def test_eval_string
@@ -26,25 +27,69 @@ class BusSchemeEvalTest < Test::Unit::TestCase
   end
 
   def test_eval_function_call
-    assert_evals_to 2, [:+, 1, 1]
+    assert_evals_to 2, "(+ 1 1)"
   end
 
   def test_nested_arithmetic
-    assert_evals_to 6, [:+, 1, [:+, 1, [:*, 2, 2]]]
+    assert_evals_to 6, "(+ 1 (+ 1 (* 2 2)))"
   end
 
   def test_blows_up_with_undefined_symbol
-    assert_raises(BusScheme::EvalError) { eval("undefined-symbol") }
+    assert_raises(EvalError) { eval("undefined-symbol") }
   end
 
   def test_variable_substitution
     eval "(define foo 7)"
-    assert_evals_to 7, :foo
-    assert_evals_to 21, [:*, 3, :foo]
+    assert_evals_to 7, :foo.sym
+    assert_evals_to 21, [:*.sym, 3, :foo.sym]
   end
 
   def test_single_quote
-    assert_evals_to :foo, "'foo"
-    assert_evals_to [:foo, :biz, :bbb].to_list, "'(foo biz bbb)"
+    assert_evals_to :foo.sym, "'foo"
+    assert_evals_to [:foo.sym, :biz.sym, :bbb.sym].to_list, "'(foo biz bbb)"
   end
+
+  def test_quote
+    assert_evals_to :hi.sym, "(quote hi)"
+    assert_evals_to [:a.sym, :b.sym, :c.sym].to_list, "'(a b c)"
+    assert_evals_to [:a.sym].to_list, "(list 'a)"
+    assert_evals_to [:a.sym, :b.sym].to_list, "(list 'a 'b)"
+    assert_evals_to [:a.sym, :b.sym, :c.sym].to_list, "(list 'a 'b 'c)"
+    assert_evals_to [:+.sym, 2, 3].to_list, "'(+ 2 3)"
+  end
+
+  def test_array_of_args_or_list_of_args
+    assert_evals_to 5, cons(:+.sym, cons(2, cons(3)))
+    assert_evals_to 5, cons(:+.sym, cons(2, cons(3)).to_a)
+  end
+
+  def test_eval_multiple_forms
+    assert_raises(EvalError) do
+      BusScheme.eval_string "(+ 2 2) (undefined-symbol)"
+    end
+  end
+
+  def test_define_after_load
+    BusScheme.eval_string "(load \"#{File.dirname(__FILE__)}/../examples/fib.scm\")
+(define greeting \"hi\")"
+    assert BusScheme.in_scope?(:greeting.sym)
+  end
+
+  def test_funcall_list_means_nth
+    assert_evals_to 3, "((list 1 2 3) 2)"
+  end
+
+  def test_funcall_vector_means_nth
+    assert_evals_to 3, "((vector 1 2 3) 2)"
+  end
+
+  def test_funcall_hash_means_lookup
+    assert_evals_to 3, "((hash (1 1) (2 2) (3 3)) 3)"
+  end
+
+#   def test_tail_call_optimization
+#     Timeout.timeout(1) do
+#       assert_nothing_raised { eval "((lambda (x) (x x)) (lambda (x) (x x)))" }
+#     end
+#   end
 end

data/test/test_helper.rb

@@ -2,13 +2,34 @@ $LOAD_PATH << File.dirname(__FILE__) + '/../lib/'
 require 'test/unit'
 require 'bus_scheme'
 
+module BusScheme
+  def self.reset_stack
+    @@stack = []
+  end
+end
+
+class BusScheme::Lambda
+  attr_accessor :body, :formals, :enclosing_scope
+end
+
+class RecursiveHash
+  attr_reader :parent
+end
+
 class Test::Unit::TestCase
+  include BusScheme
+
   # convenience method that accepts string or form
   def eval(form)
-    if form.is_a?(String)
-      BusScheme.eval_string(form)
-    else
-      BusScheme.eval_form(form)
+    begin
+      if form.is_a?(String)
+        BusScheme.eval_string(form)
+      else
+        BusScheme.eval(form)
+      end
+    rescue => e
+      BusScheme.reset_stack
+      raise e
     end
   end
 
@@ -18,6 +39,6 @@ class Test::Unit::TestCase
 
   # remove symbols from all scopes
   def clear_symbols(*symbols)
-    [BusScheme::Lambda.scope, BusScheme::SYMBOL_TABLE].compact.map{ |scope| symbols.map{ |sym| scope.delete sym } }
+    [BusScheme.current_scope, BusScheme::SYMBOL_TABLE].compact.map{ |scope| symbols.map{ |sym| scope.delete sym } }
   end
 end

data/test/test_lambda.rb

@@ -1,25 +1,21 @@
 $LOAD_PATH << File.dirname(__FILE__)
 require 'test_helper'
 
-class BusScheme::Lambda
-  attr_accessor :body, :arg_names, :environment
-end
-
 class BusSchemeLambdaTest < Test::Unit::TestCase
   def test_simple_lambda
     l = eval("(lambda () (+ 1 1))")
-    assert l.is_a?(BusScheme::Lambda)
-    assert_equal [[:+, 1, 1]], l.body
-    assert_equal [], l.arg_names
+    assert l.is_a?(Lambda)
+    assert_equal [[:+.sym, 1, 1].to_list], l.body
+    assert_equal 0, l.formals.length
 
     eval("(define foo (lambda () (+ 1 1)))")
-    assert BusScheme::Lambda.scope[:foo].is_a?(BusScheme::Lambda)
-    assert_evals_to 2, [:foo]
+    assert BusScheme[:foo.sym].is_a?(Lambda)
+    assert_evals_to 2, [:foo.sym]
   end
 
   def test_lambda_with_arg
     eval("(define foo (lambda (x) (+ x 1)))")
-    assert_evals_to 2, [:foo, 1]
+    assert_evals_to 2, "(foo 1)"
   end
 
   def test_eval_literal_lambda
@@ -28,35 +24,101 @@ class BusSchemeLambdaTest < Test::Unit::TestCase
 
   def test_lambda_with_incorrect_arity
     eval("(define foo (lambda (x) (+ x 1)))")
-    assert_raises(BusScheme::ArgumentError) { assert_evals_to 2, [:foo, 1, 3] }
+    assert_raises(ArgumentError) { assert_evals_to 2, "(foo 1 3)" }
   end
 
   def test_lambda_args_dont_stay_in_scope
     clear_symbols(:x, :foo)
     eval("(define foo (lambda (x) (+ x 1)))")
-    assert_nil BusScheme::Lambda.scope[:x]
-    assert_evals_to 2, [:foo, 1]
-    assert_nil BusScheme::Lambda.scope[:x]
+    assert ! BusScheme.in_scope?(:x)
+    assert_evals_to 2, "(foo 1)"
+    assert ! BusScheme.in_scope?(:x)
   end
 
   def test_lambda_calls_lambda
     eval "(define f (lambda (x) (+ 3 x)))"
     eval "(define g (lambda (y) (* 3 y)))"
     assert_evals_to 12, "(f (g 3))"
+    assert_evals_to 1, "((lambda () ((lambda () 1))))"
   end
 
+  def test_enforces_arg_count
+    assert_equal 3, eval("(lambda (x y z) z)").formals.size
+    assert_raises(ArgumentError) do
+      eval "((lambda (x) x))"
+    end
+  end
+  
   def test_lambda_closures
-    eval "(define foo (lambda (x) ((lambda (y) (+ x y)) (* x 2))))"
-    assert_evals_to 3, [:foo, 1]
+    assert_evals_to 3, "((lambda (x) ((lambda (y) 3) 1)) 1)"
+    eval "(define foo (lambda (xx) ((lambda (y) (+ xx y)) (* xx 2))))"
+    assert foo = BusScheme[:foo.sym]
+    
+    assert_evals_to 3, foo.call(1)
     eval "(define holder ((lambda (x) (lambda () x)) 2))"
     assert_evals_to 2, "(holder)"
   end
 
-  def test_changes_to_enclosed_variables_are_in_effect_after_lambda_execution
-    assert_evals_to 2, "((lambda (x) (begin ((lambda () (set! x 2))) x)) 1)"
+  def test_changes_to_enclosed_variables_alter_original_bindings
+    BusScheme.reset_stack # TODO: shouldn't reqire this
+    assert_evals_to 2, "((lambda (x) ((lambda () (set! x 2))) x) 1)"
+    assert BusScheme.stack.empty?
+  end
+
+  def test_implicit_begin
+    assert_evals_to 3, "((lambda () (string->symbol \"hi\") (+ 2 2) (* 1 3)))"
+  end
+
+  def test_let
+    assert_evals_to 2, "(let ((n 2)) n)"
+    assert_evals_to 5, "(let ((n 2) (m 3)) (+ n m))"
+  end
+
+  def test_shadowed_vars_dont_stay_in_scope
+    assert_evals_to Cons.new(:a.sym, :b.sym), "(let ((f (let ((x (quote a)))
+          (lambda (y) (cons x y)))))
+ (let ((x (quote not-a)))
+  (f (quote b))))"
+  end
+
+  def test_nested_function_calls_dont_affect_caller
+    eval "(define fib (lambda (x)
+	      (if (< x 3)
+		  1
+                 (+ (fib (- x 1)) (fib (- x 2))))))"
+
+    assert BusScheme.in_scope?(:fib.sym)
+    assert_evals_to 5, "(fib 5)"
+  end
+
+  def test_lambda_rest_args
+    eval "(define rest (lambda args args))"
+    assert_evals_to [:a.sym, :b.sym, :c.sym].to_list, "(rest 'a 'b 'c)"
+  end
+
+  def test_stacktrace
+    eval '(load "test/tracer.scm")'
+    assert_equal ["(eval):1 in top-level"], eval("(stacktrace)")
+    
+    assert_equal(["test/tracer.scm:1 in f",
+                  "test/tracer.scm:4 in g",
+                  "(eval):1 in (anonymous)",
+                  "(eval):0 in top-level"
+                 ],
+                 eval("((lambda () (g)))"))
   end
 
- def test_implicit_begin
-   assert_evals_to 3, "((lambda () (intern \"hi\") (+ 2 2) (* 1 3)))"
- end
+  # TODO: check the stack traces that the scheme tests give
+
+  def test_stack_grows
+    eval "(define stack-growth
+(lambda () (ruby \"raise 'wtf' if BusScheme.stack.size < 1\")))"
+    eval "(stack-growth)"
+  end
+
+  def test_primitives_live_on_stack
+    BusScheme.define 'stack-growth', lambda { assert BusScheme.stack.size > 1 }
+    assert SYMBOL_TABLE.has_key?('stack-growth'.sym)
+    eval "(stack-growth)"
+  end
 end