rubylisp 0.1.0

data/lib/rubylisp/ffi_send.rb

@@ -0,0 +1,83 @@
+module Lisp
+
+  class FfiSend < Atom
+
+    def initialize(name)
+      @value = name.to_sym
+    end
+
+    def apply_to(args, env)
+      apply_to_without_evaluating(Lisp::ConsCell.array_to_list(args.to_a.map {|a| a.evaluate(env)}), env)
+    end
+
+    def convert_value(value)
+      case value.class.name
+      when "Fixnum", "Float"
+        Lisp::Number.with_value(value)
+      when "TrueClass"
+        Lisp::Boolean.TRUE
+      when "FalseClass"
+        Lisp::Boolean.FALSE
+      when "String"
+        Lisp::String.with_value(value)
+      when "Symbol"
+        Lisp::Symbol.named(value)
+      when "Array"
+        Lisp::ConsCell.array_to_list(value.map {|a| convert_value(a)})
+      else
+        Lisp::NativeObject.with_value(value)
+      end
+    end
+
+
+    def process_arg(a, env)
+      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)
+        end
+      elsif a.list?
+        a.to_a.map {|i| process_arg(i, env)}
+      else
+        a.value
+      end
+    end
+    
+
+    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?
+
+      arguments = args.cdr.nil? ? [] : args.cdr.to_a.map {|a| process_arg(a, env)}      
+      result = nil
+      
+      begin
+        result = if arguments[-1].instance_of?(Proc)
+                   target.value.send(@value, *(arguments[0..-2]), &arguments[-1])
+                 else
+#                   puts "Sending #{@value} with #{arguments}"
+                   target.value.send(@value, *arguments)
+                 end
+      rescue Exception => e
+        raise "Exception sending #{@value}: #{e}"
+      end
+
+      convert_value(result)
+    end
+
+    def to_s
+      ".#{@value}"
+    end
+
+    def primitive?
+      true
+    end
+
+    def type
+      :primitive
+    end
+
+  end
+
+end

data/lib/rubylisp/ffi_static.rb

@@ -0,0 +1,22 @@
+module Lisp
+
+  class FfiStatic < FfiSend
+
+    def initialize(name)
+      @class_name, @value = name.split('/')
+      @klass = NativeObject.with_value(Object.const_get(@class_name))
+    end
+
+    def apply_to(args, env)
+      a = [@klass] + args.to_a
+      super(a, env)
+    end
+
+    def to_s
+      "#{@class_name}/#{@value}"
+    end
+
+
+  end
+
+end

data/lib/rubylisp/frame.rb

@@ -0,0 +1,284 @@
+module Lisp
+
+  class Frame < Atom
+
+    def self.register
+      Primitive.register("make-frame", "(make-frame slot-name slot-value ... )\n\nFrames can be created using the make-frame function, passing it an alternating sequence of slot names and values:\n\n        (make-frame a: 1 b: 2)\n\nThis results in a frame with two slots, named a: and b: with values 1 and 2, respectively.") do |args, env|
+        Lisp::Frame::make_frame_impl(args, env)
+      end
+      
+      Primitive.register("has-slot?", "(has-slot? frame slot-name)\n\nThe has-slot? function is used to query whether a frame contains (directly or in an ancestor) the particular slot.") do |args, env|
+        Lisp::Frame::has_slot_impl(args, env)
+      end
+      
+      Primitive.register("get-slot", "(get-slot _frame_ _slot-name_)\n\nThe get-slot function is used to retrieve values from frame slots") do |args, env|
+        Lisp::Frame::get_slot_impl(args, env)
+      end
+      
+      Primitive.register("get-slot-if", "(get-slot-if frame slot-name)\n\nThe same as above, except that if a matching slot is not found, nil is returned instead of raising an error.") do |args, env|
+        Lisp::Frame::get_slot_if_impl(args, env)
+      end
+      
+      Primitive.register("remove-slot!", "(remove-slot! frame slot-name)\n\nThe remove-slot! function is used to function is used to remove a slot from a frame. It only removes slots from the frame itself. not any of it's parents. remove-slot! return #t if the slot was removed, #f otherwise.") do |args, env|
+        Lisp::Frame::remove_slot_impl(args, env)
+      end
+      
+      Primitive.register("set-slot!", "(set-slot! frame slot-name new-value)\n\nThe set-slot! function is used to change values in frame slots") do |args, env|
+        Lisp::Frame::set_slot_impl(args, env)
+      end
+      
+      Primitive.register("send", "(send frame slot-name arg...)\n\nSend the message slot-name to frame, passing along the arg collection. The result is what is returned by the code in that slot.") do |args, env|
+        Lisp::Frame::send_impl(args, env)
+      end
+      
+      Primitive.register("send-super", "**(send-super slot-name arg...)\n\nLike send, but sends to the first parent that has the named slot. send-super can only be used from within a frame.") do |args, env|
+        Lisp::Frame::send_super_impl(args, env)
+      end
+      
+      Primitive.register("clone", "(clone frame)\n\nFrames represent things. For example, you could use a frame that looks like {x: 1 y: 10} to represent a point. A system that would use point frames will typically need many independant points. The approach to this is to create a prototypical point data frame, and use the clone function to create individual, independant frames.") do |args, env|
+        Lisp::Frame::clone_impl(args, env)
+      end
+      
+    end
+
+
+    def self.make_frame_impl(args, env)
+      c = args
+      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?
+        v = c.cadr.evaluate(env)
+        m[k] = v
+        c = c.cddr
+      end
+
+      Lisp::Frame.with_map(m)
+    end
+
+
+    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?
+      key = args.cadr.evaluate(env)
+      raise "Frame key must be a symbol but was #{key.type}." unless key.symbol?
+      return Lisp::TRUE if frame.has_slot?(key)
+      Lisp::FALSE
+    end
+
+    
+    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?
+      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)
+      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?
+      key = args.cadr.evaluate(env)
+      raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." 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?
+      key = args.cadr.evaluate(env)
+      raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." unless key.symbol?
+      return Lisp::TRUE if frame.remove(key)
+      Lisp::FALSE
+    end
+
+    
+    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?
+      key = args.cadr.evaluate(env)
+      raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." unless key.symbol?
+      value = args.caddr.evaluate(env)
+      frame.at_put(key, value)
+    end
+    
+
+    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?
+      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)
+      func = frame.get(selector)
+      raise "Message sent must select a function slot but was #{func.type}." unless func.function?
+      params = args.cddr
+      frame_env = Lisp::EnvironmentFrame.extending(env, frame)
+      frame_env.bind_locally(Symbol.named("self"), frame)
+      func.apply_to(params, frame_env)
+    end
+
+    def self.get_super_function(selector, env)
+      f = env.frame
+      return nil if f.nil?
+      f.parents.each do |p|
+        func = p.get(selector)
+        return func unless func.nil?
+      end
+      nil
+    end
+    
+    def self.send_super_impl(args, env)
+      raise "super can only be used within the context of a frame." unless env.frame
+      selector = args.car.evaluate(env)
+      raise "Selector must be a symbol but was #{selector.type}." 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?
+      params = args.cdr
+      frame_env = Lisp::EnvironmentFrame.extending(env, env.frame)
+      frame_env.bind_locally(Symbol.named("self"), env.frame)
+      func.apply_to(params, frame_env)
+    end
+
+    
+    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?
+      frame.clone
+    end
+
+
+    def self.with_map(m)
+      self.new(m)
+    end
+
+    def initialize(m=nil)
+      @value = m || {}
+    end
+
+
+    def clone
+      Lisp::Frame.with_map(@value.clone)
+    end
+
+    
+    def is_parent_key(k)
+      k.to_s[-2] == "*"
+    end
+
+
+    def local_slots
+      @value.keys
+    end
+
+
+    def inherited_value_slots
+      parent_frames = parent_slots.collect {|pk| get(pk)}
+      parent_slots = parent_frames.collect {|p| p.inherited_value_slots}
+      local_value_slots = Set[local_slots.reject {|s| is_parent_key(k)}]
+      parent_slots.inject(local_value_slots) {|all, s| all + s} 
+    end
+    
+    
+    def has_parent_slots?
+      @value.keys.any? {|k| is_parent_key(k)}
+    end
+
+
+    def parent_slots
+      @value.keys.select {|k| is_parent_key(k)}
+    end
+
+
+    def parents
+      parent_slots.collect {|pk| @value[pk]}
+    end
+
+    
+    def has_slot_locally?(n)
+      @value.has_key?(n)
+    end
+
+
+    def has_slot?(n)
+      return true if has_slot_locally?(n)
+      return false unless has_parent_slots?
+      return parents.any? {|p| p.has_slot?(n)}
+    end
+    
+  
+    def get(key)
+      return @value[key] if has_slot_locally?(key)
+      parents.each do |p|
+        value = p.get(key)
+        return value unless value.nil?
+      end
+      nil
+    end
+
+
+    def remove(key)
+      return false unless has_slot_locally?(key)
+      @value.delete(key)
+      true
+    end
+
+
+    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
+    end
+
+    
+    def lisp_object?
+      true
+    end
+    
+    def type
+      :frame
+    end
+    
+    def empty?
+      @value.empty?
+    end
+
+    def frame?
+      true
+    end
+    
+    def length
+      return @value.length
+    end
+
+    def car
+      nil
+    end
+
+    def cdr
+      nil
+    end
+
+    def eq?(other)
+      return false unless other.frame?
+      return false unless @value.length == other.value.length
+      @value.each do |k, v|
+        return false unless Lisp::Equivalence.equal_check(other.value[k], v).value
+      end
+      true
+    end
+
+    def to_s
+      pairs = @value.collect {|k, v| "#{k.to_s} #{v.to_s}"}
+      "{#{pairs.join(' ')}}"
+    end
+    
+  end
+
+end

data/lib/rubylisp/function.rb

@@ -0,0 +1,92 @@
+module Lisp
+
+  class Function < Atom
+
+    attr_reader :doc
+    
+    def compute_required_argument_count(args)
+      a = args
+      @required_argument_count = 0
+      @var_args = false
+      while a
+        if a.symbol?
+          @var_args = true
+          return
+        else
+          @required_argument_count += 1
+        end
+        a = a.cdr
+      end
+    end
+    
+
+    def initialize(name, arguments, doc, body, env)
+      sig = ([name] << arguments.to_a).flatten
+      @doc = "(#{(sig.collect {|e| e.to_s}).join(" ")})"
+      @name = name
+      @arguments = arguments
+      @doc = [@doc, doc].join("\n\n") unless doc.nil? || doc.to_s.empty?
+      @body = body
+      @env = env
+      @local_env = nil
+      compute_required_argument_count(@arguments)
+    end
+    
+
+    def internal_apply_to(parameters, env, should_eval)
+      if @var_args
+        raise "#{@name} expected at least #{@required_argument_count} parameters, received #{parameters.length}." if parameters.length < @required_argument_count
+      else
+        raise "#{@name} expected #{@required_argument_count} parameters, received #{parameters.length}." unless parameters.length == @required_argument_count        
+      end
+      
+      local_env = EnvironmentFrame.extending(@env, env.frame)
+      self_sym = Symbol.named("self")
+      if env.frame
+        local_env.bind_locally(self_sym, env.frame)
+      elsif env.local_binding_for(self_sym)
+        local_env.bind_locally(self_sym, env.value_of(self_sym))
+      end
+      arg = @arguments
+      param = parameters
+      accumulating_arg = nil
+      accumulated_params = []
+      while !param.nil?        
+        param_value = should_eval ? param.car.evaluate(env) : param.car
+        if accumulating_arg
+          accumulated_params << param_value
+        else
+          local_env.bind_locally(arg.car, param_value) unless arg.car.nil?
+        end
+        param = param.cdr
+        arg = arg.cdr unless accumulating_arg
+        accumulating_arg = arg if arg.symbol?
+      end
+      local_env.bind_locally(accumulating_arg, Lisp::ConsCell.array_to_list(accumulated_params)) if accumulating_arg
+      
+      @body.evaluate_each(local_env)
+    end
+
+    def apply_to(parameters, env)
+      internal_apply_to(parameters, env, true)
+    end
+
+    def apply_to_without_evaluating(parameters, env)
+      internal_apply_to(parameters, env, false)
+    end
+
+    def to_s
+      "<function: #{@name}>"
+    end
+
+    def function?
+      true
+    end
+
+    def type
+      :function
+    end
+
+  end
+
+end

data/lib/rubylisp/io.rb

@@ -0,0 +1,74 @@
+module Lisp
+
+  class IO
+
+    def self.register
+      Primitive.register("load")         {|args, env| Lisp::IO::load_impl(args, env) }
+      Primitive.register("load-library") {|args, env| Lisp::IO::load_library_impl(args, env) }
+      Primitive.register("load-project") {|args, env| Lisp::IO::load_project_impl(args, env) }
+      Primitive.register("trace")        {|args, env| puts "Trace: #{(args.to_a.map {|a| a.evaluate(env).value.to_s}).join(' ')}"; nil} 
+      Primitive.register("error")        {|args, env| App.alert((args.to_a.map {|a| a.evaluate(env).value.to_s}).join(' '))}
+      Primitive.register("alert")        {|args, env| App.alert((args.to_a.map {|a| a.evaluate(env).value.to_s}).join(' '))}
+   end
+
+
+    def self.load_impl(args, env)
+      raise "'load' requires 1 argument." if args.empty?
+      fname = args.car.evaluate(env)
+      raise "'load' requires a string argument." unless fname.string?
+      filename = fname.value.end_with?(".lsp") ? fname.value : "#{fname.value}.lsp"
+      File.open(filename) do |f|
+        contents = f.read()
+        Lisp::Parser.new.parse_and_eval_all(contents)
+      end
+      Lisp::String.with_value("OK")
+    end
+
+    
+    def self.load_library_impl(args, env)
+      raise "'load-library' requires 1 argument." 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?
+      Dir.chdir(File.join(App.documents_path, "libraries", "#{library_name}.lib")) do |d|
+        if File.exists?("load.lsp")
+          File.open("load.lsp") do |f|
+            contents = f.read()
+            Lisp::Parser.new.parse_and_eval_all(contents)
+          end
+        else
+          Dir.glob("*.lsp") do |filename|
+            File.open(filename) do |f|
+              contents = f.read()
+              Lisp::Parser.new.parse_and_eval_all(contents)
+            end
+          end
+        end
+      end
+      Lisp::String.with_value("OK")
+    end
+
+    
+    def self.load_project_impl(args, env)
+      raise "'load-project' requires 1 argument." 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?
+      Dir.chdir(File.join(App.documents_path, "projects", "#{project_name}.prj")) do |d|
+        if File.exists?("load.lsp")
+          File.open("load.lsp") do |f|
+            contents = f.read()
+            Lisp::Parser.new.parse_and_eval_all(contents)
+          end
+        else
+          Dir.glob("*.lsp") do |filename|
+            File.open(filename) do |f|
+              contents = f.read()
+              Lisp::Parser.new.parse_and_eval_all(contents)
+            end
+          end
+        end
+      end
+      Lisp::String.with_value("OK")
+    end
+    
+  end
+end