rubylisp 0.1.1 → 0.2.0

data/lib/rubylisp/debug.rb

@@ -0,0 +1,238 @@
+# Copyright 2014 David R. Astels.  All rights reserved.
+# Use of this source code is governed by a BSD-style
+# license that can be found in the LICENSE file.
+
+  
+module Lisp
+
+  class Debug
+
+    class <<self
+      attr_accessor :trace, :on_error, :on_entry, :single_step, :interactive, :target_env, :eval_in_debug_repl
+    end
+      
+
+    def self.register
+      self.trace = false
+      self.on_error = false
+      self.on_entry = Set.new
+      self.single_step = false
+      self.interactive = false
+
+      Primitive.register("debug-trace") {|args, env| Lisp::Debug::debug_trace_impl(args, env) }
+      Primitive.register("debug-on-error") {|args, env| Lisp::Debug::debug_on_error_impl(args, env) }
+      Primitive.register("debug-on-entry") {|args, env| Lisp::Debug::debug_on_entry_impl(args, env) }
+      Primitive.register("add-debug-on-entry") {|args, env| Lisp::Debug::add_debug_on_entry_impl(args, env) }
+      Primitive.register("remove-debug-on-entry") {|args, env| Lisp::Debug::remove_debug_on_entry_impl(args, env) }
+      Primitive.register("debug") {|args, env| Lisp::Debug::debug_impl(args, env) }
+      Primitive.register("dump") {|args, env| Lisp::Debug::dump_imp2l(args, env) }
+    end
+
+
+    def self.debug_trace_impl(args, env)
+      return Lisp::Debug.process_error("debug-trace requires 1 argument", env) unless args.length == 1
+      flag = args.car.evaluate(env)
+      return Lisp::Debug.process_error("the argument to debug-trace has to be a boolean", env) unless flag.boolean?
+      self.trace = flag.value
+      flag
+    end
+  
+    def self.debug_on_error_impl(args, env)
+      return Lisp::Debug.process_error("debug-on-error requires 1 argument", env) unless args.length == 1
+      flag = args.car.evaluate(env)
+      return Lisp::Debug.process_error("the argument to debug-on-error has to be a boolean", env) unless flag.boolean?
+      self.on_error = flag.value
+      flag
+    end
+  
+    def self.debug_on_entry_impl(args, env)
+      Lisp::ConsCell.array_to_list(self.on_entry.to_a.sort.map {|s| Lisp::String.with_value(s) })
+    end
+  
+    def self.add_debug_on_entry_impl(args, env)
+      return Lisp::Debug.process_error("add-debug-on-error requires 1 argument", env) unless args.length == 1
+      f = args.car.evaluate(env)
+      return Lisp::Debug.process_error("the argument to add-debug-on-error has to be a function", env) unless f.function? || f.primitive?
+
+      self.on_entry.add(f.name)
+      f
+    end
+  
+    def self.remove_debug_on_entry_impl(args, env)
+      return Lisp::Debug.process_error("remove-debug-on-error requires 1 argument", env) unless args.length == 1
+      f = args.car.evaluate(env)
+      return Lisp::Debug.process_error("the argument to remove-debug-on-error has to be a function", env) unless f.function?
+
+      self.on_entry.remove(f.name)
+      f
+    end
+  
+    def self.debug_impl(args, env)
+    end
+  
+    def self.dump_impl(args, env)
+      env.dump()
+    end
+
+
+    def self.process_state(tokens)
+      if tokens.size != 2
+        puts "Missing on/off"
+        [false, false]
+      else
+        case tokens[1]
+        when 'on'
+          [true, true]
+        when 'off'
+          [true, false]
+        else
+          puts "on/off expected."
+          [false, false]
+        end
+      end
+    end
+
+
+    def func_or_nil(fname, env)
+      f = env.value_of(Lisp::Symbol.named(fname))
+      if f.nil? || !f.function?
+        puts "No such function."
+        nil
+      else
+        f
+      end
+    end
+
+    
+    def self.debug_repl(env)
+      parser = Lisp::Parser.new
+      puts("Debugging: #{env.current_code[0]}")
+      while line = Readline.readline('D> ', true)
+        if !line.empty?
+          if line[0] == ':'
+            tokens = line[1..-1].split
+            case tokens[0]
+            when '(+'
+              f = func_or_nil(tokens[1], env)
+              self.on_entry.add(f.name) unless f.nil?
+            when '(-'
+              f = func_or_nil(tokens[1], env)
+              self.on_entry.delete(f.name) unless f.nil?
+            when '('
+              self.on_entry.to_a.sort.each {|f| puts f}
+            when '?'
+              puts "RubyLisp Debugger"
+              puts "-----------------"
+              puts ":(+ func  - debug on entry to func"
+              puts ":(- func  - don't debug on entry to func"
+              puts ":(        - show functions marked as debug on entry"
+              puts ":?        - show this command summary"
+              puts ":b        - show the environment stack"
+              puts ":c        - continue, exiting the debugger"
+              puts ":d        - do a full of the environment stack"
+              puts ":e on/off - Enable/disable debug on error"
+              puts ":f frame# - do a full dump of a single environment frame"
+              puts ":q        - quit GoLisp"
+              puts ":r sexpr  - return from the current evaluation with the specified value"
+              puts ":s        - single step (run to the next evaluation)"
+              puts ":t on/off - Enable/disable tracing"
+              puts ":u        - continue until the enclosing environment frame is returned to"
+              puts
+            when 'b'
+              env.dump_headers()
+              puts
+            when 'c'
+              self.target_env = nil
+              self.single_step = false
+              self.eval_in_debug_repl = false
+              return
+            when 'd'
+              env.dump
+            when 'e'
+              ok, state = process_state(tokens)
+              self.on_error = state if ok
+            when 'f'
+              if tokens.size != 2
+                puts "Missing frame number."
+              else
+                fnum = tokens[1].to_i
+                env.dump_single_frame(fnum)
+              end
+            when 'q'
+              exit()
+            when 'r'
+              self.eval_in_debug_repl = true
+              code = parser.parse(tokens[1..-1].join(' '))
+              return_value = code.evaluate(env)
+              self.eval_in_debug_repl = false
+              self.target_env = nil
+              self.single_step = false
+              self.eval_in_debug_repl = false
+              return return_value
+            when 's'
+              self.single_step = true
+              return
+            when 't'
+              ok, state = process_state(tokens)
+              self.trace = state if ok
+            when 'u'
+              if env.previous.nil?
+                puts "Already at top frame."
+              else
+                self.target_env = env
+                return
+              end
+            end
+          else
+            begin 
+              self.eval_in_debug_repl = true
+              code = parser.parse(line)
+              value = code.evaluate(env)
+              self.eval_in_debug_repl = false
+              puts value.to_s
+            rescue Exception => ex
+              puts "ERROR: #{ex}"
+              puts ex.backtrace
+            end
+          end
+        end
+      end
+    end
+
+    def self.process_error(error_message, env)
+      if self.on_error && self.interactive
+        puts "ERROR: #{error_message}"
+        self.debug_repl(env)
+      else
+        raise error_message
+      end
+    end
+
+
+    def self.print_dashes(level)
+      print("-" * level)
+    end
+
+    
+    def self.log_eval(sexpr, env)
+      if !self.eval_in_debug_repl && self.trace
+        depth = env.depth
+        print("% #d: " % depth)
+        print_dashes(depth)
+        puts("> #{sexpr.to_s}")
+      end
+    end
+
+
+    def self.log_result(result, env)
+      if !self.eval_in_debug_repl && self.trace
+        depth = env.depth
+        print("% #d: <" % depth)
+        print_dashes(depth)
+        puts(" #{result.to_s}")
+      end
+    end
+    
+  
+  end
+end

data/lib/rubylisp/environment_frame.rb

@@ -2,7 +2,7 @@ module Lisp
 
   class EnvironmentFrame
 
-    attr_accessor :frame
+    attr_accessor :frame, :current_code, :previous
     
     def self.global
       @@global_frame ||= EnvironmentFrame.new(nil)
@@ -18,6 +18,7 @@ module Lisp
       @bindings = []
       @parent = parent
       @frame = f
+      @current_code = []
     end
 
     def has_frame?
@@ -103,14 +104,56 @@ module Lisp
       b = binding_for(Symbol.new(symbol_name))
       b.nil? ? nil : b.value
     end
-    
 
-    def dump
+
+    def dump_bindings
       @bindings.each do |b|
-        puts b.to_s
+        puts b.to_s if b.value.nil? || !b.value.primitive?
       end
+      puts
+    end
+
+
+    def dump(frame_number=0)
+      puts "Frame #{frame_number}: #{@current_code[0]}"
+      dump_bindings
+      @previous.dump(frame_number + 1) unless @previous.nil?
+    end
+
+
+    def dump_single_frame(frame_number)
+      if frame_number == 0
+        puts "Evaling: #{@current_code[0]}"
+        dump_bindings
+      elsif !@previous.nil?
+        @previous.dump_single_frame(frame_number - 1)
+      else
+        puts "Invalid frame selected."
+      end
+    end
+
+    def internal_dump_headers(frame_number)
+      puts "Frame #{frame_number}: #{@current_code[0]}"
+      @previous.internal_dump_headers(frame_number + 1) unless @previous.nil?
+    end
+
+    
+    
+    def dump_headers
+      puts
+      internal_dump_headers(0)
     end
 
+
+    def depth
+      if @previous.nil?
+        1
+      else
+        1 + @previous.depth
+      end
+    end
+    
   end
 
+
 end

data/lib/rubylisp/exception.rb

@@ -37,20 +37,20 @@ module Lisp
         frame = frame.parent
         if frame.nil?
           exception_message = message.empty? ? "" : ": #{message}"
-          raise "Unhandled Exception: #{exception_name}#{exception_message}"
+          return Lisp::Debug.process_error("Unhandled Exception: #{exception_name}#{exception_message}", env)
         end
       end
     end
     
     def self.raise_impl(args, env)
-      raise "'raise' requires at least one argument." unless args.length > 0
+      return Lisp::Debug.process_error("'raise' requires at least one argument.", env) unless args.length > 0
       exception_name = args.car.evaluate(env)
-      raise "'raise' requires an exception name as it's first argument." unless exception_name.string? || class_name.symbol?
+      return Lisp::Debug.process_error("'raise' requires an exception name as it's first argument.", env) unless exception_name.string? || class_name.symbol?
 
       message = ""
       if args.length > 1
         message = args.cadr.evaluate(env)
-        raise "The message parameter to 'raise' must be a string." unless message.string?
+        return Lisp::Debug.process_error("The message parameter to 'raise' must be a string.", env) unless message.string?
       end
 
       handler_args = args.length > 2 ? Lisp::ConsCell.array_to_list(args.cdr.to_a.collect {|a| a.evaluate(env)}) : Lisp::ConsCell.new
@@ -61,9 +61,9 @@ module Lisp
       raw_handlers = args.car
       body = args.cdr
       
-      raise "Exception handlers must be a list." unless raw_handlers.list?
-      raise "Exception handlers must be a list of pairs." unless raw_handlers.all? {|h| h.list?}
-      raise "Exception clause must be a symbol/string or a list of symbol/string." unless raw_handlers.all? do |h|
+      return Lisp::Debug.process_error("Exception handlers must be a list.", env) unless raw_handlers.list?
+      return Lisp::Debug.process_error("Exception handlers must be a list of pairs.", env) unless raw_handlers.all? {|h| h.list?}
+      return Lisp::Debug.process_error("Exception clause must be a symbol/string or a list of symbol/string.", env) unless raw_handlers.all? do |h|
         ex = h.car
         ex.symbol? || ex.string? || (ex.list? && ex.all? {|h2| h2.symbol? || h2.string?})
       end
@@ -71,7 +71,7 @@ module Lisp
       array_of_handlers = raw_handlers.to_a.collect do |h|
         ex = h.car
         f = h.cadr.evaluate(env)
-      raise "Exception handler has to be a function." unless f.function?
+      return Lisp::Debug.process_error("Exception handler has to be a function.", env) unless f.function?
         Lisp::ConsCell.cons(ex, f)
       end
       handlers = Lisp::ConsCell.array_to_list(array_of_handlers)

data/lib/rubylisp/ext.rb

@@ -20,6 +20,10 @@ class NilClass
     self.to_s
   end
 
+  def print_string_helper
+    ""
+  end
+
   def evaluate(env)
     nil
   end

data/lib/rubylisp/ffi_class.rb

@@ -24,17 +24,17 @@ module Lisp
 
 
     def self.extend_impl(args, env)
-      raise "'extend' requires 2 arguments." if args.length != 2
+      return Lisp::Debug.process_error("'extend' requires 2 arguments.", env) if args.length != 2
 
       class_name = args.car.evaluate(env)
-      raise "'extend' requires a name as it's first argument." unless class_name.string? || class_name.symbol?
+      return Lisp::Debug.process_error("'extend' requires a name as it's first argument.", env) unless class_name.string? || class_name.symbol?
       super_class = Object.const_get(class_name.to_s)
-      raise "'extend' requires the name of an existing class as it's first argument." if super_class.nil?
+      return Lisp::Debug.process_error("'extend' requires the name of an existing class as it's first argument.", env) if super_class.nil?
 
       new_class_name = args.cadr.evaluate(env)
-      raise "'extend' requires a name  as it's second argument." unless new_class_name.string? || new_class_name.symbol?
+      return Lisp::Debug.process_error("'extend' requires a name  as it's second argument.", env) unless new_class_name.string? || new_class_name.symbol?
       new_class = Class.new(super_class)
-      raise "'extend' requires the name of a new (i.e. nonexistant) class as it's second argument." if Object.const_defined?(new_class_name.to_s)
+      return Lisp::Debug.process_error("'extend' requires the name of a new (i.e. nonexistant) class as it's second argument.", env) if Object.const_defined?(new_class_name.to_s)
 
       Object.const_set(new_class_name.to_s, new_class)
       ClassObject.with_class(new_class)
@@ -77,17 +77,17 @@ module Lisp
 
     
     def self.add_method_impl(args, env)
-      raise "'add-method' requires 3 arguments." if args.length != 3
+      return Lisp::Debug.process_error("'add-method' requires 3 arguments.", env) if args.length != 3
       class_name = args.car.evaluate(env)
-      raise "'add-method' requires a class name as it's first argument." unless class_name.string? || class_name.symbol?
+      return Lisp::Debug.process_error("'add-method' requires a class name as it's first argument.", env) unless class_name.string? || class_name.symbol?
       target_class = Object.const_get(class_name.to_s)
-      raise "'add-method' requires the name of an existing class." if target_class.nil?
+      return Lisp::Debug.process_error("'add-method' requires the name of an existing class.", env) if target_class.nil?
 
       method_name = args.cadr.evaluate(env)
-      raise "'add-method' requires a method name as it's second argument." unless class_name.string? || class_name.symbol?
+      return Lisp::Debug.process_error("'add-method' requires a method name as it's second argument.", env) unless class_name.string? || class_name.symbol?
 
       body = args.caddr.evaluate(env)
-      raise "'add-method' requires a function as it's third argument." unless body.function?
+      return Lisp::Debug.process_error("'add-method' requires a function as it's third argument.", env) unless body.function?
       
       target_class.send(:define_method, method_name.to_s) do |*args|
         local_env = Lisp::EnvironmentFrame.extending(env)

data/lib/rubylisp/ffi_send.rb

@@ -46,8 +46,8 @@ module Lisp
 
     def apply_to_without_evaluating(args, env)
       target = args.car
-      raise "Send target of '#{@value}' evaluated to nil." if target.nil?
-      raise "Target of an FFI send of '#{@value}' must be a wrapped ObjC object, was #{target}" unless target.object?
+      return Lisp::Debug.process_error("Send target of '#{@value}' evaluated to nil.", env) if target.nil?
+      return Lisp::Debug.process_error("Target of an FFI send of '#{@value}' must be a wrapped ObjC object, was #{target}", env) unless target.object?
 
       arguments = args.cdr.nil? ? [] : args.cdr.to_a.map {|a| process_arg(a, env)}      
       result = nil
@@ -60,7 +60,7 @@ module Lisp
                    target.value.send(@value, *arguments)
                  end
       rescue Exception => e
-        raise "Exception sending #{@value}: #{e}"
+        return Lisp::Debug.process_error("Exception sending #{@value}: #{e}", env)
       end
 
       convert_value(result)

data/lib/rubylisp/frame.rb

@@ -39,6 +39,10 @@ module Lisp
         Lisp::Frame::clone_impl(args, env)
       end
       
+      Primitive.register("keys", "(keys frame)\n\nReturn a list of the keys in the frame.") do |args, env|
+        Lisp::Frame::keys_impl(args, env)
+      end
+      
     end
 
 
@@ -47,8 +51,8 @@ module Lisp
       m = {}
       while !c.nil?
         k = c.car
-        raise "Slot names must be a symbol, found a {k.type}." unless k.symbol?
-        raise "Slot names must end in a colon, found '#{k}'." unless k.naked?
+        return Lisp::Debug.process_error("Slot names must be a symbol, found a {k.type}.", env) unless k.symbol?
+        return Lisp::Debug.process_error("Slot names must end in a colon, found '#{k}'.", env) unless k.naked?
         v = c.cadr.evaluate(env)
         m[k] = v
         c = c.cddr
@@ -60,9 +64,9 @@ module Lisp
 
     def self.has_slot_impl(args, env)
       frame = args.car.evaluate(env)
-      raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
       key = args.cadr.evaluate(env)
-      raise "Frame key must be a symbol but was #{key.type}." unless key.symbol?
+      return Lisp::Debug.process_error("Frame key must be a symbol but was #{key.type}.", env) unless key.symbol?
       return Lisp::TRUE if frame.has_slot?(key)
       Lisp::FALSE
     end
@@ -70,28 +74,28 @@ module Lisp
     
     def self.get_slot_impl(args, env)
       frame = args.car.evaluate(env)
-      raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
       key = args.cadr.evaluate(env)
-      raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." unless key.symbol?
-      raise "Frame key (#{key.to_s}) must name an existing slot." unless frame.has_slot?(key)
+      return Lisp::Debug.process_error("Frame key (#{key.to_s}) must be a symbol but was #{key.type}.", env) unless key.symbol?
+      return Lisp::Debug.process_error("Frame key (#{key.to_s}) must name an existing slot.", env) unless frame.has_slot?(key)
       frame.get(key)
     end
 
     
     def self.get_slot_if_impl(args, env)
       frame = args.car.evaluate(env)
-      raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
       key = args.cadr.evaluate(env)
-      raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." unless key.symbol?
+      return Lisp::Debug.process_error("Frame key (#{key.to_s}) must be a symbol but was #{key.type}.", env) unless key.symbol?
       frame.get(key)
     end
 
     
     def self.remove_slot_impl(args, env)
       frame = args.car.evaluate(env)
-      raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
       key = args.cadr.evaluate(env)
-      raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." unless key.symbol?
+      return Lisp::Debug.process_error("Frame key (#{key.to_s}) must be a symbol but was #{key.type}.", env) unless key.symbol?
       return Lisp::TRUE if frame.remove(key)
       Lisp::FALSE
     end
@@ -99,9 +103,9 @@ module Lisp
     
     def self.set_slot_impl(args, env)
       frame = args.car.evaluate(env)
-      raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
       key = args.cadr.evaluate(env)
-      raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." unless key.symbol?
+      return Lisp::Debug.process_error("Frame key (#{key.to_s}) must be a symbol but was #{key.type}.", env) unless key.symbol?
       value = args.caddr.evaluate(env)
       frame.at_put(key, value)
     end
@@ -109,12 +113,12 @@ module Lisp
 
     def self.send_impl(args, env)
       frame = args.car.evaluate(env)
-      raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
       selector = args.cadr.evaluate(env)
-      raise "Selector must be a symbol but was #{selector.type}." unless selector.symbol?
-      raise "Message sent must name an existing slot in the receiver." unless frame.has_slot?(selector)
+      return Lisp::Debug.process_error("Selector must be a symbol but was #{selector.type}.", env) unless selector.symbol?
+      return Lisp::Debug.process_error("Message sent must name an existing slot in the receiver.", env) unless frame.has_slot?(selector)
       func = frame.get(selector)
-      raise "Message sent must select a function slot but was #{func.type}." unless func.function?
+      return Lisp::Debug.process_error("Message sent must select a function slot but was #{func.type}.", env) unless func.function?
       params = args.cddr
       frame_env = Lisp::EnvironmentFrame.extending(env, frame)
       frame_env.bind_locally(Symbol.named("self"), frame)
@@ -132,11 +136,11 @@ module Lisp
     end
     
     def self.send_super_impl(args, env)
-      raise "super can only be used within the context of a frame." unless env.frame
+      return Lisp::Debug.process_error("super can only be used within the context of a frame.", env) unless env.frame
       selector = args.car.evaluate(env)
-      raise "Selector must be a symbol but was #{selector.type}." unless selector.symbol?
+      return Lisp::Debug.process_error("Selector must be a symbol but was #{selector.type}.", env) unless selector.symbol?
       func = get_super_function(selector, env)
-      raise "Message sent must select a function slot but was #{func.type}." unless func && func.function?
+      return Lisp::Debug.process_error("Message sent must select a function slot but was #{func.type}.", env) unless func && func.function?
       params = args.cdr
       frame_env = Lisp::EnvironmentFrame.extending(env, env.frame)
       frame_env.bind_locally(Symbol.named("self"), env.frame)
@@ -146,11 +150,18 @@ module Lisp
     
     def self.clone_impl(args, env)
       frame = args.car.evaluate(env)
-      raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
       frame.clone
     end
 
 
+    def self.keys_impl(args, env)
+      frame = args.car.evaluate(env)
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
+      ConsCell.array_to_list(frame.value.keys)
+    end
+
+
     def self.with_map(m)
       self.new(m)
     end
@@ -203,23 +214,37 @@ module Lisp
     end
 
 
-    def has_slot?(n)
+    def has_slot_helper(n, v)
+      return false if v.include?(self)
+      v << self
       return true if has_slot_locally?(n)
       return false unless has_parent_slots?
-      return parents.any? {|p| p.has_slot?(n)}
+      return parents.any? {|p| p.has_slot_helper(n, v)}
     end
     
   
-    def get(key)
+    def has_slot?(n)
+      has_slot_helper(n, Set.new)
+    end
+    
+  
+    def get_helper(key, v)
+      return nil if v.include?(self)
+      v << self
       return @value[key] if has_slot_locally?(key)
       parents.each do |p|
-        value = p.get(key)
+        value = p.get_helper(key, v)
         return value unless value.nil?
       end
       nil
     end
 
 
+    def get(key)
+      get_helper(key, Set.new)
+    end
+
+
     def remove(key)
       return false unless has_slot_locally?(key)
       @value.delete(key)
@@ -228,12 +253,7 @@ module Lisp
 
 
     def at_put(key, value)
-      return @value[key] = value if !has_slot?(key) || has_slot_locally?(key)
-      parents.each do |p|
-        v = p.at_put(key, value)
-        return v unless v.nil?
-      end
-      nil
+      return @value[key] = value
     end
 
     

data/lib/rubylisp/function.rb

@@ -2,7 +2,7 @@ module Lisp
 
   class Function < Atom
 
-    attr_reader :doc, :arity
+    attr_reader :doc, :arity, :name
     
     def compute_required_argument_count(args)
       a = args
@@ -35,12 +35,13 @@ module Lisp
 
     def internal_apply_to(parameters, env, should_eval)
       if @var_args
-        raise "#{@name} expected at least #{@arity} parameters, received #{parameters.length}." if parameters.length < @arity
+        return Lisp::Debug.process_error("#{@name} expected at least #{@arity} parameters, received #{parameters.length}.", env) if parameters.length < @arity
       else
-        raise "#{@name} expected #{@arity} parameters, received #{parameters.length}." unless parameters.length == @arity        
+        return Lisp::Debug.process_error("#{@name} expected #{@arity} parameters, received #{parameters.length}.", env) unless parameters.length == @arity        
       end
       
       local_env = EnvironmentFrame.extending(@env, env.frame)
+      local_env.previous = env
       self_sym = Symbol.named("self")
       if env.frame
         local_env.bind_locally(self_sym, env.frame)