rubylisp 0.2.1 → 1.0.2

data/lib/rubylisp/prim_equivalence.rb

@@ -0,0 +1,93 @@
+module Lisp
+
+  class PrimEquivalence
+
+    def self.register
+      Primitive.register("=", "2", "(= n1 n2)\n\nEquivalent to (eqv? n1 n2)") do |args, env|
+        Lisp::PrimEquivalence::eqv_impl(args, env)
+      end
+      
+      Primitive.register("==", "2", "(== n1 n2)\n\nEquivalent to (eqv? n1 n2)") do |args, env|
+        Lisp::PrimEquivalence::eqv_impl(args, env)
+      end
+      
+      Primitive.register("!=", "2", "(!= n1 n2)\n\nEquivalent to (neqv? n1 n2).") do |args, env|
+        Lisp::PrimEquivalence::neqv_impl(args, env)
+      end
+      
+      Primitive.register("/=", "2", "(/= n1 n2)\n\nEquivalent to (neqv? n1 n2).") do |args, env|
+        Lisp::PrimEquivalence::neqv_impl(args, env)
+      end
+
+      Primitive.register("eq?", "2") do |args, env|
+        Lisp::PrimEquivalence::eq_impl(args, env)
+      end
+      
+      Primitive.register("neq?", "2") do |args, env|
+        Lisp::PrimEquivalence::neq_impl(args, env)
+      end
+      
+      Primitive.register("eqv?", "2") do |args, env|
+        Lisp::PrimEquivalence::eqv_impl(args, env)
+      end
+      
+      Primitive.register("neqv?", "2") do |args, env|
+        Lisp::PrimEquivalence::eqv_impl(args, env)
+      end
+      
+      Primitive.register("equal?", "2") do |args, env|
+        Lisp::PrimEquivalence::equal_impl(args, env)
+      end
+      
+      Primitive.register("nequal?", "2") do |args, env|
+        Lisp::PrimEquivalence::nequal_impl(args, env)
+      end
+      
+    end
+    
+
+    def self.eqv_impl(args, env)
+      o1 = args.car
+      o2 = args.cadr
+      Lisp::Boolean.with_value(o1.eqv?(o2))
+    end
+    
+
+    def self.neqv_impl(args, env)
+      o1 = args.car
+      o2 = args.cadr
+      Lisp::Boolean.with_value(!o1.eqv?(o2))
+    end
+    
+
+    def self.eq_impl(args, env)
+      o1 = args.car
+      o2 = args.cadr
+      Lisp::Boolean.with_value(o1.eq?(o2))
+    end
+    
+
+    def self.neq_impl(args, env)
+      o1 = args.car
+      o2 = args.cadr
+      Lisp::Boolean.with_value(!o1.eq?(o2))
+    end
+    
+
+    def self.equal_impl(args, env)
+      o1 = args.car
+      o2 = args.cadr
+      Lisp::Boolean.with_value(o1.equal?(o2))
+    end
+    
+
+    def self.nequal_impl(args, env)
+      o1 = args.car
+      o2 = args.cadr
+      Lisp::Boolean.with_value(!o1.equal?(o2))
+    end
+    
+
+  end
+
+end

data/lib/rubylisp/prim_frame.rb

@@ -0,0 +1,166 @@
+module Lisp
+
+  class PrimFrame
+
+    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::PrimFrame::make_frame_impl(args, env)
+      end
+      
+      Primitive.register("has-slot?", "2", "(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::PrimFrame::has_slot_impl(args, env)
+      end
+      
+      Primitive.register("get-slot", "2", "(get-slot _frame_ _slot-name_)\n\nThe get-slot function is used to retrieve values from frame slots") do |args, env|
+        Lisp::PrimFrame::get_slot_impl(args, env)
+      end
+      
+      Primitive.register("get-slot-if", "2", "(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::PrimFrame::get_slot_if_impl(args, env)
+      end
+      
+      Primitive.register("remove-slot!", "2", "(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::PrimFrame::remove_slot_impl(args, env)
+      end
+      
+      Primitive.register("set-slot!", "3", "(set-slot! frame slot-name new-value)\n\nThe set-slot! function is used to change values in frame slots") do |args, env|
+        Lisp::PrimFrame::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::PrimFrame::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::PrimFrame::send_super_impl(args, env)
+      end
+      
+      Primitive.register("clone", "1", "(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::PrimFrame::clone_impl(args, env)
+      end
+      
+      Primitive.register("keys", "1", "(keys frame)\n\nReturn a list of the keys in the frame.") do |args, env|
+        Lisp::PrimFrame::keys_impl(args, env)
+      end
+      
+    end
+
+
+    def self.make_frame_impl(args, env)
+      c = args
+      m = {}
+      while !c.nil?
+        k = c.car
+        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
+        m[k] = v
+        c = c.cddr
+      end
+
+      Lisp::Frame.with_map(m)
+    end
+
+
+    def self.has_slot_impl(args, env)
+      frame = args.car
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
+      key = args.cadr
+      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
+
+    
+    def self.get_slot_impl(args, env)
+      frame = args.car
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
+      key = args.cadr
+      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
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
+      key = args.cadr
+      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
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
+      key = args.cadr
+      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
+
+    
+    def self.set_slot_impl(args, env)
+      frame = args.car
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
+      key = args.cadr
+      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
+      frame.at_put(key, value)
+    end
+    
+
+    def self.send_impl(args, env)
+      frame = args.car
+      return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
+      selector = args.cadr
+      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)
+      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, selector.to_s, 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)
+      return Lisp::Debug.process_error("super can only be used within the context of a frame.", env) unless env.frame
+      selector = args.car
+      return Lisp::Debug.process_error("Selector must be a symbol but was #{selector.type}.", env) unless selector.symbol?
+      func = get_super_function(selector, env)
+      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, selector.to_s, 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
+      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
+      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
+
+  end
+  
+end

data/lib/rubylisp/prim_io.rb

@@ -0,0 +1,266 @@
+module Lisp
+
+  class PrimIo
+
+    def self.register
+      Primitive.register("load", "1")         {|args, env| Lisp::PrimIo::load_impl(args, env) }
+      Primitive.register("open-input-file", "1") {|args, env| Lisp::PrimIo::open_input_file_impl(args, env) }
+      Primitive.register("open-output-file", "1|2") {|args, env| Lisp::PrimIo::open_output_file_impl(args, env) }
+      Primitive.register("close-port", "1") {|args, env| Lisp::PrimIo::close_port_impl(args, env) }
+      Primitive.register("write-string", "1|2") {|args, env| Lisp::PrimIo::write_string_impl(args, env) }
+      Primitive.register("newline", "0|1") {|args, env| Lisp::PrimIo::newline_impl(args, env) }
+      Primitive.register("write", "1|2") {|args, env| Lisp::PrimIo::write_impl(args, env) }
+      Primitive.register("read", "0|1") {|args, env| Lisp::PrimIo::read_impl(args, env) }
+      Primitive.register("list-directory", "1|2") {|args, env| Lisp::PrimIo::list_directory_impl(args, env) }
+      Primitive.register("eof-object?", "1") {|args, env| Lisp::PrimIo::eof_objectp_impl(args, env) }
+      Primitive.register("format", ">=2") {|args, env| Lisp::PrimIo::format_impl(args, env) }
+      # Primitive.register("load-library", "1") {|args, env| Lisp::PrimIo::load_library_impl(args, env) }
+      # Primitive.register("load-project", "1") {|args, env| Lisp::PrimIo::load_project_impl(args, env) }
+      Primitive.register("trace", "*")        {|args, env| puts "Trace: #{(args.to_a.map {|a| a.value.to_s}).join(' ')}"; nil} 
+      Primitive.register("error", "*")        {|args, env| App.alert((args.to_a.map {|a| a.value.to_s}).join(' '))}
+      Primitive.register("alert", "*")        {|args, env| App.alert((args.to_a.map {|a| a.value.to_s}).join(' '))}
+   end
+
+
+    def self.load_impl(args, env)
+      fname = args.car
+      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"
+      Lisp::Parser.new.process_file(filename)
+      Lisp::String.with_value("OK")
+    end
+
+    
+    def self.open_input_file_impl(args, env)
+      fname = args.car
+      return Lisp::Debug.process_error("'open-input-file' requires a string argument.", env) unless fname.string?
+      f = File.open(fname.value, "r")
+      f ? Lisp::Port.with_value(f) : nil
+    end
+
+    
+    def self.open_output_file_impl(args, env)
+      fname = args.car
+      return Lisp::Debug.process_error("'load' requires a string argument.", env) unless fname.string?
+      mode = (args.length == 2 && args.cadr.true?) ? "a" : "w"
+      f = File.open(fname.value, mode)
+      f ? Lisp::Port.with_value(f) : nil
+    end
+
+    
+    def self.close_port_impl(args, env)
+      p = args.car
+      return Lisp::Debug.process_error("'close-port' requires a port argument.", env) unless p.port?
+      p.value.close
+      Lisp::String.with_value("OK")
+    end
+
+    
+    def self.write_string_impl(args, env)
+      s = args.car
+      return Lisp::Debug.process_error("'write-string' requires a string first argument.", env) unless s.string?
+
+      if args.length == 2
+        p = args.cadr
+        return Lisp::Debug.process_error("'write-string' requires a port as it's second argument.", env) unless p.port?
+        port = p.value
+      else
+        port = $stdout
+      end
+
+      port.write(s.value)
+    end
+
+    
+    def self.newline_impl(args, env)
+      if args.length == 1
+        p = args.car
+        return Lisp::Debug.process_error("'newline' requires a port as it's argument.", env) unless p.port?
+        port = p.value
+      else
+        port = $stdout
+      end
+
+      port.write("\n")
+    end
+
+    
+    def self.write_impl(args, env)
+      if args.length == 2
+        p = args.cadr
+        return Lisp::Debug.process_error("'write' requires a port as it's second argument.", env) unless p.port?
+        port = p.value
+      else
+        port = $stdout
+      end
+
+      port.write(args.car.print_string)
+    end
+
+    
+    def self.read_impl(args, env)
+      if args.length == 1
+        p = args.car
+        return Lisp::Debug.process_error("'read' requires a port as it's argument.", env) unless p.port?
+        port = p.value
+      else
+        port = $stdin
+      end
+
+      Lisp::Parser.new.parse_object_from_file(port)
+    end
+
+    
+    def self.list_directory_impl(args, env)
+      return Lisp::Debug.process_error("'list-directory' requires a string as it's first argument.", env) unless args.car.string?
+      dir = args.car.value
+      fpart = (args.length == 2) ? args.cadr.value : "*"
+      filenames = Dir.glob(File.join(dir, fpart))
+      Lisp::ConsCell.array_to_list(filenames.map {|f| Lisp::String.with_value(f)})
+    end
+
+    
+    def self.eof_objectp_impl(args, env)
+      Boolean.with_value(args.car.eof_object?)
+    end
+
+    
+    def self.format_impl(args, env)
+      destination = args.car
+      return Lisp::Debug.process_error("'format' requires a port or boolean as it's first argument.", env) unless destination.port? || destination.boolean?
+
+      control_string_obj = args.cadr
+      return Lisp::Debug.process_error("'format' requires a string as it's second argument.", env) unless control_string_obj.string?
+      control_string = control_string_obj.value
+
+      arguments = args.cddr
+
+      number_of_substitutions = control_string.count('~')
+      parts = []
+      start = 0
+      i = 0
+      numeric_arg = 0
+      at_modifier = false
+      
+      while i < control_string.length
+        numeric_arg = 0
+        at_modifier = false
+
+        if control_string[i] == '~'
+          parts << control_string[start...i]
+          i += 1
+          start = i
+          i += 1 while '0123456789'.include?(control_string[i])
+          if i == start
+            if control_string[i] == '#'
+              numeric_arg = arguments.length
+              i += 1
+            elsif 'vV'.include?(control_string[i])
+              if arguments.car.number?
+                numeric_arg = arguments.car.value
+                arguments = arguments.cdr
+              else
+                return Lisp::Debug.process_error("'format' encountered a size argument mismatch at index #{i}.", env)
+              end
+              i += 1
+            else
+              numeric_arg = 0
+            end
+          else
+            numeric_arg = control_string[start...i].to_i
+          end
+          if control_string[i] == '@'
+            at_modifier = true
+            i += 1
+          end
+
+          case control_string[i]
+          when 'A', 'a', 'S', 's'
+            substitution = ('Aa'.include?(control_string[i])) ? arguments.car.print_string : arguments.car.to_s
+            padding = substitution.length < numeric_arg ? (" " * (numeric_arg - substitution.length)) : ""
+            parts << padding if at_modifier
+            parts << substitution
+            parts << padding unless at_modifier
+            arguments = arguments.cdr
+            start = i + 1
+          when '%'
+            parts << ((numeric_arg > 0) ? ("\n" * numeric_arg) : "\n")
+            start = i + 1
+          when '~'
+            parts << ((numeric_arg > 0) ? ("~" * numeric_arg) : "~")
+            start = i + 1
+          when "\n"
+            while control_string[i] =~ /[[:space:]]/
+              i += 1
+            end
+            parts << "\n" if at_modifier
+            start = i
+            i -= 1
+          else
+            return Lisp::Debug.process_error("'format' encountered an unsupported substitution at index #{i}.", env)
+          end
+        end
+        i += 1
+      end
+      parts << control_string[start..i] if start < control_string.length
+      return Lisp::Debug.process_error("'format' found a mismatch in the number of substitutions and arguments.", env) if i < control_string.length || !arguments.nil?
+
+      combined_string = parts.join
+
+      if destination.port?
+        destination.value.write(combined_string)
+      elsif destination.value
+        $stdout.write(combined_string)
+      else
+        return Lisp::String.with_value(combined_string)
+      end
+
+    end
+
+    
+  #   def self.load_library_impl(args, env)
+  #     library_name = args.car
+  #     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|
+  #           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)
+  #     project_name = args.car
+  #     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|
+  #           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