rubymotionlisp 0.2.2 → 1.0.0

data/lib/rubylisp/cons_cell.rb

@@ -5,6 +5,7 @@ module Lisp
     attr_reader :car, :cdr
 
     def self.cons(a=nil, b=nil)
+      b = nil if b.pair? && b.empty?
       ConsCell.new(a, b)
     end
 
@@ -31,8 +32,9 @@ module Lisp
 
 
     def set_nth!(n, d)
+      return nil if empty?
       c = self
-      (n-1).times {|i| c = c.cdr}
+      n.times {|i| c = c.cdr}
       c.set_car!(d)
     end
 
@@ -93,10 +95,6 @@ module Lisp
       true
     end
 
-    def alist?
-      false
-    end
-
     def frame?
       false
     end
@@ -104,10 +102,21 @@ module Lisp
     def vector?
       false
     end
+
+    def eq?(other)
+      return true if empty? && (other.nil? || (other.pair? && other.empty?))
+      other.pair? && self == other
+    end
+
+    def eqv?(other)
+      return true if empty? && (other.nil? || (other.pair? && other.empty?))
+      other.pair? && self == other
+    end
     
-    def eq?(sexpr)
-      return false unless sexpr.pair?
-      (@car == sexpr.car || @car.eq?(sexpr.car)) && (@cdr == sexpr.cdr || @cdr.eq?(sexpr.cdr))
+    def equal?(other)
+      return true if empty? && (other.nil? || (other.pair? && other.empty?))
+      return false unless other.pair?
+      @car.equal?(other.car) && @cdr.equal?(other.cdr)
     end
     
     def type
@@ -124,7 +133,7 @@ module Lisp
       return "()" if self.empty?
       return "'#{@cdr.car.to_s}" if @car.symbol? && @car.name == "quote"
       return "{#{@cdr.to_s_helper}}" if @car.symbol? && @car.name == "make-frame"
-      return "[#{@cdr.to_s_helper}]" if @car.symbol? && @car.name == "make-vector"
+      return "#(#{@cdr.to_s_helper})" if @car.symbol? && @car.name == "make-vector"
       return "(#{@car.to_s} . #{@cdr.to_s})" if !@cdr.nil? && !@cdr.pair?
       return "(#{self.to_s_helper})"
     end
@@ -137,22 +146,24 @@ module Lisp
       return "()" if self.empty?
       return "'#{@cdr.car.print_string}" if @car.symbol? && @car.name == "quote"
       return "{#{@cdr.print_string_helper}}" if @car.symbol? && @car.name == "make-frame"
-      return "[#{@cdr.print_string_helper}]" if @car.symbol? && @car.name == "make-vector"
+      return "#(#{@cdr.print_string_helper})" if @car.symbol? && @car.name == "make-vector"
       return "(#{@car.print_string} . #{@cdr.print_string})" if !@cdr.nil? && !@cdr.pair?
       return "(#{self.print_string_helper})"
     end
 
     def to_a
       a = []
+      return a if empty?
       c = self
       until c.nil?
-        a << c.car()
+        a << c.car
         c = c.cdr
       end
       a
     end
 
     def each &block
+      return if empty?
       c = self
       if self.length > 0
         until c.nil?
@@ -163,11 +174,11 @@ module Lisp
     end
 
     def self.array_to_list(cells, tail=nil)
-      return tail if cells.empty?
+      return cons() if cells.empty? && tail.nil?
       head = ConsCell.new
       last_cell = head
-      cells.each do |d|
-        new_cell = self.cons(d, nil)
+      (0...cells.length).each do |i|
+        new_cell = self.cons(cells[i], nil)
         last_cell.set_cdr!(new_cell)
         last_cell = new_cell
       end
@@ -193,13 +204,13 @@ module Lisp
 
     def nth(n)
       c = self
-      (n-1).times {|i| c = c.cdr}
+      n.times {|i| c = c.cdr}
       c.car
     end
 
     def nth_tail(n)
       c = self
-      (n-1).times {|i| c = c.cdr}
+      n.times {|i| c = c.cdr}
       c
     end
 
@@ -225,6 +236,7 @@ module Lisp
           Lisp::Debug.debug_repl(env)
         end
       end
+
       result = func.apply_to(@cdr, env)
       env.current_code.shift() if !Lisp::Debug.eval_in_debug_repl && Lisp::Debug.interactive
       Lisp::Debug.log_result(result, env)
@@ -236,8 +248,8 @@ module Lisp
       return self if empty?
       sexpr = if @car.symbol?
                 key = @car
-                frame = nth(2)
-                value = nth(3)
+                frame = nth(1)
+                value = nth(2)
                 
                 s = key.name
                 if s.end_with?(":")
@@ -246,6 +258,10 @@ module Lisp
                   ConsCell.array_to_list([Symbol.named("set-slot!"), frame, Symbol.named(s[0..-2]), value])
                 elsif s.end_with?(":?")
                   ConsCell.array_to_list([Symbol.named("has-slot?"), frame, Symbol.named(s[0..-2])])
+                elsif s.end_with?(":>")
+                  ConsCell.array_to_list([Symbol.named("send"), frame, Symbol.named(s[0..-2])] << self.cdddr)
+                elsif s.end_with?(":^")
+                  ConsCell.array_to_list([Symbol.named("send-super"), frame, Symbol.named(s[0..-2])] << self.cdddr)
                 else
                   self
                 end
@@ -256,6 +272,7 @@ module Lisp
     end
 
     def evaluate_each(env)
+      return nil if empty?
       result = @car.evaluate(env)
       return result if @cdr.nil?
       @cdr.evaluate_each(env)
@@ -287,9 +304,22 @@ module Lisp
       c
     end
 
+    def print_ary(a)
+      (0...a.length).map {|i| puts (a[i].nil? ? "nil" : a[i])}
+    end
+    
     def flatten
-      ary = to_a.collect {|s| s.list? ? s.to_a : s}
-      ConsCell.array_to_list(ary.flatten)
+      ary = []
+      to_a.each do |s|
+        if s.nil?
+          ary << nil
+        elsif s.list?
+          s.to_a.each {|e| ary << e}
+        else
+          ary << s
+        end
+      end
+      ConsCell.array_to_list(ary)
     end
     
     

data/lib/rubylisp/environment.rb

@@ -0,0 +1,27 @@
+module Lisp
+
+  class Environment < Atom
+
+    def self.with_value(e)
+      self.new(e)
+    end
+
+    def initialize(e)
+      @value = e
+    end
+
+    def environment?
+      true
+    end
+
+    def equal?(other)
+      other.environment? && @value == other.value
+    end
+
+    def type
+      :environment
+    end
+
+  end
+
+end

data/lib/rubylisp/environment_frame.rb

@@ -2,21 +2,25 @@ module Lisp
 
   class EnvironmentFrame
 
-    attr_accessor :frame, :current_code, :previous
+    attr_accessor :frame, :current_code, :previous, :name
+    attr_reader :parent
     
     def self.global
-      @@global_frame ||= EnvironmentFrame.new(nil)
+      @@global_frame ||= EnvironmentFrame.new(nil, "GLOBAL")
       @@global_frame
     end
 
-    def self.extending(parent, f=nil)
+    def self.extending(parent, name, f=nil)
       f ||= parent.frame if parent && parent.has_frame?
-      self.new(parent, f)
+      e = self.new(parent, name, f)
+      TopLevelEnvironments[name] = e if parent.nil? || parent == self.global
+      e
     end
 
-    def initialize(parent, f=nil)
+    def initialize(parent, name, f=nil)
       @bindings = []
       @parent = parent
+      @name = name
       @frame = f
       @current_code = []
     end
@@ -27,6 +31,14 @@ module Lisp
     
     # Bindings following parent env frame pointer
 
+    def bound_names
+      @bindings.map {|b| b.symbol}
+    end
+
+    def bound_values
+      @bindings.map {|b| b.value}
+    end
+
     def is_name_bound?(str)
       if !@frame && @frame.has_slot?(Lisp:Symbol.named("#{str}:", true))
         return true
@@ -38,6 +50,11 @@ module Lisp
       return @parent.is_name_bound?(str)
     end
 
+    def name_bound_locally?(str)
+      binding = @bindings.detect {|b| b.symbol.name == str}
+      !binding.nil?
+    end
+
     def binding_for(symbol)
       binding = @bindings.detect {|b| b.symbol.name == symbol.name}
       return binding unless binding.nil?
@@ -152,8 +169,9 @@ module Lisp
         1 + @previous.depth
       end
     end
-    
+
   end
 
+  TopLevelEnvironments = {}
 
 end

data/lib/rubylisp/eof_object.rb

@@ -0,0 +1,26 @@
+module Lisp
+
+  class EofObject < Atom
+
+    def self.instance
+      @instance ||= self.new()
+    end
+
+    def initialize()
+    end
+
+    def type
+      :eof_object
+    end
+
+    def eof_object?
+      true
+    end
+
+    def to_s
+      "<EOF>"
+    end
+
+  end
+
+end

data/lib/rubylisp/exception.rb

@@ -3,81 +3,81 @@ module Lisp
   class Exception
 
     def self.register
-      Primitive.register("raise")     {|args, env| Lisp::Exception::raise_impl(args, env) }
-      Primitive.register("reraise")   {|args, env| Lisp::Exception::reraise_impl(args, env) }
-      Primitive.register("try")       {|args, env| Lisp::Exception::try_impl(args, env) }
-      Primitive.register("reraise")   {|args, env| Lisp::Exception::reraise_impl(args, env) }
-      Primitive.register("resume")    {|args, env| Lisp::Exception::resume_impl(args, env) }
-      Primitive.register("restart")   {|args, env| Lisp::Exception::restart_impl(args, env) }
+      # Primitive.register("raise")     {|args, env| Lisp::Exception::raise_impl(args, env) }
+      # Primitive.register("reraise")   {|args, env| Lisp::Exception::reraise_impl(args, env) }
+      # Primitive.register("try")       {|args, env| Lisp::Exception::try_impl(args, env) }
+      # Primitive.register("reraise")   {|args, env| Lisp::Exception::reraise_impl(args, env) }
+      # Primitive.register("resume")    {|args, env| Lisp::Exception::resume_impl(args, env) }
+      # Primitive.register("restart")   {|args, env| Lisp::Exception::restart_impl(args, env) }
     end
 
 
-    def handler_or_nil(handlers, exception_name)
-      handlers.each do |handler_pair|
-        exceptions = handler_pair.car
-        if exceptions.eq(exception_name) || (exceptions.pair? && exceptions.include?(exception_name))
-          handler_pair.cdr
-        else
-          nil
-        end
-      end
-    end
-
-    def self.do_exception(name, with_message, args, env)
-      frame = env
-      while !frame.nil?
-        handlers = frame.value_of(Symbol.named("__handlers__"))
-        unless handlers.nil?
-          handler = handler_or_nil(handlers, for: name)
-          unless handler.nil?
-            handler.apply_to_without_evaluating(args, frame)
-            break
-          end
-        end
-        frame = frame.parent
-        if frame.nil?
-          exception_message = message.empty? ? "" : ": #{message}"
-          return Lisp::Debug.process_error("Unhandled Exception: #{exception_name}#{exception_message}", env)
-        end
-      end
-    end
+    # def handler_or_nil(handlers, exception_name)
+    #   handlers.each do |handler_pair|
+    #     exceptions = handler_pair.car
+    #     if exceptions.eq(exception_name) || (exceptions.pair? && exceptions.include?(exception_name))
+    #       handler_pair.cdr
+    #     else
+    #       nil
+    #     end
+    #   end
+    # end
+
+    # def self.do_exception(name, with_message, args, env)
+    #   frame = env
+    #   while !frame.nil?
+    #     handlers = frame.value_of(Symbol.named("__handlers__"))
+    #     unless handlers.nil?
+    #       handler = handler_or_nil(handlers, for: name)
+    #       unless handler.nil?
+    #         handler.apply_to_without_evaluating(args, frame)
+    #         break
+    #       end
+    #     end
+    #     frame = frame.parent
+    #     if frame.nil?
+    #       exception_message = message.empty? ? "" : ": #{message}"
+    #       return Lisp::Debug.process_error("Unhandled Exception: #{exception_name}#{exception_message}", env)
+    #     end
+    #   end
+    # end
     
     def self.raise_impl(args, env)
-      return Lisp::Debug.process_error("'raise' requires at least one argument.", env) unless args.length > 0
-      exception_name = args.car.evaluate(env)
-      return Lisp::Debug.process_error("'raise' requires an exception name as it's first argument.", env) unless exception_name.string? || class_name.symbol?
+      # return Lisp::Debug.process_error("'raise' requires at least one argument.", env) unless args.length > 0
+      # exception_name = args.car.evaluate(env)
+      # 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)
-        return Lisp::Debug.process_error("The message parameter to 'raise' must be a string.", env) unless message.string?
-      end
+      # message = ""
+      # if args.length > 1
+      #   message = args.cadr.evaluate(env)
+      #   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
+      # handler_args = args.length > 2 ? Lisp::ConsCell.array_to_list(args.cdr.to_a.collect {|a| a.evaluate(env)}) : Lisp::ConsCell.new
     end
   
 
     def self.try_impl(args, env)
-      raw_handlers = args.car
-      body = args.cdr
+      # raw_handlers = args.car
+      # body = args.cdr
       
-      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
+      # 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
       
-      array_of_handlers = raw_handlers.to_a.collect do |h|
-        ex = h.car
-        f = h.cadr.evaluate(env)
-      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)
-      env.bind_locally(Symbol.named("__handlers__"), handlers)
+      # array_of_handlers = raw_handlers.to_a.collect do |h|
+      #   ex = h.car
+      #   f = h.cadr.evaluate(env)
+      # 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)
+      # env.bind_locally(Symbol.named("__handlers__"), handlers)
       
-      body.evaluate_each(env)
+      # body.evaluate_each(env)
     end
 
 

data/lib/rubylisp/ext.rb

@@ -5,15 +5,29 @@ class NilClass
   end
   
   def false?
-    true
+    false
   end
 
   def to_s
     "()"
   end
 
+  
+  def to_ary
+    []
+  end
+
+  
+  def eqv?(other)
+    other.nil? || (other.pair? && other.empty?)
+  end
+  
   def eq?(other)
-    other.nil?
+    other.nil? || (other.pair? && other.empty?)
+  end
+  
+  def equal?(other)
+    other.nil? || (other.pair? && other.empty?)
   end
   
   def print_string
@@ -84,14 +98,25 @@ class NilClass
     true
   end
   
+  def vector?
+    false
+  end
+  
+  def environment?
+    false
+  end
+  
   def method_missing(name, *args, &block)
-    if name[0] == ?c && name[-1] == ?r && (name[1..-2].chars.all? {|e| "ad".include?(e)})
+    is_list_walk = name[0] == ?c && name[-1] == ?r && (name[1..-2].chars.all? {|e| "ad".include?(e)})
+    if is_list_walk
       nil
     else
+      #puts "nil#method_missing name: #{name} args #{args}"
+      #puts caller
       super
     end
   end
-
+  
   def primitive?
     false
   end
@@ -112,8 +137,9 @@ class NilClass
     true
   end
     
-
-  
+  def flatten
+    nil
+  end  
 end
 
 

data/lib/rubylisp/ffi_new.rb

@@ -4,14 +4,15 @@ module Lisp
 
     def initialize(name)
       @value = name
-      @klass = Object.const_get(name)
     end
 
     def apply_to(args, env)
+      @klass = Object.const_get(@value)
       NativeObject.with_value(@klass.new)
     end
 
     def apply_to_without_evaluating(args, env)
+      @klass = Object.const_get(@value)
       NativeObject.with_value(@klass.new)
     end
 

data/lib/rubylisp/ffi_send.rb

@@ -10,7 +10,9 @@ module Lisp
       apply_to_without_evaluating(Lisp::ConsCell.array_to_list(args.to_a.map {|a| a.evaluate(env)}), env)
     end
 
+    # convert a rubymotion arg to a lisp arg
     def convert_value(value)
+      #puts "convert_value(#{value.to_s})\n"
       case value.class.name
       when "Fixnum", "Float"
         Lisp::Number.with_value(value)
@@ -30,11 +32,17 @@ module Lisp
     end
 
 
+    # convert a lisp arg to a rubymotion arg
     def process_arg(a, env)
+      #puts "process_arg(#{a.to_s})"
       if a.function?
-        proc do |*args|
-          arg_list = args.empty? ? nil : Lisp::ConsCell.array_to_list(args.collect {|arg| convert_value(arg) })
-          a.apply_to(arg_list, env)
+        #puts "function arg"
+        proc do #|*args|
+          #puts "Proc argument invoked"
+          # arg_list = args.empty? ? nil : Lisp::ConsCell.array_to_list(args.collect {|arg| convert_value(arg) })
+          # puts "Applying #{@a.to_s} to #{arg_list}"
+         
+          a.apply_to(nil, env)
         end
       elsif a.list?
         a.to_a.map {|i| process_arg(i, env)}
@@ -49,6 +57,8 @@ module Lisp
       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?
 
+      # puts "Sending #{@value} to #{target.to_s} with raw args #{args}"
+
       arguments = args.cdr.nil? ? [] : args.cdr.to_a.map {|a| process_arg(a, env)}      
       result = nil
       
@@ -56,11 +66,11 @@ module Lisp
         result = if arguments[-1].instance_of?(Proc)
                    target.value.send(@value, *(arguments[0..-2]), &arguments[-1])
                  else
-#                   puts "Sending #{@value} with #{arguments}"
+                   # puts "Sending #{@value} to #{target} with processed args #{arguments}"
                    target.value.send(@value, *arguments)
                  end
       rescue Exception => e
-        return Lisp::Debug.process_error("Exception sending #{@value}: #{e}", env)
+        return Lisp::Debug.process_error("Exception sending #{@value} - #{e.name}", env)
       end
 
       convert_value(result)