Class: Lisp::PrimAlist

Inherits:
Object show all
Defined in:
lib/rubylisp/prim_alist.rb

Class Method Summary collapse

Class Method Details

.acons_impl(args, env) ⇒ Object 



25
26
27
28
29
30
31
32
33
34
35
36
37
 
# File 'lib/rubylisp/prim_alist.rb', line 25

def self.acons_impl(args, env)
  key = args.car
  value = args.cadr
  alist = args.length == 2 ? nil : args.caddr
  return Lisp::Debug.process_error("the last argument to acons has to be a list", env) unless alist.list?

  pair = ConsCell.cons(key, value)
  if alist.nil?
    ConsCell.cons(pair)
  else
    ConsCell.cons(pair, alist)
  end
end

.assoc_impl(args, env, &equivalence_block) ⇒ Object 



40
41
42
43
44
45
46
47
48
49
50
 
# File 'lib/rubylisp/prim_alist.rb', line 40

def self.assoc_impl(args, env, &equivalence_block)
  key = args.car
  alist = args.cadr
  return Lisp::Debug.process_error("the last argument to assoc has to be a list", env) unless alist.list?

  alist.each do |pair|
    if equivalence_block.call(pair.car, key)
      return pair
    end
  end
end

.dissoc_impl(args, env, &equivalence_block) ⇒ Object 



65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
 
# File 'lib/rubylisp/prim_alist.rb', line 65

def self.dissoc_impl(args, env, &equivalence_block)
  key = args.car
  alist = args.cadr
  return Lisp::Debug.process_error("the last argument to dissoc has to be a list", env) unless alist.list?

  new_prefix = nil
  trailing_end = nil
  crawler = alist
  while !crawler.nil? 
    if equivalence_block.call(crawler.caar, key)
      if new_prefix.nil?
        new_prefix = crawler.cdr
      else
        trailing_end.set_cdr!(crawler.cdr)
      end
      return new_prefix
    else
      new_cell = ConsCell.cons(ConsCell.cons(crawler.caar, crawler.cdar))
      if new_prefix.nil?
        new_prefix = new_cell
        trailing_end = new_prefix
      else
        trailing_end.set_cdr!(new_cell)
      end
    end
    crawler = crawler.cdr
  end
end

.rassoc_impl(args, env, &equivalence_block) ⇒ Object 



53
54
55
56
57
58
59
60
61
62
 
# File 'lib/rubylisp/prim_alist.rb', line 53

def self.rassoc_impl(args, env, &equivalence_block)
  value = args.car
  alist = args.cadr
  return Lisp::Debug.process_error("the last argument to rassoc has to be a list", env) unless alist.list?
  alist.each do |pair|
    if equivalence_block.call(pair.cdr, value)
      return pair
    end
  end
end

.register ⇒ Object 



6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
# File 'lib/rubylisp/prim_alist.rb', line 6

def self.register
  Primitive.register("acons", "2|3")      {|args, env| Lisp::PrimAlist::acons_impl(args, env) }
  Primitive.register("assq", "2")         {|args, env| Lisp::PrimAlist::assoc_impl(args, env) {|a, b| a.eq?(b) } }
  Primitive.register("assv", "2")         {|args, env| Lisp::PrimAlist::assoc_impl(args, env) {|a, b| a.eqv?(b) } }
  Primitive.register("assoc", "2")        {|args, env| Lisp::PrimAlist::assoc_impl(args, env) {|a, b| a.equal?(b) } }
  Primitive.register("rassq", "2")        {|args, env| Lisp::PrimAlist::rassoc_impl(args, env) {|a, b| a.eq?(b) } }
  Primitive.register("rassv", "2")        {|args, env| Lisp::PrimAlist::rassoc_impl(args, env) {|a, b| a.eqv?(b) } }
  Primitive.register("rassoc", "2")       {|args, env| Lisp::PrimAlist::rassoc_impl(args, env) {|a, b| a.equal?(b) } }
  Primitive.register("del-assq", "2")     {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.eq?(b) } }
  Primitive.register("dissq", "2")        {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.eq?(b) } }
  Primitive.register("del-assv", "2")     {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.eqv?(b) } }
  Primitive.register("dissv", "2")        {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.eqv?(b) } }
  Primitive.register("del-assoc", "2")    {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.equal?(b) } }
  Primitive.register("dissoc", "2")       {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.equal?(b) } }
  Primitive.register("zip", "2|3")        {|args, env| Lisp::PrimAlist::zip_impl(args, env) }
  Primitive.register("pairlis", "2|3")    {|args, env| Lisp::PrimAlist::zip_impl(args, env) }
end

.zip_impl(args, env) ⇒ Object 



95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
 
# File 'lib/rubylisp/prim_alist.rb', line 95

def self.zip_impl(args, env)
  key_list = args.car
  return Lisp::Debug.process_error("the keys supplied to zip has to be a list", env) unless key_list.list?
  value_list = args.cadr
  return Lisp::Debug.process_error("the values supplied to zip has to be a list", env) unless value_list.list?
  return Lisp::Debug.process_error("zip requires the same number of keys and values", env) unless key_list.length == value_list.length

  old_list = if args.length == 3
               alist = args.caddr
               return Lisp::Debug.process_error("the third argument to zip has to be a list", env) unless alist.list?
               alist
             else
               nil
             end
  pairs = key_list.to_a.zip(value_list.to_a)
  pairs.inject(old_list) {|alist, pair| ConsCell.cons(ConsCell.cons(*pair), alist)}
end