rubymotionlisp 0.2.2 → 1.0.0

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
Files changed (60) hide show
  1. checksums.yaml +4 -4
  2. data/README.md +129 -2
  3. data/lib/rubylisp/atom.rb +25 -6
  4. data/lib/rubylisp/boolean.rb +9 -6
  5. data/lib/rubylisp/builtins.rb +33 -0
  6. data/lib/rubylisp/character.rb +14 -275
  7. data/lib/rubylisp/class_object.rb +56 -0
  8. data/lib/rubylisp/cons_cell.rb +50 -20
  9. data/lib/rubylisp/environment.rb +27 -0
  10. data/lib/rubylisp/environment_frame.rb +24 -6
  11. data/lib/rubylisp/eof_object.rb +26 -0
  12. data/lib/rubylisp/exception.rb +61 -61
  13. data/lib/rubylisp/ext.rb +32 -6
  14. data/lib/rubylisp/ffi_new.rb +2 -1
  15. data/lib/rubylisp/ffi_send.rb +15 -5
  16. data/lib/rubylisp/frame.rb +5 -164
  17. data/lib/rubylisp/function.rb +4 -3
  18. data/lib/rubylisp/macro.rb +13 -8
  19. data/lib/rubylisp/{object.rb → native_object.rb} +0 -15
  20. data/lib/rubylisp/number.rb +5 -0
  21. data/lib/rubylisp/parser.rb +81 -52
  22. data/lib/rubylisp/port.rb +27 -0
  23. data/lib/rubylisp/prim_alist.rb +115 -0
  24. data/lib/rubylisp/prim_assignment.rb +61 -0
  25. data/lib/rubylisp/prim_character.rb +273 -0
  26. data/lib/rubylisp/{ffi_class.rb → prim_class_object.rb} +16 -69
  27. data/lib/rubylisp/prim_environment.rb +203 -0
  28. data/lib/rubylisp/prim_equivalence.rb +93 -0
  29. data/lib/rubylisp/prim_frame.rb +166 -0
  30. data/lib/rubylisp/prim_io.rb +266 -0
  31. data/lib/rubylisp/prim_list_support.rb +496 -0
  32. data/lib/rubylisp/{logical.rb → prim_logical.rb} +9 -14
  33. data/lib/rubylisp/prim_math.rb +397 -0
  34. data/lib/rubylisp/prim_native_object.rb +21 -0
  35. data/lib/rubylisp/prim_relational.rb +42 -0
  36. data/lib/rubylisp/{special_forms.rb → prim_special_forms.rb} +97 -84
  37. data/lib/rubylisp/prim_string.rb +792 -0
  38. data/lib/rubylisp/prim_system.rb +55 -0
  39. data/lib/rubylisp/prim_type_checks.rb +58 -0
  40. data/lib/rubylisp/prim_vector.rb +497 -0
  41. data/lib/rubylisp/primitive.rb +51 -6
  42. data/lib/rubylisp/string.rb +4 -803
  43. data/lib/rubylisp/symbol.rb +0 -1
  44. data/lib/rubylisp/tokenizer.rb +160 -136
  45. data/lib/rubylisp/vector.rb +10 -31
  46. data/lib/rubymotion/debug.rb +40 -0
  47. data/lib/rubymotion/require-fix.rb +1 -0
  48. data/lib/rubymotionlisp.rb +4 -0
  49. metadata +28 -17
  50. data/lib/rubylisp/alist.rb +0 -230
  51. data/lib/rubylisp/assignment.rb +0 -65
  52. data/lib/rubylisp/equivalence.rb +0 -118
  53. data/lib/rubylisp/io.rb +0 -74
  54. data/lib/rubylisp/list_support.rb +0 -526
  55. data/lib/rubylisp/math.rb +0 -405
  56. data/lib/rubylisp/motion_builtins.rb +0 -31
  57. data/lib/rubylisp/relational.rb +0 -46
  58. data/lib/rubylisp/system.rb +0 -20
  59. data/lib/rubylisp/testing.rb +0 -136
  60. data/lib/rubylisp/type_checks.rb +0 -60
@@ -1,526 +0,0 @@
1
- module Lisp
2
-
3
- class ListSupport
4
-
5
- def self.register
6
- %w(car cdr caar cadr cdar cddr
7
- caaar caadr cadar caddr cdaar cdadr cddar cdddr
8
- caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
9
- cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr).each do |name|
10
- Primitive.register(name) {|args, env| ad_impl(args, env, name) }
11
- end
12
- Primitive.register("list") {|args, env| Lisp::ListSupport::list_impl(args, env) }
13
- Primitive.register("vector") {|args, env| Lisp::ListSupport::vector_impl(args, env) }
14
- Primitive.register("cons*") {|args, env| Lisp::ListSupport::cons_star_impl(args, env) }
15
- Primitive.register("cons") {|args, env| Lisp::ListSupport::cons_impl(args, env) }
16
- Primitive.register("make-list") {|args, env| Lisp::ListSupport::make_list_impl(args, env) }
17
- Primitive.register("iota") {|args, env| Lisp::ListSupport::iota_impl(args, env) }
18
-
19
- Primitive.register("length") {|args, env| Lisp::ListSupport::length_impl(args, env) }
20
- Primitive.register("first") {|args, env| Lisp::ListSupport::first_impl(args, env) }
21
- Primitive.register("head") {|args, env| Lisp::ListSupport::first_impl(args, env) }
22
- Primitive.register("rest") {|args, env| Lisp::ListSupport::rest_impl(args, env) }
23
- Primitive.register("tail") {|args, env| Lisp::ListSupport::rest_impl(args, env) }
24
- Primitive.register("second") {|args, env| Lisp::ListSupport::second_impl(args, env) }
25
- Primitive.register("third") {|args, env| Lisp::ListSupport::third_impl(args, env) }
26
- Primitive.register("fourth") {|args, env| Lisp::ListSupport::fourth_impl(args, env) }
27
- Primitive.register("fifth") {|args, env| Lisp::ListSupport::fifth_impl(args, env) }
28
- Primitive.register("sixth") {|args, env| Lisp::ListSupport::sixth_impl(args, env) }
29
- Primitive.register("seventh") {|args, env| Lisp::ListSupport::seventh_impl(args, env) }
30
- Primitive.register("eighth") {|args, env| Lisp::ListSupport::eighth_impl(args, env) }
31
- Primitive.register("ninth") {|args, env| Lisp::ListSupport::ninth_impl(args, env) }
32
- Primitive.register("tenth") {|args, env| Lisp::ListSupport::tenth_impl(args, env) }
33
- Primitive.register("nth") {|args, env| Lisp::ListSupport::nth_impl(args, env) }
34
-
35
- Primitive.register("sublist") {|args, env| Lisp::ListSupport::sublist_impl(args, env) }
36
- Primitive.register("list-head") {|args, env| Lisp::ListSupport::list_head_impl(args, env) }
37
- Primitive.register("take") {|args, env| Lisp::ListSupport::take_impl(args, env) }
38
- Primitive.register("list-tail") {|args, env| Lisp::ListSupport::list_tail_impl(args, env) }
39
- Primitive.register("drop") {|args, env| Lisp::ListSupport::drop_impl(args, env) }
40
- Primitive.register("last-pair") {|args, env| Lisp::ListSupport::last_pair_impl(args, env) }
41
-
42
- Primitive.register("memq") {|args, env| Lisp::ListSupport::memq_impl(args, env) }
43
- Primitive.register("memv") {|args, env| Lisp::ListSupport::memv_impl(args, env) }
44
- Primitive.register("member") {|args, env| Lisp::ListSupport::member_impl(args, env) }
45
-
46
- Primitive.register("filter") {|args, env| Lisp::ListSupport::filter_impl(args, env) }
47
- Primitive.register("remove") {|args, env| Lisp::ListSupport::remove_impl(args, env) }
48
- Primitive.register("partition") {|args, env| Lisp::ListSupport::partition_impl(args, env) }
49
- Primitive.register("map") {|args, env| Lisp::ListSupport::map_impl(args, env) }
50
- Primitive.register("reduce-left") {|args, env| Lisp::ListSupport::reduce_left_impl(args, env) }
51
- Primitive.register("any") {|args, env| Lisp::ListSupport::any_impl(args, env) }
52
- Primitive.register("every") {|args, env| Lisp::ListSupport::every_impl(args, env) }
53
- Primitive.register("reverse") {|args, env| Lisp::ListSupport::reverse_impl(args, env) }
54
- Primitive.register("append") {|args, env| Lisp::ListSupport::append_impl(args, env) }
55
- Primitive.register("append!") {|args, env| Lisp::ListSupport::appendbang_impl(args, env) }
56
- Primitive.register("flatten") {|args, env| Lisp::ListSupport::flatten_impl(args, env) }
57
- # Primitive.register("flatten*") {|args, env| Lisp::ListSupport::recursive_flatten_impl(args, env) }
58
- end
59
-
60
-
61
- def self.cons_impl(args, env)
62
- return Lisp::Debug.process_error("cons requires two arguments.", env) unless args.length == 2
63
- left = args.car.evaluate(env)
64
- right = args.cadr.evaluate(env)
65
- Lisp::ConsCell.cons(left, right)
66
- end
67
-
68
-
69
- def self.cons_star_impl(args, env)
70
- vals = []
71
- args.each {|item| vals << item.evaluate(env) }
72
- Lisp::ConsCell::array_to_list(vals[0..-2], vals[-1])
73
- end
74
-
75
-
76
- def self.list_impl(args, env)
77
- vals = []
78
- args.each {|item| vals << item.evaluate(env) }
79
- if vals.size == 1 && vals[0].vector?
80
- Lisp::ConsCell::array_to_list(vals[0].value)
81
- else
82
- Lisp::ConsCell::array_to_list(vals)
83
- end
84
- end
85
-
86
-
87
- def self.make_list_impl(args, env)
88
- return Lisp::Debug.process_error("consmake-list requires one or two arguments.", env) unless args.length == 1 || args.length == 2
89
- arg1 = args.car.evaluate(env)
90
- return Lisp::Debug.process_error("make-list requires an integer for it's first argument, received: #{args.car}", env) unless arg1.integer?
91
- count = arg1.value
92
- val = if args.length == 1
93
- nil
94
- else
95
- args.cadr.evaluate(env)
96
- end
97
-
98
- vals = Array.new(count, val)
99
- Lisp::ConsCell::array_to_list(vals)
100
- end
101
-
102
-
103
- def self.iota_impl(args, env)
104
- return Lisp::Debug.process_error("iota requires at least one argument.", env) unless args.length > 0
105
- arg1 = args.car.evaluate(env)
106
- return Lisp::Debug.process_error("iota requires an positive integer for it's first argument, received: #{args.car}", env) unless arg1.integer? && arg1.positive?
107
- count = arg1.value
108
-
109
- start = if args.length < 2
110
- 0
111
- else
112
- arg2 = args.cadr.evaluate(env)
113
- return Lisp::Debug.process_error("iota requires an number for it's second argument, received: #{args.cadr}", env) unless arg2.number?
114
- arg2.value
115
- end
116
-
117
- step = if args.length < 3
118
- 1
119
- else
120
- arg3 = args.caddr.evaluate(env)
121
- return Lisp::Debug.process_error("iota requires an number for it's third argument, received: #{args.caddr}", env) unless arg3.number?
122
- arg3.value
123
- end
124
-
125
- vals = []
126
- count.times do |c|
127
- vals << start
128
- start += step
129
- end
130
-
131
- Lisp::ConsCell::array_to_list(vals.map {|v| Number.with_value(v) })
132
- end
133
-
134
-
135
- def self.length_impl(args, env)
136
- Lisp::Number.with_value(args.car.evaluate(env).length)
137
- end
138
-
139
-
140
- # in support of all the CxR functions
141
- def self.ad_impl(args, env, f)
142
- l = args.car.evaluate(env)
143
- return Lisp::Debug.process_error("list required.", env) unless l.list?
144
- l.send(f)
145
- end
146
-
147
-
148
- def self.first_impl(args, env)
149
- l = args.car.evaluate(env)
150
- return Lisp::Debug.process_error("rest requires a list or vector.", env) unless l.list? || l.vector?
151
- return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 1
152
- l.nth(1)
153
- end
154
-
155
-
156
- def self.rest_impl(args, env)
157
- l = args.car.evaluate(env)
158
- return Lisp::Debug.process_error("rest requires a list or vector.", env) unless l.list? || l.vector?
159
- if l.list?
160
- l.cdr
161
- else
162
- Lisp::Vector.new(l.value[1..-1])
163
- end
164
- end
165
-
166
-
167
- def self.second_impl(args, env)
168
- l = args.car.evaluate(env)
169
- return Lisp::Debug.process_error("rest requires a list or vector.", env) unless l.list? || l.vector?
170
- return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 2
171
- l.nth(2)
172
- end
173
-
174
- def self.third_impl(args, env)
175
- l = args.car.evaluate(env)
176
- return Lisp::Debug.process_error("rest requires a list or vector.", env) unless l.list? || l.vector?
177
- return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 3
178
- l.nth(3)
179
- end
180
-
181
-
182
- def self.fourth_impl(args, env)
183
- l = args.car.evaluate(env)
184
- return Lisp::Debug.process_error("rest requires a list or vector.", env) unless l.list? || l.vector?
185
- return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 4
186
- l.nth(4)
187
- end
188
-
189
-
190
- def self.fifth_impl(args, env)
191
- l = args.car.evaluate(env)
192
- return Lisp::Debug.process_error("rest requires a list or vector.", env) unless l.list? || l.vector?
193
- return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 5
194
- l.nth(5)
195
- end
196
-
197
-
198
- def self.sixth_impl(args, env)
199
- l = args.car.evaluate(env)
200
- return Lisp::Debug.process_error("rest requires a list or vector.", env) unless l.list? || l.vector?
201
- return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 6
202
- l.nth(6)
203
- end
204
-
205
-
206
- def self.seventh_impl(args, env)
207
- l = args.car.evaluate(env)
208
- return Lisp::Debug.process_error("rest requires a list or vector.", env) unless l.list? || l.vector?
209
- return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 7
210
- l.nth(7)
211
- end
212
-
213
-
214
- def self.eighth_impl(args, env)
215
- l = args.car.evaluate(env)
216
- return Lisp::Debug.process_error("rest requires a list or vector.", env) unless l.list? || l.vector?
217
- return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 8
218
- l.nth(8)
219
- end
220
-
221
-
222
- def self.ninth_impl(args, env)
223
- l = args.car.evaluate(env)
224
- return Lisp::Debug.process_error("rest requires a list or vector.", env) unless l.list? || l.vector?
225
- return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 9
226
- l.nth(9)
227
- end
228
-
229
-
230
- def self.tenth_impl(args, env)
231
- l = args.car.evaluate(env)
232
- return Lisp::Debug.process_error("rest requires a list or vector.", env) unless l.list? || l.vector?
233
- return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 10
234
- l.nth(10)
235
- end
236
-
237
-
238
- def self.nth_impl(args, env)
239
- return Lisp::Debug.process_error("nth requires 2 arguments", env) unless args.length == 2
240
- n = args.car.evaluate(env)
241
- return Lisp::Debug.process_error("The first argument of nth has to be an number.", env) unless n.number?
242
- return Lisp::Debug.process_error("The first argument of nth has to be positive.", env) unless n.value > 0
243
- l = args.cadr.evaluate(env)
244
- return Lisp::Debug.process_error("rest requires a list or vector.", env) unless l.list? || l.vector?
245
- l.nth(n.value)
246
- end
247
-
248
-
249
- def self.make_same_kind_as(sequence, value)
250
- if sequence.vector?
251
- Lisp::Vector.new(value)
252
- else
253
- Lisp::ConsCell.array_to_list(value)
254
- end
255
- end
256
-
257
-
258
- def self.sublist_impl(args, env)
259
- return Lisp::Debug.process_error("sublist requires 3 arguments", env) unless args.length == 3
260
- l = args.car.evaluate(env)
261
- return Lisp::Debug.process_error("sublist requires it's first argument to be a list or vector, but received #{args.car}", env) unless l.list? || l.vector?
262
- st = args.cadr.evaluate(env)
263
- return Lisp::Debug.process_error("sublist requires it's second argument to be a positive integer, but received #{args.cadr}", env) unless st.number? && st.positive?
264
- return Lisp::Debug.process_error("sublist requires it's second argument to be <= the list length", env) unless st.value <= l.length
265
- en = args.caddr.evaluate(env)
266
- return Lisp::Debug.process_error("sublist requires it's third argument to be a positive integer, but received #{args.caddr}", env) unless en.number? && en.positive?
267
- return Lisp::Debug.process_error("sublist requires it's third argument to be <= the list length", env) unless en.value <= l.length
268
- return Lisp::Debug.process_error("sublist requires it's second argument to be <= the third argument", env) unless st.value <= en.value
269
- make_same_kind_as(l, l.to_a[(st.value - 1)...en.value])
270
- end
271
-
272
-
273
- def self.list_head_impl(args, env)
274
- return Lisp::Debug.process_error("list_head requires 2 arguments", env) unless args.length == 2
275
- l = args.car.evaluate(env)
276
- return Lisp::Debug.process_error("list_head requires it's first argument to be a list, but received #{args.car}", env) unless l.list?
277
- k = args.cadr.evaluate(env)
278
- return Lisp::Debug.process_error("list_head requires it's second argument to be a positive integer, but received #{args.cadr}", env) unless k.number? && k.positive?
279
- return Lisp::Debug.process_error("list_head requires it's second argument to be <= the list length", env) unless k.value <= l.length
280
- Lisp::ConsCell.array_to_list(l.to_a[0...k.value])
281
- end
282
-
283
-
284
- def self.take_impl(args, env)
285
- return Lisp::Debug.process_error("take requires 2 arguments", env) unless args.length == 2
286
- k = args.car.evaluate(env)
287
- return Lisp::Debug.process_error("take requires it's first argument to be an integer >= 0, but received #{args.car}", env) unless k.number? && !k.negative?
288
- l = args.cadr.evaluate(env)
289
- return Lisp::Debug.process_error("take requires it's second argument to be a list or vector, but received #{args.cadr}", env) unless l.list? || l.vector?
290
- return Lisp::Debug.process_error("take requires it's first argument to be <= the list length", env) unless k.value <= l.length
291
- make_same_kind_as(l, l.to_a[0...k.value])
292
- end
293
-
294
-
295
- def self.list_tail_impl(args, env)
296
- return Lisp::Debug.process_error("list_head requires 2 arguments", env) unless args.length == 2
297
- l = args.car.evaluate(env)
298
- return Lisp::Debug.process_error("list_head requires it's first argument to be a list, but received #{args.car}", env) unless l.list?
299
- k = args.cadr.evaluate(env)
300
- return Lisp::Debug.process_error("list_head requires it's second argument to be a positive integer, but received #{args.cadr}", env) unless k.number? && k.positive?
301
- return Lisp::Debug.process_error("list_head requires it's second argument to be <= the list length", env) unless k.value <= l.length
302
- l.nth_tail(k.value + 1)
303
- end
304
-
305
-
306
- def self.drop_impl(args, env)
307
- return Lisp::Debug.process_error("drop requires 2 arguments", env) unless args.length == 2
308
- k = args.car.evaluate(env)
309
- return Lisp::Debug.process_error("drop requires it's first argument to be an integer >= 0, but received #{args.car}", env) unless k.number? && !k.negative?
310
- l = args.cadr.evaluate(env)
311
- return Lisp::Debug.process_error("drop requires it's second argument to be a list or vector, but received #{args.cadr}", env) unless l.list? || l.vector?
312
- return Lisp::Debug.process_error("drop requires it's first argument to be <= the list length", env) unless k.value <= l.length
313
- l.nth_tail(k.value + 1)
314
- end
315
-
316
-
317
- def self.last_pair_impl(args, env)
318
- return Lisp::Debug.process_error("last_pair requires 1 arguments", env) unless args.length == 1
319
- l = args.car.evaluate(env)
320
- return Lisp::Debug.process_error("last_pair requires it's argument to be a list, but received #{args.car}", env) unless l.list?
321
- l.last
322
- end
323
-
324
-
325
- def self.memq_impl(args, env)
326
- return Lisp::Debug.process_error("memq requires 2 arguments but received #{args.length}.", env) unless args.length == 2
327
- item = args.car.evaluate(env)
328
- collection = args.cadr.evaluate(env)
329
- return Lisp::Debug.process_error("memq requires a list as it's second argument.", env) unless collection.list?
330
- collection.length.times do |i|
331
- if Lisp::Equivalence.eq_check(item, collection.nth(i + 1)).value
332
- return collection.nth_tail(i + 1)
333
- end
334
- end
335
- Lisp::FALSE
336
- end
337
-
338
-
339
- def self.memv_impl(args, env)
340
- return Lisp::Debug.process_error("memv requires 2 arguments but received #{args.length}.", env) unless args.length == 2
341
- item = args.car.evaluate(env)
342
- collection = args.cadr.evaluate(env)
343
- return Lisp::Debug.process_error("memv requires a list as it's second argument.", env) unless collection.list?
344
- collection.length.times do |i|
345
- if Lisp::Equivalence.eqv_check(item, collection.nth(i + 1)).value
346
- return collection.nth_tail(i + 1)
347
- end
348
- end
349
- Lisp::FALSE
350
- end
351
-
352
-
353
- def self.member_impl(args, env)
354
- return Lisp::Debug.process_error("member requires 2 arguments but received #{args.length}.", env) unless args.length == 2
355
- item = args.car.evaluate(env)
356
- collection = args.cadr.evaluate(env)
357
- return Lisp::Debug.process_error("member requires a list as it's second argument.", env) unless collection.list?
358
- collection.length.times do |i|
359
- if Lisp::Equivalence.equal_check(item, collection.nth(i + 1)).value
360
- return collection.nth_tail(i + 1)
361
- end
362
- end
363
- Lisp::FALSE
364
- end
365
-
366
-
367
- def self.filter_impl(args, env)
368
- return Lisp::Debug.process_error("filter requires 2 arguments but received #{args.length}.", env) unless args.length == 2
369
- f = args.car.evaluate(env)
370
- return Lisp::Debug.process_error("filter requires a function as it's first argument but received #{args.car}.", env) unless f.function? || f.primitive?
371
- collection = args.cadr.evaluate(env)
372
- return Lisp::Debug.process_error("filter requires a list or vector as it's second argument but received #{args.cadr}.", env) unless collection.list? || collection.vector?
373
- results = collection.to_a.select {|item| f.apply_to_without_evaluating(Lisp::ConsCell.cons(item, nil), env).value }
374
- make_same_kind_as(collection, results)
375
- end
376
-
377
-
378
- def self.remove_impl(args, env)
379
- return Lisp::Debug.process_error("remove requires 2 arguments but received #{args.length}.", env) unless args.length == 2
380
- f = args.car.evaluate(env)
381
- return Lisp::Debug.process_error("remove requires a function as it's first argument but received #{args.car}.", env) unless f.function? || f.primitive?
382
- collection = args.cadr.evaluate(env)
383
- return Lisp::Debug.process_error("remove requires a list or vector as it's second argument but received #{args.cadr}.", env) unless collection.list? || collection.vector?
384
- results = collection.to_a.reject {|item| f.apply_to_without_evaluating(Lisp::ConsCell.cons(item, nil), env).value }
385
- make_same_kind_as(collection, results)
386
- end
387
-
388
-
389
- def self.partition_impl(args, env)
390
- return Lisp::Debug.process_error("partition requires 2 arguments but received #{args.length}.", env) unless args.length == 2
391
- f = args.car.evaluate(env)
392
- return Lisp::Debug.process_error("partition requires a function as it's first argument.", env) unless f.function? || f.primitive?
393
- collection = args.cadr.evaluate(env)
394
- return Lisp::Debug.process_error("partition requires a list as it's second argument.", env) unless collection.list? | collection.vector?
395
- results = collection.to_a.partition {|item| f.apply_to_without_evaluating(Lisp::ConsCell.cons(item, nil), env).value }
396
- matches = make_same_kind_as(collection, results[0])
397
- non_matches = make_same_kind_as(collection, results[1])
398
- Lisp::ConsCell.array_to_list([matches, non_matches])
399
- end
400
-
401
-
402
- def self.map_impl(args, env)
403
- return Lisp::Debug.process_error("map requires at least 2 arguments but received #{args.length}.", env) if args.length < 2
404
- f = args.car.evaluate(env)
405
- return Lisp::Debug.process_error("map requires a function as it's first argument but received #{args.car}.", env) unless f.function? || f.primitive?
406
- collections = args.cdr.to_a.collect {|a| a.evaluate(env)}
407
- return Lisp::Debug.process_error("all requires all subsequent arguments to be lists or vectors", env) unless collections.all? {|l| l.list? || l.vector?}
408
- all_vectors = collections.all? {|i| i.vector?}
409
- lists = collections.collect {|l| l.to_a }
410
-
411
- map_args = []
412
- while (lists.all? {|l| !l.empty? })
413
- map_args << Lisp::ConsCell.array_to_list(lists.map {|l| l.shift })
414
- end
415
- results = map_args.collect {|item| f.apply_to_without_evaluating(item, env) }
416
- if all_vectors
417
- Lisp::Vector.new(results)
418
- else
419
- Lisp::ConsCell.array_to_list(results)
420
- end
421
-
422
- end
423
-
424
-
425
- def self.quote_if_required(thing)
426
- return thing unless thing.list? || thing.symbol?
427
- thing.quoted
428
- end
429
-
430
-
431
- def self.reduce_left_impl(args, env)
432
- return Lisp::Debug.process_error("reduce requires 3 arguments but received #{args.length}.", env) unless args.length == 3
433
- f = args.car.evaluate(env)
434
- return Lisp::Debug.process_error("map requires a function as it's first argument but received #{args.car}.", env) unless f.function? || f.primitive?
435
- initial = args.cadr.evaluate(env)
436
- collection = args.caddr.evaluate(env)
437
- return Lisp::Debug.process_error("reduce requires a list or vector as it's third argument but received #{args.caddr}.", env) unless collection.list? || collection.vector?
438
- return initial if collection.empty?
439
- return collection.nth(1) if collection.length == 1
440
- result = collection.to_a.inject do |acc, item|
441
- f.apply_to(Lisp::ConsCell.array_to_list([quote_if_required(acc), quote_if_required(item)]), env)
442
- end
443
- result
444
- end
445
-
446
-
447
- def self.any_impl(args, env)
448
- return Lisp::Debug.process_error("any requires at least two arguments", env) unless args.length >= 2
449
- p = args.car.evaluate(env)
450
- return Lisp::Debug.process_error("any requires a function as it's first argument", env) unless p.function? || p.primitive?
451
- lists = args.cdr.to_a.collect {|a| a.evaluate(env)}
452
- return Lisp::Debug.process_error("any requires all subsequent arguments to be lists or vectors", env) unless lists.all? {|l| l.list? || l.vector?}
453
-
454
- while true
455
- cars = lists.collect {|l| l.nth(1)}
456
- return_val = p.apply_to(Lisp::ConsCell.array_to_list(cars), env)
457
- return Lisp::TRUE if return_val.value
458
- lists = lists.collect {|l| l.nth_tail(2)}
459
- return Lisp::FALSE if lists.any? {|l| l.empty?}
460
- end
461
- end
462
-
463
-
464
- def self.every_impl(args, env)
465
- return Lisp::Debug.process_error("all requires at least two arguments", env) unless args.length >= 2
466
- p = args.car.evaluate(env)
467
- return Lisp::Debug.process_error("all requires a function as it's first argument", env) unless p.function? || p.primitive?
468
- lists = args.cdr.to_a.collect {|a| a.evaluate(env)}
469
- return Lisp::Debug.process_error("all requires all subsequent arguments to be lists or vectors", env) unless lists.all? {|l| l.list? || l.vector?}
470
-
471
- while true
472
- cars = lists.collect {|l| l.nth(1)}
473
- return_val = p.apply_to(Lisp::ConsCell.array_to_list(cars), env)
474
- return Lisp::FALSE unless return_val.value
475
- lists = lists.collect {|l| l.nth_tail(2)}
476
- return Lisp::TRUE if lists.any? {|l| l.empty?}
477
- end
478
- end
479
-
480
-
481
- def self.reverse_impl(args, env)
482
- return Lisp::Debug.process_error("reverse requires a single argument.", env) unless args.length == 1
483
- l = args.car.evaluate(env)
484
- return Lisp::Debug.process_error("reverse requires a list or vector", env) unless l.list? || l.vector?
485
- make_same_kind_as(l, l.to_a.reverse)
486
- end
487
-
488
-
489
- def self.append_impl(args, env)
490
- return Lisp::Debug.process_error("append requires at least 1 argument.", env) unless args.length >= 1
491
- l = args.map {|i| i.evaluate(env)}
492
- return Lisp::Debug.process_error("append requires lists or vectors", env) unless l.all? {|i| i.list? || i.vector?}
493
- all_vectors = l.all? {|i| i.vector?}
494
- new_items = []
495
- l.each do |sublist|
496
- sublist.each {|item| new_items << item.copy}
497
- end
498
-
499
- if all_vectors
500
- Lisp::Vector.new(new_items)
501
- else
502
- Lisp::ConsCell.array_to_list(new_items)
503
- end
504
- end
505
-
506
-
507
- def self.appendbang_impl(args, env)
508
- return Lisp::Debug.process_error("append! requires at least 1 argument.", env) unless args.length >= 1
509
- arg_array = args.to_a.map {|i| i.evaluate(env)}
510
- return Lisp::Debug.process_error("append! requires lists", env) unless arg_array.all? {|i| i.list?}
511
- (0...(arg_array.length-1)). each do |i|
512
- arg_array[i].last.set_cdr!(arg_array[i+1])
513
- end
514
- arg_array[0]
515
- end
516
-
517
-
518
- def self.flatten_impl(args, env)
519
- return Lisp::Debug.process_error("flatten requires 1 argument.", env) unless args.length != 1
520
- l = args.car.evaluate(env)
521
- return Lisp::Debug.process_error("flatten requires a list argument", env) unless l.list?
522
- l.flatten
523
- end
524
-
525
- end
526
- end