class Lisp::PrimListSupport

Public Class Methods

ad_impl(args, env, f) click to toggle source

in support of all the CxR functions

# File lib/rubylisp/prim_list_support.rb, line 130
def self.ad_impl(args, env, f)
  l = args.car
  return Lisp::Debug.process_error("list required.", env) unless l.list?
  l.send(f)
end
any_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 427
def self.any_impl(args, env)
  p = args.car
  return Lisp::Debug.process_error("any requires a function as it's first argument", env) unless p.function? || p.primitive?
  lists = args.cdr.to_a
  return Lisp::Debug.process_error("any requires all subsequent arguments to be lists", env) unless lists.all? {|l| l.list?}

  while true
    cars = lists.collect {|l| l.nth(0)}
    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(1)}
    return Lisp::FALSE if lists.any? {|l| l.empty?}
  end
end
append_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 467
def self.append_impl(args, env)
  l = args
  return Lisp::Debug.process_error("append requires lists", env) unless l.all? {|i| i.list? }
  new_items = []
  l.each do |sublist|
    sublist.each {|item| new_items << item.copy}
  end

  Lisp::ConsCell.array_to_list(new_items)
end
appendbang_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 479
def self.appendbang_impl(args, env)
  arg_array = args.to_a
  return Lisp::Debug.process_error("append! requires lists", env) 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
cons_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 62
def self.cons_impl(args, env)
  Lisp::ConsCell.cons(args.car, args.cadr)
end
cons_star_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 67
def self.cons_star_impl(args, env)
  return args.car if args.length == 1
  arg_ary = args.to_a
  Lisp::ConsCell::array_to_list(arg_ary[0..-2], arg_ary[-1])
end
drop_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 286
def self.drop_impl(args, env)
  k = args.car
  return Lisp::Debug.process_error("drop requires it's first argument to be an integer >= 0, but received #{l}", env) unless k.number? && k.value >= 0
  l = args.cadr
  return Lisp::Debug.process_error("drop requires it's second argument to be a list, but received #{l}", env) unless l.list?
  return Lisp::Debug.process_error("drop requires it's first argument to be <= the list length", env) unless k.value <= l.length
  l.nth_tail(k.value)
end
eighth_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 199
def self.eighth_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
  return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 8
  l.nth(7)
end
every_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 443
def self.every_impl(args, env)
  p = args.car
  return Lisp::Debug.process_error("every requires a function as it's first argument", env) unless p.function? || p.primitive?
  lists = args.cdr.to_a
  return Lisp::Debug.process_error("every requires all subsequent arguments to be lists", env) unless lists.all? {|l| l.list?}

  
  while true
    cars = lists.collect {|l| l.nth(0)}
    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(1)}
    return Lisp::TRUE if lists.any? {|l| l.empty?}
  end
end
fifth_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 175
def self.fifth_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
  return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 5
  l.nth(4)
end
filter_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 342
def self.filter_impl(args, env)
  f = args.car
  return Lisp::Debug.process_error("filter requires a function as it's first argument but received #{args.car}.", env) unless f.function? || f.primitive?
  collection = args.cadr
  return Lisp::Debug.process_error("filter requires a list as it's second argument but received #{args.cadr}.", env) unless collection.list?
  results = collection.to_a.select {|item| f.apply_to_without_evaluating(Lisp::ConsCell.cons(item, nil), env).value }
  Lisp::ConsCell.array_to_list(results)
end
first_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 137
def self.first_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
  return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 1
  l.nth(0)
end
flatten_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 489
def self.flatten_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("flatten requires a list argument", env) unless l.list?
  l.flatten
end
for_each_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 390
def self.for_each_impl(args, env)
  f = args.car
  return Lisp::Debug.process_error("for-each requires a function as it's first argument but received #{args.car}.", env) unless f.function? || f.primitive?
  collections = args.cdr
  return Lisp::Debug.process_error("for-each requires all subsequent arguments to be lists", env) unless collections.all? {|l| l.list?}
  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
  map_args.collect {|item| f.apply_to_without_evaluating(item, env) }

  nil
end
fourth_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 167
def self.fourth_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
  return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 4
  l.nth(3)
end
iota_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 93
def self.iota_impl(args, env)
  arg1 = args.car
  return Lisp::Debug.process_error("iota requires an positive integer for it's first argument, received: #{arg1}", env) unless arg1.integer? && arg1.positive?
  count = arg1.value

  start = if args.length < 2
            0
          else
            arg2 = args.cadr
            return Lisp::Debug.process_error("iota requires an number for it's second argument, received: #{arg2}", env) unless arg2.number?
            arg2.value
          end

  step = if args.length < 3
            1
          else
            arg3 = args.caddr
            return Lisp::Debug.process_error("iota requires an number for it's third argument, received: #{arg3}", env) 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
last_pair_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 296
def self.last_pair_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("last_pair requires it's argument to be a list, but received #{l}", env) unless l.list?
  l.last
end
length_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 124
def self.length_impl(args, env)
  Lisp::Number.with_value(args.car.length)
end
list_head_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 256
def self.list_head_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("list_head requires it's first argument to be a list, but received #{l}", env) unless l.list?
  k = args.cadr
  return Lisp::Debug.process_error("list_head requires it's second argument to be a non-negative integer, but received #{k}", env) unless k.number? && k.value >= 0
  return Lisp::Debug.process_error("list_head requires it's second argument to be <= the list length", env) unless k.value <= l.length
  Lisp::ConsCell.array_to_list(l.to_a[0...k.value])
end
list_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 74
def self.list_impl(args, env)
  args
end
list_tail_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 276
def self.list_tail_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("list_head requires it's first argument to be a list, but received #{l}", env) unless l.list?
  k = args.cadr
  return Lisp::Debug.process_error("list_head requires it's second argument to be a non-negative integer, but received #{k}", env) unless k.number? && k.value >= 0
  return Lisp::Debug.process_error("list_head requires it's second argument to be <= the list length", env) unless k.value <= l.length
  l.nth_tail(k.value)
end
make_list_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 79
def self.make_list_impl(args, env)
  return Lisp::Debug.process_error("make-list requires an integer for it's first argument, received: #{args.car}", env) unless args.car.integer?
  count = args.car.value
  val = if args.length == 1
          nil
        else
          args.cadr
        end

  vals = Array.new(count, val)
  Lisp::ConsCell::array_to_list(vals)
end
make_same_kind_as(sequence, value) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 233
def self.make_same_kind_as(sequence, value)
  if sequence.vector?
    Lisp::Vector.new(value)
  else
    Lisp::ConsCell.array_to_list(value)
  end
end
map_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 374
def self.map_impl(args, env)
  f = args.car
  return Lisp::Debug.process_error("map requires a function as it's first argument but received #{args.car}.", env) unless f.function? || f.primitive?
  collections = args.cdr.to_a
  return Lisp::Debug.process_error("map requires all subsequent arguments to be lists", env) unless collections.all? {|l| l.list?}
  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) }
  Lisp::ConsCell.array_to_list(results)
end
member_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 329
def self.member_impl(args, env)
  item = args.car
  collection = args.cadr
  return Lisp::Debug.process_error("member requires a list as it's second argument.", env) unless collection.list?
  collection.length.times do |i|
    if item.equal?(collection.nth(i))
      return collection.nth_tail(i)
    end
  end
  Lisp::FALSE
end
memq_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 303
def self.memq_impl(args, env)
  item = args.car
  collection = args.cadr
  return Lisp::Debug.process_error("memq requires a list as it's second argument.", env) unless collection.list?
  collection.length.times do |i|
    if item.eq?(collection.nth(i))
      return collection.nth_tail(i)
    end
  end
  Lisp::FALSE
end
memv_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 316
def self.memv_impl(args, env)
  item = args.car
  collection = args.cadr
  return Lisp::Debug.process_error("memv requires a list as it's second argument.", env) unless collection.list?
  collection.length.times do |i|
    if item.eqv?(collection.nth(i))
      return collection.nth_tail(i)
    end
  end
  Lisp::FALSE
end
ninth_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 207
def self.ninth_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
  return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 9
  l.nth(8)
end
nth_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 223
def self.nth_impl(args, env)
  n = args.car
  return Lisp::Debug.process_error("The first argument of nth has to be an number.", env) unless n.number?
  return Lisp::Debug.process_error("The first argument of nth has to be non-negative.", env) unless n.value >= 0
  l = args.cadr
  return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
  l.nth(n.value)
end
partition_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 362
def self.partition_impl(args, env)
  f = args.car
  return Lisp::Debug.process_error("partition requires a function as it's first argument.", env) unless f.function? || f.primitive?
  collection = args.cadr
  return Lisp::Debug.process_error("partition requires a list as it's second argument.", env) unless collection.list?
  results = collection.to_a.partition {|item| f.apply_to_without_evaluating(Lisp::ConsCell.cons(item, nil), env).value }
  matches = Lisp::ConsCell.array_to_list(results[0])
  non_matches = Lisp::ConsCell.array_to_list(results[1])
  Lisp::ConsCell.array_to_list([matches, non_matches])
end
quote_if_required(thing) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 407
def self.quote_if_required(thing)
  return thing unless thing.list? || thing.symbol?
  thing.quoted
end
reduce_left_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 413
def self.reduce_left_impl(args, env)
  f = args.car
  return Lisp::Debug.process_error("reduce-left requires a function as it's first argument but received #{args.car}.", env) unless f.function? || f.primitive?
  initial = args.cadr
  collection = args.caddr
  return Lisp::Debug.process_error("reduce-left requires a list as it's third argument but received #{args.caddr}.", env) unless collection.list?
  return initial if collection.empty?
  return collection.nth(0) if collection.length == 1
  collection.to_a.inject do |acc, item|
    f.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([acc, item]), env)
  end
end
register() click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 5
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, "1")        {|args, env| ad_impl(args, env, name) }
  end

  Primitive.register("list", "*")        {|args, env|  Lisp::PrimListSupport::list_impl(args, env) }
  Primitive.register("cons*", "*")       {|args, env|  Lisp::PrimListSupport::cons_star_impl(args, env) }
  Primitive.register("cons", "2")        {|args, env|  Lisp::PrimListSupport::cons_impl(args, env) }
  Primitive.register("make-list", "1|2") {|args, env|  Lisp::PrimListSupport::make_list_impl(args, env) }
  Primitive.register("iota", "1|2|3")    {|args, env|  Lisp::PrimListSupport::iota_impl(args, env) }

  Primitive.register("length", "1")      {|args, env|  Lisp::PrimListSupport::length_impl(args, env) }
  Primitive.register("first", "1")       {|args, env|  Lisp::PrimListSupport::first_impl(args, env) }
  Primitive.register("head", "1")        {|args, env|  Lisp::PrimListSupport::first_impl(args, env) }
  Primitive.register("rest", "1")        {|args, env|  Lisp::PrimListSupport::rest_impl(args, env) }
  Primitive.register("tail", "1")        {|args, env|  Lisp::PrimListSupport::rest_impl(args, env) }
  Primitive.register("second", "1")      {|args, env|  Lisp::PrimListSupport::second_impl(args, env) }
  Primitive.register("third", "1")       {|args, env|  Lisp::PrimListSupport::third_impl(args, env) }
  Primitive.register("fourth", "1")      {|args, env|  Lisp::PrimListSupport::fourth_impl(args, env) }
  Primitive.register("fifth", "1")       {|args, env|  Lisp::PrimListSupport::fifth_impl(args, env) }
  Primitive.register("sixth", "1")       {|args, env|  Lisp::PrimListSupport::sixth_impl(args, env) }
  Primitive.register("seventh", "1")     {|args, env|  Lisp::PrimListSupport::seventh_impl(args, env) }
  Primitive.register("eighth", "1")      {|args, env|  Lisp::PrimListSupport::eighth_impl(args, env) }
  Primitive.register("ninth", "1")       {|args, env|  Lisp::PrimListSupport::ninth_impl(args, env) }
  Primitive.register("tenth", "1")       {|args, env|  Lisp::PrimListSupport::tenth_impl(args, env) }
  Primitive.register("nth", "2")         {|args, env|  Lisp::PrimListSupport::nth_impl(args, env) }

  Primitive.register("sublist", "3")     {|args, env|  Lisp::PrimListSupport::sublist_impl(args, env) }
  Primitive.register("list-head", "2")   {|args, env|  Lisp::PrimListSupport::list_head_impl(args, env) }
  Primitive.register("take", "2")        {|args, env|  Lisp::PrimListSupport::take_impl(args, env) }
  Primitive.register("list-tail", "2")   {|args, env|  Lisp::PrimListSupport::list_tail_impl(args, env) }
  Primitive.register("drop", "2")        {|args, env|  Lisp::PrimListSupport::drop_impl(args, env) }
  Primitive.register("last-pair", "1")   {|args, env|  Lisp::PrimListSupport::last_pair_impl(args, env) }

  Primitive.register("memq", "2")        {|args, env|  Lisp::PrimListSupport::memq_impl(args, env) }
  Primitive.register("memv", "2")        {|args, env|  Lisp::PrimListSupport::memv_impl(args, env) }
  Primitive.register("member", "2")      {|args, env|  Lisp::PrimListSupport::member_impl(args, env) }

  Primitive.register("filter", "2")      {|args, env| Lisp::PrimListSupport::filter_impl(args, env) }
  Primitive.register("remove", "2")      {|args, env| Lisp::PrimListSupport::remove_impl(args, env) }
  Primitive.register("partition", "2")   {|args, env| Lisp::PrimListSupport::partition_impl(args, env) }
  Primitive.register("map", ">=2")       {|args, env| Lisp::PrimListSupport::map_impl(args, env) }
  Primitive.register("for-each", ">=2")  {|args, env| Lisp::PrimListSupport::for_each_impl(args, env) }
  Primitive.register("reduce-left", "3") {|args, env| Lisp::PrimListSupport::reduce_left_impl(args, env) }
  Primitive.register("any", ">=2")       {|args, env| Lisp::PrimListSupport::any_impl(args, env) }
  Primitive.register("every", ">=2")     {|args, env| Lisp::PrimListSupport::every_impl(args, env) }
  Primitive.register("reverse", "1")     {|args, env| Lisp::PrimListSupport::reverse_impl(args, env) }
  Primitive.register("append", ">=1")    {|args, env| Lisp::PrimListSupport::append_impl(args, env) }
  Primitive.register("append!", ">=1")   {|args, env| Lisp::PrimListSupport::appendbang_impl(args, env) }
  Primitive.register("flatten", "1")     {|args, env| Lisp::PrimListSupport::flatten_impl(args, env) }
  # Primitive.register("flatten*")     {|args, env| Lisp::PrimListSupport::recursive_flatten_impl(args, env) }
end
remove_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 352
def self.remove_impl(args, env)
  f = args.car
  return Lisp::Debug.process_error("remove requires a function as it's first argument but received #{args.car}.", env) unless f.function? || f.primitive?
  collection = args.cadr
  return Lisp::Debug.process_error("remove requires a list as it's second argument but received #{args.cadr}.", env) unless collection.list?
  results = collection.to_a.reject {|item| f.apply_to_without_evaluating(Lisp::ConsCell.cons(item, nil), env).value }
  Lisp::ConsCell.array_to_list(results)
end
rest_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 145
def self.rest_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
  l.cdr
end
reverse_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 460
def self.reverse_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("reverse requires a list", env) unless l.list?
  Lisp::ConsCell.array_to_list(l.to_a.reverse)
end
second_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 152
def self.second_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
  return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 2
  l.nth(1)
end
seventh_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 191
def self.seventh_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
  return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 7
  l.nth(6)
end
sixth_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 183
def self.sixth_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
  return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 6
  l.nth(5)
end
sublist_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 242
def self.sublist_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("sublist requires it's first argument to be a list, but received #{l}", env) unless l.list?
  st = args.cadr
  return Lisp::Debug.process_error("sublist requires it's second argument to be a non-negative integer, but received #{st}", env) unless st.number? && st.value >= 0
  return Lisp::Debug.process_error("sublist requires it's second argument to be <= the list length", env) unless st.value < l.length
  en = args.caddr
  return Lisp::Debug.process_error("sublist requires it's third argument to be a non-negative integer, but received #{en}", env) unless en.number? && en.value >= 0
  return Lisp::Debug.process_error("sublist requires it's third argument to be <= the list length", env) unless en.value < l.length
  return Lisp::Debug.process_error("sublist requires it's second argument to be <= the third argument", env) unless st.value <= en.value
  Lisp::ConsCell.array_to_list(l.to_a[st.value...en.value])
end
take_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 266
def self.take_impl(args, env)
  k = args.car
  return Lisp::Debug.process_error("take requires it's first argument to be a non-negative integer, but received #{k}", env) unless k.number? && k.value >= 0
  l = args.cadr
  return Lisp::Debug.process_error("take requires it's second argument to be a list, but received #{l}", env) unless l.list?
  return Lisp::Debug.process_error("take requires it's first argument to be <= the list length", env) unless k.value <= l.length
  Lisp::ConsCell.array_to_list(l.to_a[0...k.value])
end
tenth_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 215
def self.tenth_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
  return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 10
  l.nth(9)
end
third_impl(args, env) click to toggle source
# File lib/rubylisp/prim_list_support.rb, line 159
def self.third_impl(args, env)
  l = args.car
  return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
  return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 3
  l.nth(2)
end