rubylisp 0.2.1 → 1.0.2

data/lib/rubylisp/prim_system.rb

@@ -0,0 +1,55 @@
+module Lisp
+
+  class PrimSystem
+
+    def self.register
+      Primitive.register("sleep", "1") {|args, env| Lisp::PrimSystem.sleep_impl(args, env) }
+      Primitive.register("time", "1", "", true)  {|args, env| Lisp::PrimSystem.time_impl(args, env) }
+      Primitive.register("quit", "0")  {|args, env| exit() }
+      Primitive.register("error", "1")  {|args, env| Lisp::PrimSystem.error_impl(args, env) }
+      Primitive.register("on-error", "2|3", "", true)  {|args, env| Lisp::PrimSystem.on_error_impl(args, env) }
+    end
+
+    
+    def self.sleep_impl(args, env)
+      arg = args.car
+      return Lisp::Debug.process_error("sleep needs a numeric argument", env) unless arg.number?
+      sleep(arg.value)
+    end
+
+    
+    def self.time_impl(args, env)
+      start_time = Time.now
+      args.car.evaluate(env)
+      end_time = Time.now
+      Lisp::Number.with_value(end_time - start_time)
+    end    
+
+
+    def self.error_impl(args, env)
+      #puts "error #{args.car.print_string}"
+      Lisp::Debug.process_error(args.car.to_s, env)
+    end
+    
+
+    def self.on_error_impl(args, env)
+      #puts "on-error ===> #{args.car.body.print_string}"
+      begin
+        result = args.car.evaluate(env)
+      rescue => e
+        handler = args.cadr.evaluate(env)
+        return Lisp::Debug.process_error("on-error needs a function as it's second argument", env) unless handler.function?
+        #puts "ERROR: #{e}"
+        err_string = Lisp::String.with_value("#{e}")
+        handler.apply_to(Lisp::ConsCell.array_to_list([err_string]), env)
+      else
+        if args.length == 3
+          handler = args.caddr.evaluate(env)
+          return Lisp::Debug.process_error("on-error needs a function as it's third argument", env) unless handler.function?
+          handler.apply_to(nil, env)
+        end
+      end
+    end
+    
+  end
+end

data/lib/rubylisp/prim_type_checks.rb

@@ -0,0 +1,58 @@
+module Lisp
+
+  class PrimTypeChecks
+
+    def self.register
+      Primitive.register("list?", "1")     {|args, env| Lisp::PrimTypeChecks::typep_impl(args.car, :pair) }
+      Primitive.register("pair?", "1")     {|args, env| Lisp::PrimTypeChecks::typep_impl(args.car, :pair) }
+      Primitive.register("symbol?", "1")   {|args, env| Lisp::PrimTypeChecks::typep_impl(args.car, :symbol) }
+      Primitive.register("number?", "1")   {|args, env| Lisp::PrimTypeChecks::typep_impl(args.car, :number) }
+      Primitive.register("frame?", "1")   {|args, env| Lisp::PrimTypeChecks::typep_impl(args.car, :frame) }
+
+      Primitive.register("integer?", "1")  {|args, env| Lisp::PrimTypeChecks::integerp_impl(args, env) }
+      Primitive.register("float?", "1")    {|args, env| Lisp::PrimTypeChecks::floatp_impl(args, env) }
+      Primitive.register("function?", "1") {|args, env| Lisp::PrimTypeChecks::functionp_impl(args, env) }
+
+      Primitive.register("nil?", "1")      {|args, env| Lisp::PrimTypeChecks::nilp_impl(args, env) }
+      Primitive.register("null?", "1")     {|args, env| Lisp::PrimTypeChecks::nilp_impl(args, env) }
+      Primitive.register("not-nil?", "1")  {|args, env| Lisp::PrimTypeChecks::not_nilp_impl(args, env) }
+      Primitive.register("not-null?", "1") {|args, env| Lisp::PrimTypeChecks::not_nilp_impl(args, env) }
+    end
+
+
+    def self.typep_impl(val, sym)
+      return Lisp::Boolean.with_value(val.type == sym)
+    end
+
+
+    def self.integerp_impl(args, env)
+      val = args.car
+      return Lisp::Boolean.with_value(val.type == :number && val.integer?)
+    end
+
+
+    def self.floatp_impl(args, env)
+      val = args.car
+      return Lisp::Boolean.with_value(val.type == :number && val.float?)
+    end
+
+
+    def self.functionp_impl(args, env)
+      val = args.car
+      return Lisp::Boolean.with_value(val.type == :function || val.type == :primitive)
+    end
+
+
+    def self.nilp_impl(args, env)
+      return Lisp::Boolean.with_value(args.car.nil? || (args.car.pair? && args.car.empty?))
+    end
+
+
+    def self.not_nilp_impl(args, env)
+      return Lisp::FALSE if args.car.nil?
+      return Lisp::TRUE unless args.car.pair?
+      return Lisp::Boolean.with_value(args.car.pair? && !args.car.empty?)
+    end
+
+  end
+end

data/lib/rubylisp/prim_vector.rb

@@ -0,0 +1,497 @@
+module Lisp
+
+  class PrimVector
+
+    def self.register
+      Primitive.register("vector?", "1")   {|args, env| Lisp::PrimVector::vectorp_impl(args, env) }
+      Primitive.register("make-vector", "1|2")   {|args, env| Lisp::PrimVector::make_vector_impl(args, env) }
+      Primitive.register("make-initialized-vector", "2")   {|args, env| Lisp::PrimVector::make_initialized_vector_impl(args, env) }
+      Primitive.register("vector", "*")   {|args, env| Lisp::PrimVector::vector_impl(args, env) }
+      Primitive.register("list->vector", "1") {|args, env| Lisp::PrimVector::list_to_vector_impl(args, env) }
+      Primitive.register("vector->list", "1") {|args, env| Lisp::PrimVector::vector_to_list_impl(args, env) }
+      Primitive.register("vector-copy", "1") {|args, env| Lisp::PrimVector::vector_copy_impl(args, env) }
+      Primitive.register("vector-grow", "2") {|args, env| Lisp::PrimVector::vector_grow_impl(args, env) }
+      Primitive.register("vector-map", "2") {|args, env| Lisp::PrimVector::vector_map_impl(args, env) }
+      Primitive.register("vector-reduce-left", "3") {|args, env| Lisp::PrimVector::vector_reduce_left_impl(args, env) }
+      Primitive.register("vector-for-each", "2") {|args, env| Lisp::PrimVector::vector_for_each_impl(args, env) }
+      Primitive.register("vector-length", "1") {|args, env| Lisp::PrimVector::vector_length_impl(args, env) }
+      Primitive.register("vector-ref", "2") {|args, env| Lisp::PrimVector::vector_ref_impl(args, env) }
+      Primitive.register("vector-set!", "3") {|args, env| Lisp::PrimVector::vector_set_impl(args, env) }
+      Primitive.register("vector-first", "1") {|args, env| Lisp::PrimVector::vector_first_impl(args, env) }
+      Primitive.register("vector-second", "1") {|args, env| Lisp::PrimVector::vector_second_impl(args, env) }
+      Primitive.register("vector-third", "1") {|args, env| Lisp::PrimVector::vector_third_impl(args, env) }
+      Primitive.register("vector-fourth", "1") {|args, env| Lisp::PrimVector::vector_fourth_impl(args, env) }
+      Primitive.register("vector-fifth", "1") {|args, env| Lisp::PrimVector::vector_fifth_impl(args, env) }
+      Primitive.register("vector-sixth", "1") {|args, env| Lisp::PrimVector::vector_sixth_impl(args, env) }
+      Primitive.register("vector-seventh", "1") {|args, env| Lisp::PrimVector::vector_seventh_impl(args, env) }
+      Primitive.register("vector-eighth", "1") {|args, env| Lisp::PrimVector::vector_eighth_impl(args, env) }
+      Primitive.register("vector-ninth", "1") {|args, env| Lisp::PrimVector::vector_ninth_impl(args, env) }
+      Primitive.register("vector-tenth", "1") {|args, env| Lisp::PrimVector::vector_tenth_impl(args, env) }
+      Primitive.register("vector-binary-search", "4") {|args, env| Lisp::PrimVector::vector_binary_search_impl(args, env) }
+      Primitive.register("subvector", "3") {|args, env| Lisp::PrimVector::subvector_impl(args, env) }
+      Primitive.register("vector-head", "2") {|args, env| Lisp::PrimVector::vector_head_impl(args, env) }
+      Primitive.register("vector-tail", "2") {|args, env| Lisp::PrimVector::vector_tail_impl(args, env) }
+      Primitive.register("vector-fill!", "2") {|args, env| Lisp::PrimVector::vector_fill_impl(args, env) }
+      Primitive.register("subvector-fill!", "4") {|args, env| Lisp::PrimVector::subvector_fill_impl(args, env) }
+      Primitive.register("subvector-move-left!", "5") {|args, env| Lisp::PrimVector::subvector_move_left_impl(args, env) }
+      Primitive.register("subvector-move-right!", "5") {|args, env| Lisp::PrimVector::subvector_move_right_impl(args, env) }
+      Primitive.register("vector-filter", "2") {|args, env| Lisp::PrimVector::vector_filter_impl(args, env) }
+      Primitive.register("vector-remove", "2") {|args, env| Lisp::PrimVector::vector_remove_impl(args, env) }
+      Primitive.register("sort!", "2") {|args, env| Lisp::PrimVector::vector_merge_sort_impl(args, env) }
+      Primitive.register("merge-sort!", "2") {|args, env| Lisp::PrimVector::vector_merge_sort_impl(args, env) }
+      Primitive.register("quick-sort!", "2") {|args, env| Lisp::PrimVector::vector_quick_sort_impl(args, env) }
+    end
+
+    def self.vectorp_impl(args, env)
+      Boolean.with_value(args.car.vector?)
+    end
+    
+
+    def self.make_initialized_vector_impl(args, env)
+      k = args.car
+      return Lisp::Debug.process_error("make-vector requires its first argument to be a non-negative integer, but received #{k.to_s}.", env) unless k.integer? && k.value >= 0
+      proc = args.cadr
+      return Lisp::Debug.process_error("make-initialized-vector requires its second argument to be a procedure, but received #{proc.to_s}.", env) unless proc.function? || proc.primitive?
+      a = Array.new(k.value) {|i| proc.apply_to(Lisp::ConsCell.array_to_list([Lisp::Number.with_value(i)]), env)}
+      Lisp::Vector.with_array(a)
+    end
+  
+
+    def self.make_vector_impl(args, env)
+      k = args.car
+      return Lisp::Debug.process_error("make-vector requires its first argument to be a non-negative integer, but received #{k.to_s}.", env) unless k.integer? && k.value >= 0
+      obj = (args.length == 2) ? args.cadr : nil
+      Lisp::Vector.new(Array.new(k.value, obj))
+    end
+  
+
+    def self.vector_impl(args, env)
+      Lisp::Vector.with_array(args.to_a)
+    end
+
+    
+    def self.list_to_vector_impl(args, env)
+      l = args.car
+      return Lisp::Debug.process_error("list->vector requires its first argument to be a list, but received #{l.to_s}.", env) unless l.list?
+      Lisp::Vector.with_array(l.to_a)
+    end
+
+    
+    def self.vector_to_list_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector->list requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      Lisp::ConsCell.array_to_list(v.to_a)
+    end
+
+    
+    def self.vector_copy_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("list->vector requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      Lisp::Vector.with_array(v.to_a.clone)
+    end
+
+    
+    def self.vector_grow_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-grow requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      len = v.length
+      k = args.cadr
+      return Lisp::Debug.process_error("vector-grow requires its second argument to be a non-negative integer > the length of the vector, but received #{k.to_s}.", env) unless k.integer? && k.value > len
+      new_array = v.to_a.clone
+      new_array[len..len] = Array.new(k.value - len)
+      Lisp::Vector.with_array(new_array)
+    end
+
+    
+    def self.vector_map_impl(args, env)
+      proc = args.car
+      return Lisp::Debug.process_error("vector-map requires its first argument to be a procedure, but received #{proc.to_s}.", env) unless proc.function? || proc.primitive?
+      v = args.cadr
+      return Lisp::Debug.process_error("vector-map requires its second argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      Lisp::Vector.with_array(v.to_a.collect {|e| proc.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([e]), env)})
+    end
+
+    
+    def self.vector_reduce_left_impl(args, env)
+      proc = args.car
+      return Lisp::Debug.process_error("vector-reduce-left requires its first argument to be a procedure, but received #{proc.to_s}.", env) unless proc.function? || proc.primitive?
+      initial = args.cadr
+      v = args.caddr
+      return Lisp::Debug.process_error("vector-reduce-left requires its second argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      return initial if v.empty?
+      return v.at(0) if v.length == 1
+      v.to_a.inject do |acc, item|
+        proc.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([acc, item]), env)
+      end
+    end
+
+    
+    def self.vector_for_each_impl(args, env)
+      proc = args.car
+      return Lisp::Debug.process_error("vector-for-each requires its first argument to be a procedure, but received #{proc.to_s}.", env) unless proc.function? || proc.primitive?
+      v = args.cadr
+      return Lisp::Debug.process_error("vector-for-each requires its second argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      v.to_a.each {|e| proc.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([e]), env)}
+      nil
+    end
+
+    
+    def self.vector_length_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-length requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      Lisp::Number.with_value(v.to_a.length)
+    end
+
+    
+    def self.vector_ref_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-ref requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      len = v.length
+      k = args.cadr
+      return Lisp::Debug.process_error("vector-ref requires its second argument to be a non-negative integer < the length of the vector, but received #{k.to_s}.", env) unless k.integer? && k.value < len
+      v.at(k.value)
+    end
+
+    
+    def self.vector_set_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-set requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      len = v.length
+      k = args.cadr
+      return Lisp::Debug.process_error("vector-set requires its second argument to be a non-negative integer < the length of the vector, but received #{k.to_s}.", env) unless k.integer? && k.value < len
+      obj = args.caddr
+      v.at_put(k.value, obj)
+      v
+    end
+
+    
+    def self.vector_first_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-first requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 1
+      v.at(0)
+    end
+
+    
+    def self.vector_second_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-second requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 2
+      v.at(1)
+    end
+
+    
+    def self.vector_third_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-third requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 3
+      v.at(2)
+    end
+
+    
+    def self.vector_fourth_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-fourth requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 4
+      v.at(3)
+    end
+
+    
+    def self.vector_fifth_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-fifth requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 5
+      v.at(4)
+    end
+
+    
+    def self.vector_sixth_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-sixth requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 6
+      v.at(5)
+    end
+
+    
+    def self.vector_seventh_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-seventh requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 7
+      v.at(6)
+    end
+
+    
+    def self.vector_eighth_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-eighth requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 8
+      v.at(7)
+    end
+
+    
+    def self.vector_ninth_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-ninth requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 9
+      v.at(8)
+    end
+
+    
+    def self.vector_tenth_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-tenth requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      return Lisp::Debug.process_error("vector index out of bounds", env) unless v.length >= 10
+      v.at(9)
+    end
+
+    
+    def self.vector_binary_search_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-binary-search requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+
+      comparison_predicate = args.cadr
+      return Lisp::Debug.process_error("vector-binary-search requires its second argument to be a procedure, but received #{comparison_predicate.to_s}.", env) unless comparison_predicate.function? || comparison_predicate.primitive?
+
+      unwrap_proc = args.caddr
+      return Lisp::Debug.process_error("vector-binary-search requires its third argument to be a procedure, but received #{unwrap_proc.to_s}.", env) unless unwrap_proc.function? || unwrap_proc.primitive?
+
+      key = args.cadddr
+
+      lo = 0
+      hi = v.length - 1
+      
+      while lo <= hi
+        mid = lo + (hi - lo) / 2
+        val = unwrap_proc.apply_to_without_evaluating(Lisp::ConsCell.cons(v.at(mid)), env)
+        return v.at(mid) if key.equal?(val)
+        if comparison_predicate.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([key, val]), env).value
+          hi = mid - 1
+        else
+          lo = mid + 1
+        end
+      end
+      Lisp::FALSE
+    end
+
+      
+    def self.subvector_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("subvector requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      len = v.length
+      s = args.cadr
+      return Lisp::Debug.process_error("subvector requires its second argument to be a non-negative integer < the length of the vector, but received #{s.to_s}.", env) unless s.integer? && s.value >= 0 && s.value < len
+      e = args.caddr
+      return Lisp::Debug.process_error("subvector requires its third argument to be a non-negative integer >= the second argument and <= the length of the vector, but received #{e.to_s}.", env) unless e.integer? && e.value >= s.value && e.value <= len
+      Vector.with_array(v.to_a[s.value...e.value])
+    end
+
+
+    def self.vector_head_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-head requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      e = args.cadr
+      return Lisp::Debug.process_error("vector-head requires its second argument to be a non-negative integer <= the length of the vector, but received #{e.to_s}.", env) unless e.integer? && e.value >= 0 && e.value <= v.length
+      Vector.with_array(v.to_a[0...e.value])
+    end
+
+
+    def self.vector_tail_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-tail requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      s = args.cadr
+      return Lisp::Debug.process_error("vector-tail requires its second argument to be a non-negative integer <= the length of the vector, but received #{s.to_s}.", env) unless s.integer? && s.value >= 0 && s.value <= v.length
+      Vector.with_array(v.to_a[s.value..-1])
+    end
+
+
+    def self.vector_fill_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("vector-tail requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      obj = args.cadr
+      (0...v.length).each {|i| v.at_put(i, obj)}
+      v
+    end
+
+
+    def self.subvector_fill_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("subvector requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      len = v.length
+      s = args.cadr
+      return Lisp::Debug.process_error("subvector requires its second argument to be a non-negative integer < the length of the vector, but received #{s.to_s}.", env) unless s.integer? && s.value >= 0 && s.value < len
+      e = args.caddr
+      return Lisp::Debug.process_error("subvector requires its third argument to be a non-negative integer >= the second argument and <= the length of the vector, but received #{e.to_s}.", env) unless e.integer? && e.value >= s.value && e.value <= len
+      obj = args.cadddr
+      (s.value...e.value).each  {|i| v.at_put(i, obj)}
+      v
+    end
+
+
+    def self.vector_filter_impl(args, env)
+      proc = args.car
+      return Lisp::Debug.process_error("vector-filter requires its first argument to be a procedure, but received #{proc.to_s}.", env) unless proc.function? || proc.primitive?
+      v = args.cadr
+      return Lisp::Debug.process_error("vector-filter requires its second argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      new_array = v.to_a.select {|e| proc.apply_to_without_evaluating(Lisp::ConsCell.cons(e), env).value}
+      Lisp::Vector.with_array(new_array)
+    end
+    
+
+    def self.vector_remove_impl(args, env)
+      proc = args.car
+      return Lisp::Debug.process_error("vector-remove requires its first argument to be a procedure, but received #{proc.to_s}.", env) unless proc.function? || proc.primitive?
+      v = args.cadr
+      return Lisp::Debug.process_error("vector-remove requires its second argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+      new_array = v.to_a.reject {|e| proc.apply_to_without_evaluating(Lisp::ConsCell.cons(e), env).value}
+      Lisp::Vector.with_array(new_array)
+    end
+
+
+    def self.subvector_move_left_impl(args, env)
+      v1 = args.car
+      return Lisp::Debug.process_error("subvector-move-left! requires its first argument to be a vector, but received #{v1.to_s}.", env) unless v1.vector?
+      len1 = v1.length
+
+      s1 = args.cadr
+      return Lisp::Debug.process_error("subvector-move-left! requires its second argument to be a non-negative integer < the length of the vector, but received #{s1.to_s}.", env) unless s1.integer? && s1.value >= 0 && s1.value < len1
+
+      e1 = args.caddr
+      return Lisp::Debug.process_error("subvector-move-left! requires its third argument to be a non-negative integer >= the second argument and <= the length of the vector, but received #{e1.to_s}.", env) unless e1.integer? && e1.value >= s1.value && e1.value <= len1
+
+      v2 = args.cadddr
+      return Lisp::Debug.process_error("subvector-move-left! requires its fourth argument to be a vector, but received #{v2.to_s}.", env) unless v2.vector?
+      len2 = v2.length
+
+      s2 = args.caddddr
+      return Lisp::Debug.process_error("subvector-move-left! requires its fifth argument to be a non-negative integer < the length of the vector, but received #{s2.to_s}.", env) unless s2.integer? && s2.value >= 0 && s2.value < len2
+
+      source_length = e1.value - s1.value
+      tail_size2 = len2 - s2.value
+      return Lisp::Debug.process_error("subvector-move-left! source subvector is longer than the available space in the destination (0-#{tail_size2}), got #{source_length}.", env) unless source_length < tail_size2
+
+      i1 = s1.value
+      i2 = s2.value
+      while i1 < e1.value
+        v2.at_put(i2, v1.at(i1))
+        i1 = i1 + 1
+        i2 = i2 + 1
+      end
+
+      v2
+    end
+
+
+    def self.subvector_move_right_impl(args, env)
+      v1 = args.car
+      return Lisp::Debug.process_error("subvector-move-right! requires its first argument to be a vector, but received #{v1.to_s}.", env) unless v1.vector?
+      len1 = v1.length
+
+      s1 = args.cadr
+      return Lisp::Debug.process_error("subvector-move-right! requires its second argument to be a non-negative integer < the length of the vector, but received #{s1.to_s}.", env) unless s1.integer? && s1.value >= 0 && s1.value < len1
+
+      e1 = args.caddr
+      return Lisp::Debug.process_error("subvector-move-right! requires its third argument to be a non-negative integer >= the second argument and <= the length of the vector, but received #{e1.to_s}.", env) unless e1.integer? && e1.value >= s1.value && e1.value <= len1
+
+      v2 = args.cadddr
+      return Lisp::Debug.process_error("subvector-move-right! requires its fourth argument to be a vector, but received #{v2.to_s}.", env) unless v2.vector?
+      len2 = v2.length
+
+      s2 = args.caddddr
+      return Lisp::Debug.process_error("subvector-move-right! requires its fifth argument to be a non-negative integer < the length of the vector, but received #{s2.to_s}.", env) unless s2.integer? && s2.value >= 0 && s2.value < len2
+
+      source_length = e1.value - s1.value
+      tail_size2 = len2 - s2.value
+      return Lisp::Debug.process_error("subvector-move-right! source subvector is longer than the available space in the destination (0-#{tail_size2}), got #{source_length}.", env) unless source_length < tail_size2
+
+      i1 = e1.value - 1
+      i2 = s2.value + source_length - 1
+      while i1 >= s1.value
+        v2.at_put(i2, v1.at(i1))
+        i1 = i1 - 1
+        i2 = i2 - 1
+      end
+
+      v2
+    end
+
+
+    def self.merge(left, right, comparison_predicate, env)
+      result = []
+      while !left.empty? && !right.empty?
+        if comparison_predicate.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([left[0], right[0]]), env).value
+          result << left.shift
+        else
+          result << right.shift
+        end
+      end
+      result[result.length..result.length] = left
+      result[result.length..result.length] = right
+      result
+    end
+
+    
+    def self.merge_sort(m, comparison_predicate, env)
+      return m if m.length <= 1
+      middle = m.length / 2
+      left = m[0...middle]
+      right = m[middle..-1]
+      merge(merge_sort(left, comparison_predicate, env), merge_sort(right, comparison_predicate, env), comparison_predicate, env)
+    end
+    
+    
+    def self.vector_merge_sort_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("merge-sort! requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+
+      comparison_predicate = args.cadr
+      return Lisp::Debug.process_error("merge-sort! requires its second argument to be a procedure, but received #{comparison_predicate.to_s}.", env) unless comparison_predicate.function? || comparison_predicate.primitive?
+
+      v.update!(merge_sort(v.to_a, comparison_predicate, env))
+      v
+    end
+
+
+    def self.partition(v, lo, hi, comparison_predicate, env)
+      pivot = v[lo]
+      i = lo - 1
+      j = hi + 1
+      while true
+        begin
+          j = j - 1
+        end while comparison_predicate.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([pivot, v[j]]), env).value
+        begin
+          i = i + 1
+        end while comparison_predicate.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([v[i], pivot]), env).value
+        if i < j
+          v[i], v[j] = v[j], v[i]
+        else
+          return j
+        end
+      end
+    end
+    
+
+    def self.quicksort(v, lo, hi, comparison_predicate, env)
+      if lo < hi
+        p = partition(v, lo, hi, comparison_predicate, env)
+        quicksort(v, lo, p, comparison_predicate, env)
+        quicksort(v, p + 1, hi, comparison_predicate, env)
+      end
+      v
+    end
+
+    
+    def self.vector_quick_sort_impl(args, env)
+      v = args.car
+      return Lisp::Debug.process_error("quick-sort! requires its first argument to be a vector, but received #{v.to_s}.", env) unless v.vector?
+
+      comparison_predicate = args.cadr
+      return Lisp::Debug.process_error("quick-sort! requires its second argument to be a procedure, but received #{comparison_predicate.to_s}.", env) unless comparison_predicate.function? || comparison_predicate.primitive?
+      v.update!(quicksort(v.to_a, 0, v.length - 1, comparison_predicate, env))
+      v
+    end
+    
+    
+  end
+
+end