rubymotionlisp 0.1.4 → 0.2.0

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)

data/lib/rubylisp/io.rb

@@ -13,9 +13,9 @@ module Lisp
 
 
     def self.load_impl(args, env)
-      raise "'load' requires 1 argument." if args.empty?
+      return Lisp::Debug.process_error("'load' requires 1 argument.", env) if args.empty?
       fname = args.car.evaluate(env)
-      raise "'load' requires a string argument." unless fname.string?
+      return Lisp::Debug.process_error("'load' requires a string argument.", env) unless fname.string?
       filename = fname.value.end_with?(".lsp") ? fname.value : "#{fname.value}.lsp"
       File.open(filename) do |f|
         contents = f.read()
@@ -26,9 +26,9 @@ module Lisp
 
     
     def self.load_library_impl(args, env)
-      raise "'load-library' requires 1 argument." if args.empty?
+      return Lisp::Debug.process_error("'load-library' requires 1 argument.", env) if args.empty?
       library_name = args.car.evaluate(env)
-      raise "'load-library' requires a string or symbol argument." unless library_name.string? || library_name.symbol?
+      return Lisp::Debug.process_error("'load-library' requires a string or symbol argument.", env) unless library_name.string? || library_name.symbol?
       Dir.chdir(File.join(App.documents_path, "libraries", "#{library_name}.lib")) do |d|
         if File.exists?("load.lsp")
           File.open("load.lsp") do |f|
@@ -49,9 +49,9 @@ module Lisp
 
     
     def self.load_project_impl(args, env)
-      raise "'load-project' requires 1 argument." if args.empty?
+      return Lisp::Debug.process_error("'load-project' requires 1 argument.", env) if args.empty?
       project_name = args.car.evaluate(env)
-      raise "'load-project' requires a string or symbol argument." unless project_name.string? || project_name.symbol?
+      return Lisp::Debug.process_error("'load-project' requires a string or symbol argument.", env) unless project_name.string? || project_name.symbol?
       Dir.chdir(File.join(App.documents_path, "projects", "#{project_name}.prj")) do |d|
         if File.exists?("load.lsp")
           File.open("load.lsp") do |f|