rubymotionlisp 0.1.3

data/lib/rubylisp/list_support.rb

@@ -0,0 +1,527 @@
+module Lisp
+
+  class ListSupport
+
+    def self.register
+      %w(car cdr caar cadr cdar cddr
+         caaar caadr cadar caddr cdaar cdadr cddar cdddr
+         caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
+         cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr).each do |name|
+        Primitive.register(name) {|args, env| ad_impl(args, env, name) }
+      end
+      Primitive.register("list") {|args, env|  Lisp::ListSupport::list_impl(args, env) }
+      Primitive.register("vector") {|args, env|  Lisp::ListSupport::vector_impl(args, env) }
+      Primitive.register("cons*") {|args, env|  Lisp::ListSupport::cons_star_impl(args, env) }
+      Primitive.register("cons") {|args, env|  Lisp::ListSupport::cons_impl(args, env) }
+      Primitive.register("make-list") {|args, env|  Lisp::ListSupport::make_list_impl(args, env) }
+      Primitive.register("iota") {|args, env|  Lisp::ListSupport::iota_impl(args, env) }
+
+      Primitive.register("length") {|args, env|  Lisp::ListSupport::length_impl(args, env) }
+      Primitive.register("first") {|args, env|  Lisp::ListSupport::first_impl(args, env) }
+      Primitive.register("head") {|args, env|  Lisp::ListSupport::first_impl(args, env) }
+      Primitive.register("rest") {|args, env|  Lisp::ListSupport::rest_impl(args, env) }
+      Primitive.register("tail") {|args, env|  Lisp::ListSupport::rest_impl(args, env) }
+      Primitive.register("second") {|args, env|  Lisp::ListSupport::second_impl(args, env) }
+      Primitive.register("third") {|args, env|  Lisp::ListSupport::third_impl(args, env) }
+      Primitive.register("fourth") {|args, env|  Lisp::ListSupport::fourth_impl(args, env) }
+      Primitive.register("fifth") {|args, env|  Lisp::ListSupport::fifth_impl(args, env) }
+      Primitive.register("sixth") {|args, env|  Lisp::ListSupport::sixth_impl(args, env) }
+      Primitive.register("seventh") {|args, env|  Lisp::ListSupport::seventh_impl(args, env) }
+      Primitive.register("eighth") {|args, env|  Lisp::ListSupport::eighth_impl(args, env) }
+      Primitive.register("ninth") {|args, env|  Lisp::ListSupport::ninth_impl(args, env) }
+      Primitive.register("tenth") {|args, env|  Lisp::ListSupport::tenth_impl(args, env) }
+      Primitive.register("nth") {|args, env|  Lisp::ListSupport::nth_impl(args, env) }
+
+      Primitive.register("sublist") {|args, env|  Lisp::ListSupport::sublist_impl(args, env) }
+      Primitive.register("list-head") {|args, env|  Lisp::ListSupport::list_head_impl(args, env) }
+      Primitive.register("take") {|args, env|  Lisp::ListSupport::take_impl(args, env) }
+      Primitive.register("list-tail") {|args, env|  Lisp::ListSupport::list_tail_impl(args, env) }
+      Primitive.register("drop") {|args, env|  Lisp::ListSupport::drop_impl(args, env) }
+      Primitive.register("last-pair") {|args, env|  Lisp::ListSupport::last_pair_impl(args, env) }
+
+      Primitive.register("memq") {|args, env|  Lisp::ListSupport::memq_impl(args, env) }
+      Primitive.register("memv") {|args, env|  Lisp::ListSupport::memv_impl(args, env) }
+      Primitive.register("member") {|args, env|  Lisp::ListSupport::member_impl(args, env) }
+
+      Primitive.register("filter")         {|args, env| Lisp::ListSupport::filter_impl(args, env) }
+      Primitive.register("remove")         {|args, env| Lisp::ListSupport::remove_impl(args, env) }
+      Primitive.register("partition")         {|args, env| Lisp::ListSupport::partition_impl(args, env) }
+      Primitive.register("map")         {|args, env| Lisp::ListSupport::map_impl(args, env) }
+      Primitive.register("reduce-left") {|args, env| Lisp::ListSupport::reduce_left_impl(args, env) }
+      Primitive.register("any") {|args, env| Lisp::ListSupport::any_impl(args, env) }
+      Primitive.register("every") {|args, env| Lisp::ListSupport::every_impl(args, env) }
+      Primitive.register("reverse")     {|args, env| Lisp::ListSupport::reverse_impl(args, env) }
+      Primitive.register("append")      {|args, env| Lisp::ListSupport::append_impl(args, env) }
+      Primitive.register("append!")     {|args, env| Lisp::ListSupport::appendbang_impl(args, env) }
+      Primitive.register("flatten")     {|args, env| Lisp::ListSupport::flatten_impl(args, env) }
+      # Primitive.register("flatten*")     {|args, env| Lisp::ListSupport::recursive_flatten_impl(args, env) }
+    end
+
+
+    def self.cons_impl(args, env)
+      raise "cons requires two arguments." unless args.length == 2
+      left = args.car.evaluate(env)
+      right = args.cadr.evaluate(env)
+      Lisp::ConsCell.cons(left, right)
+    end
+
+
+    def self.cons_star_impl(args, env)
+      vals = []
+      args.each {|item| vals << item.evaluate(env) }
+      Lisp::ConsCell::array_to_list(vals[0..-2], vals[-1])
+    end
+
+
+    def self.list_impl(args, env)
+      vals = []
+      args.each {|item| vals << item.evaluate(env) }
+      if vals.size == 1 && vals[0].vector?
+        Lisp::ConsCell::array_to_list(vals[0].value)
+      else
+        Lisp::ConsCell::array_to_list(vals)
+      end
+    end
+
+
+    def self.make_list_impl(args, env)
+      raise "consmake-list requires one or two arguments." unless args.length == 1 || args.length == 2
+      arg1 = args.car.evaluate(env)
+      raise "make-list requires an integer for it's first argument, received: #{args.car}" unless arg1.integer?
+      count = arg1.value
+      val = if args.length == 1
+              nil
+            else
+              args.cadr.evaluate(env)
+            end
+
+      vals = Array.new(count, val)
+      Lisp::ConsCell::array_to_list(vals)
+    end
+
+
+    def self.iota_impl(args, env)
+      raise "iota requires at least one argument." unless args.length > 0
+      arg1 = args.car.evaluate(env)
+      raise "iota requires an positive integer for it's first argument, received: #{args.car}" unless arg1.integer? && arg1.positive?
+      count = arg1.value
+
+      start = if args.length < 2
+                0
+              else
+                arg2 = args.cadr.evaluate(env)
+                raise "iota requires an number for it's second argument, received: #{args.cadr}" unless arg2.number?
+                arg2.value
+              end
+
+      step = if args.length < 3
+                1
+              else
+                arg3 = args.caddr.evaluate(env)
+                raise "iota requires an number for it's third argument, received: #{args.caddr}" unless arg3.number?
+                arg3.value
+              end
+
+      vals = []
+      count.times do |c|
+        vals << start
+        start += step
+      end
+
+      Lisp::ConsCell::array_to_list(vals.map {|v| Number.with_value(v) })
+    end
+
+
+    def self.length_impl(args, env)
+      Lisp::Number.with_value(args.car.evaluate(env).length)
+    end
+
+
+    # in support of all the CxR functions
+    def self.ad_impl(args, env, f)
+      l = args.car.evaluate(env)
+      raise "list required." unless l.list?
+      l.send(f)
+    end
+
+
+    def self.first_impl(args, env)
+      l = args.car.evaluate(env)
+      raise "rest requires a list or vector." unless l.list? || l.vector?
+      raise "list index out of bounds" unless l.length >= 1
+      l.nth(1)
+    end
+
+
+    def self.rest_impl(args, env)
+      l = args.car.evaluate(env)
+      raise "rest requires a list or vector." unless l.list? || l.vector?
+      if l.list?
+        l.cdr
+      else
+        Lisp::Vector.new(l.value[1..-1])
+      end
+    end
+
+
+    def self.second_impl(args, env)
+      l = args.car.evaluate(env)
+      raise "rest requires a list or vector." unless l.list? || l.vector?
+      raise "list index out of bounds" unless l.length >= 2
+      l.nth(2)
+    end
+
+    def self.third_impl(args, env)
+      l = args.car.evaluate(env)
+      raise "rest requires a list or vector." unless l.list? || l.vector?
+      raise "list index out of bounds" unless l.length >= 3
+      l.nth(3)
+    end
+
+
+    def self.fourth_impl(args, env)
+      l = args.car.evaluate(env)
+      raise "rest requires a list or vector." unless l.list? || l.vector?
+      raise "list index out of bounds" unless l.length >= 4
+      l.nth(4)
+    end
+
+
+    def self.fifth_impl(args, env)
+      l = args.car.evaluate(env)
+      raise "rest requires a list or vector." unless l.list? || l.vector?
+      raise "list index out of bounds" unless l.length >= 5
+      l.nth(5)
+    end
+
+
+    def self.sixth_impl(args, env)
+      l = args.car.evaluate(env)
+      raise "rest requires a list or vector." unless l.list? || l.vector?
+      raise "list index out of bounds" unless l.length >= 6
+      l.nth(6)
+    end
+
+
+    def self.seventh_impl(args, env)
+      l = args.car.evaluate(env)
+      raise "rest requires a list or vector." unless l.list? || l.vector?
+      raise "list index out of bounds" unless l.length >= 7
+      l.nth(7)
+    end
+
+
+    def self.eighth_impl(args, env)
+      l = args.car.evaluate(env)
+      raise "rest requires a list or vector." unless l.list? || l.vector?
+      raise "list index out of bounds" unless l.length >= 8
+      l.nth(8)
+    end
+
+
+    def self.ninth_impl(args, env)
+      l = args.car.evaluate(env)
+      raise "rest requires a list or vector." unless l.list? || l.vector?
+      raise "list index out of bounds" unless l.length >= 9
+      l.nth(9)
+    end
+
+
+    def self.tenth_impl(args, env)
+      l = args.car.evaluate(env)
+      raise "rest requires a list or vector." unless l.list? || l.vector?
+      raise "list index out of bounds" unless l.length >= 10
+      l.nth(10)
+    end
+
+
+    def self.nth_impl(args, env)
+      raise "nth requires 2 arguments" unless args.length == 2
+      n = args.car.evaluate(env)
+      raise "The first argument of nth has to be an number." unless n.number?
+      raise "The first argument of nth has to be positive." unless n.value > 0
+      l = args.cadr.evaluate(env)
+      raise "rest requires a list or vector." unless l.list? || l.vector?
+      l.nth(n.value)
+    end
+
+
+    def self.make_same_kind_as(sequence, value)
+      if sequence.vector?
+        Lisp::Vector.new(value)
+      else
+        Lisp::ConsCell.array_to_list(value)
+      end
+    end
+    
+
+    def self.sublist_impl(args, env)
+      raise "sublist requires 3 arguments" unless args.length == 3
+      l = args.car.evaluate(env)
+      raise "sublist requires it's first argument to be a list or vector, but received #{args.car}" unless l.list? || l.vector?
+      st = args.cadr.evaluate(env)
+      raise "sublist requires it's second argument to be a positive integer, but received #{args.cadr}" unless st.number? && st.positive?
+      raise "sublist requires it's second argument to be <= the list length" unless st.value <= l.length
+      en = args.caddr.evaluate(env)
+      raise "sublist requires it's third argument to be a positive integer, but received #{args.caddr}" unless en.number? && en.positive?
+      raise "sublist requires it's third argument to be <= the list length" unless en.value <= l.length
+      raise "sublist requires it's second argument to be <= the third argument" unless st.value <= en.value
+      make_same_kind_as(l, l.to_a[(st.value - 1)...en.value])
+    end
+
+
+    def self.list_head_impl(args, env)
+      raise "list_head requires 2 arguments" unless args.length == 2
+      l = args.car.evaluate(env)
+      raise "list_head requires it's first argument to be a list, but received #{args.car}" unless l.list?
+      k = args.cadr.evaluate(env)
+      raise "list_head requires it's second argument to be a positive integer, but received #{args.cadr}" unless k.number? && k.positive?
+      raise "list_head requires it's second argument to be <= the list length" unless k.value <= l.length
+      Lisp::ConsCell.array_to_list(l.to_a[0...k.value])
+    end
+
+
+    def self.take_impl(args, env)
+      raise "take requires 2 arguments" unless args.length == 2
+      k = args.car.evaluate(env)
+      raise "take requires it's first argument to be an integer >= 0, but received #{args.car}" unless k.number? && !k.negative?
+      l = args.cadr.evaluate(env)
+      raise "take requires it's second argument to be a list or vector, but received #{args.cadr}" unless l.list? || l.vector?
+      raise "take requires it's first argument to be <= the list length" unless k.value <= l.length
+      puts l
+      make_same_kind_as(l, l.to_a[0...k.value])
+    end
+
+
+    def self.list_tail_impl(args, env)
+      raise "list_head requires 2 arguments" unless args.length == 2
+      l = args.car.evaluate(env)
+      raise "list_head requires it's first argument to be a list, but received #{args.car}" unless l.list?
+      k = args.cadr.evaluate(env)
+      raise "list_head requires it's second argument to be a positive integer, but received #{args.cadr}" unless k.number? && k.positive?
+      raise "list_head requires it's second argument to be <= the list length" unless k.value <= l.length
+      l.nth_tail(k.value + 1)
+    end
+
+
+    def self.drop_impl(args, env)
+      raise "drop requires 2 arguments" unless args.length == 2
+      k = args.car.evaluate(env)
+      raise "drop requires it's first argument to be an integer >= 0, but received #{args.car}" unless k.number? && !k.negative?
+      l = args.cadr.evaluate(env)
+      raise "drop requires it's second argument to be a list or vector, but received #{args.cadr}" unless l.list? || l.vector?
+      raise "drop requires it's first argument to be <= the list length" unless k.value <= l.length
+      l.nth_tail(k.value + 1)
+    end
+
+
+    def self.last_pair_impl(args, env)
+      raise "last_pair requires 1 arguments" unless args.length == 1
+      l = args.car.evaluate(env)
+      raise "last_pair requires it's argument to be a list, but received #{args.car}" unless l.list?
+      l.last
+    end
+
+
+    def self.memq_impl(args, env)
+      raise "memq requires 2 arguments but received #{args.length}." unless args.length == 2
+      item = args.car.evaluate(env)
+      collection = args.cadr.evaluate(env)
+      raise "memq requires a list as it's second argument." unless collection.list?
+      collection.length.times do |i|
+        if Lisp::Equivalence.eq_check(item, collection.nth(i + 1)).value
+          return collection.nth_tail(i + 1)
+        end
+      end
+      Lisp::FALSE
+    end
+
+
+    def self.memv_impl(args, env)
+      raise "memv requires 2 arguments but received #{args.length}." unless args.length == 2
+      item = args.car.evaluate(env)
+      collection = args.cadr.evaluate(env)
+      raise "memv requires a list as it's second argument." unless collection.list?
+      collection.length.times do |i|
+        if Lisp::Equivalence.eqv_check(item, collection.nth(i + 1)).value
+          return collection.nth_tail(i + 1)
+        end
+      end
+      Lisp::FALSE
+    end
+
+
+    def self.member_impl(args, env)
+      raise "member requires 2 arguments but received #{args.length}." unless args.length == 2
+      item = args.car.evaluate(env)
+      collection = args.cadr.evaluate(env)
+      raise "member requires a list as it's second argument." unless collection.list?
+      collection.length.times do |i|
+        if Lisp::Equivalence.equal_check(item, collection.nth(i + 1)).value
+          return collection.nth_tail(i + 1)
+        end
+      end
+      Lisp::FALSE
+    end
+
+
+    def self.filter_impl(args, env)
+      raise "filter requires 2 arguments but received #{args.length}." unless args.length == 2
+      f = args.car.evaluate(env)
+      raise "filter requires a function as it's first argument but received #{args.car}." unless f.function? || f.primitive?
+      collection = args.cadr.evaluate(env)
+      raise "filter requires a list or vector as it's second argument but received #{args.cadr}." unless collection.list? || collection.vector?
+      results = collection.to_a.select {|item| f.apply_to_without_evaluating(Lisp::ConsCell.cons(item, nil), env).value }
+      make_same_kind_as(collection, results)
+    end
+
+
+    def self.remove_impl(args, env)
+      raise "remove requires 2 arguments but received #{args.length}." unless args.length == 2
+      f = args.car.evaluate(env)
+      raise "remove requires a function as it's first argument but received #{args.car}." unless f.function? || f.primitive?
+      collection = args.cadr.evaluate(env)
+      raise "remove requires a list or vector as it's second argument but received #{args.cadr}." unless collection.list? || collection.vector?
+      results = collection.to_a.reject {|item| f.apply_to_without_evaluating(Lisp::ConsCell.cons(item, nil), env).value }
+      make_same_kind_as(collection, results)
+    end
+
+
+    def self.partition_impl(args, env)
+      raise "partition requires 2 arguments but received #{args.length}." unless args.length == 2
+      f = args.car.evaluate(env)
+      raise "partition requires a function as it's first argument." unless f.function? || f.primitive?
+      collection = args.cadr.evaluate(env)
+      raise "partition requires a list as it's second argument." unless collection.list? | collection.vector?
+      results = collection.to_a.partition {|item| f.apply_to_without_evaluating(Lisp::ConsCell.cons(item, nil), env).value }
+      matches = make_same_kind_as(collection, results[0])
+      non_matches = make_same_kind_as(collection, results[1])
+      Lisp::ConsCell.array_to_list([matches, non_matches])
+    end
+
+
+    def self.map_impl(args, env)
+      raise "map requires at least 2 arguments but received #{args.length}." if args.length < 2
+      f = args.car.evaluate(env)
+      raise "map requires a function as it's first argument but received #{args.car}." unless f.function? || f.primitive?
+      collections = args.cdr.to_a.collect {|a| a.evaluate(env)}
+      raise "all requires all subsequent arguments to be lists or vectors" unless collections.all? {|l| l.list? || l.vector?}
+      all_vectors = collections.all? {|i| i.vector?}
+      lists = collections.collect {|l| l.to_a }
+      
+      map_args = []
+      while (lists.all? {|l| !l.empty? })
+        map_args << Lisp::ConsCell.array_to_list(lists.map {|l| l.shift })
+      end
+      results = map_args.collect {|item| f.apply_to_without_evaluating(item, env) }
+      if all_vectors
+        Lisp::Vector.new(results)
+      else
+        Lisp::ConsCell.array_to_list(results)
+      end
+
+    end
+
+
+    def self.quote_if_required(thing)
+      return thing unless thing.list? || thing.symbol?
+      thing.quoted
+    end
+
+
+    def self.reduce_left_impl(args, env)
+      raise "reduce requires 3 arguments but received #{args.length}." unless args.length == 3
+      f = args.car.evaluate(env)
+      raise "map requires a function as it's first argument but received #{args.car}." unless f.function? || f.primitive?
+      initial = args.cadr.evaluate(env)
+      collection = args.caddr.evaluate(env)
+      raise "reduce requires a list or vector as it's third argument but received #{args.caddr}." unless collection.list? || collection.vector?
+      return initial if collection.empty?
+      return collection.nth(1) if collection.length == 1
+      result = collection.to_a.inject do |acc, item|
+        f.apply_to(Lisp::ConsCell.array_to_list([quote_if_required(acc), quote_if_required(item)]), env)
+      end
+      result
+    end
+
+
+    def self.any_impl(args, env)
+      raise "any requires at least two arguments" unless args.length >= 2
+      p = args.car.evaluate(env)
+      raise "any requires a function as it's first argument" unless p.function? || p.primitive?
+      lists = args.cdr.to_a.collect {|a| a.evaluate(env)}
+      raise "any requires all subsequent arguments to be lists or vectors" unless lists.all? {|l| l.list? || l.vector?}
+
+      while true
+        cars = lists.collect {|l| l.nth(1)}
+        return_val = p.apply_to(Lisp::ConsCell.array_to_list(cars), env)
+        return Lisp::TRUE if return_val.value
+        lists = lists.collect {|l| l.nth_tail(2)}
+        return Lisp::FALSE if lists.any? {|l| l.empty?}
+      end
+    end
+
+
+    def self.every_impl(args, env)
+      raise "all requires at least two arguments" unless args.length >= 2
+      p = args.car.evaluate(env)
+      raise "all requires a function as it's first argument" unless p.function? || p.primitive?
+      lists = args.cdr.to_a.collect {|a| a.evaluate(env)}
+      raise "all requires all subsequent arguments to be lists or vectors" unless lists.all? {|l| l.list? || l.vector?}
+
+      while true
+        cars = lists.collect {|l| l.nth(1)}
+        return_val = p.apply_to(Lisp::ConsCell.array_to_list(cars), env)
+        return Lisp::FALSE unless return_val.value
+        lists = lists.collect {|l| l.nth_tail(2)}
+        return Lisp::TRUE if lists.any? {|l| l.empty?}
+      end
+    end
+
+
+    def self.reverse_impl(args, env)
+      raise "reverse requires a single argument." unless args.length == 1
+      l = args.car.evaluate(env)
+      raise "reverse requires a list or vector" unless l.list? || l.vector?
+      make_same_kind_as(l, l.to_a.reverse)
+    end
+
+
+    def self.append_impl(args, env)
+      raise "append requires at least 1 argument." unless args.length >= 1
+      l = args.map {|i| i.evaluate(env)}
+      raise "append requires lists or vectors" unless l.all? {|i| i.list? || i.vector?}
+      all_vectors = l.all? {|i| i.vector?}
+      new_items = []
+      l.each do |sublist|
+        sublist.each {|item| new_items << item.copy}
+      end
+
+      if all_vectors
+        Lisp::Vector.new(new_items)
+      else
+        Lisp::ConsCell.array_to_list(new_items)
+      end
+    end
+
+
+    def self.appendbang_impl(args, env)
+      raise "append! requires at least 1 argument." unless args.length >= 1
+      arg_array = args.to_a.map {|i| i.evaluate(env)}
+      raise "append! requires lists" unless arg_array.all? {|i| i.list?}
+      (0...(arg_array.length-1)). each do |i|
+        arg_array[i].last.set_cdr!(arg_array[i+1])
+      end
+      arg_array[0]
+    end
+
+
+    def self.flatten_impl(args, env)
+      raise "flatten requires 1 argument." unless args.length != 1
+      l = args.car.evaluate(env)
+      raise "flatten requires a list argument" unless l.list?
+      l.flatten
+    end
+
+  end
+end

data/lib/rubylisp/logical.rb

@@ -0,0 +1,38 @@
+module Lisp
+
+  class Logical
+
+    def self.register
+      Primitive.register("or",
+                         "(or expression ...\n\nThe expressions are evaluated from left to right, and the value of the first expression that evaluates to a true value is returned. Any remaining expressions are not evaluated. If all expressions evaluate to false values, the value of the last expression is returned. If there are no expressions then #f is returned.",
+                         true)  do |args, env|
+                           Lisp::Logical::or_impl(args, env)
+                         end
+      Primitive.register("and",
+                         "(and expression ...)\n\nThe expressions are evaluated from left to right, and the value of the first expression that evaluates to a false value is returned. Any remaining expressions are not evaluated. If all the expressions evaluate to true values, the value of the last expression is returned. If there are no expressions then #t is returned.",
+                         true) do |args, env|
+                           Lisp::Logical::and_impl(args, env)
+                         end
+      Primitive.register("not") {|args, env| Lisp::Logical::not_impl(args, env) }
+    end
+
+
+    def self.or_impl(args, env)
+      raise "or needs at least 2 arguments" unless args.length > 1
+      value = !!args.inject(false) {|acc, item| acc || item.evaluate(env).value}
+      return Lisp::Boolean.with_value(value)
+    end
+
+    def self.and_impl(args, env)
+      raise "and needs at least 2 arguments" unless args.length > 1
+      value = !!args.inject(true) {|acc, item| acc && item.evaluate(env).value}
+      return Lisp::Boolean.with_value(value)
+    end
+
+    def self.not_impl(args, env)
+      raise "not needs a single argument" unless args.length == 1
+      return Lisp::Boolean.with_value(!(args.car.evaluate(env).value))
+    end
+
+  end
+end

data/lib/rubylisp/macro.rb

@@ -0,0 +1,95 @@
+module Lisp
+
+  class Macro < 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 expand(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(local_env)
+    end
+    
+    def internal_apply_to(parameters, env, should_eval)
+      expanded_macro = expand(parameters, env, should_eval)
+      expanded_macro.evaluate(env)
+    end
+
+    def apply_to(parameters, env)
+      internal_apply_to(parameters, env, false)
+    end
+
+    def apply_to_without_evaluating(parameters, env)
+      internal_apply_to(parameters, env, false)
+    end
+
+    def to_s
+      "<macro: #{@name}>"
+    end
+
+    def macro?
+      true
+    end
+
+    def type
+      :macro
+    end
+
+  end
+
+end