rubymotionlisp 0.2.2 → 1.0.0

Sign up to get free protection for your applications and to get access to all the features.
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
@@ -0,0 +1,496 @@
1
+ module Lisp
2
+
3
+ class PrimListSupport
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, "1") {|args, env| ad_impl(args, env, name) }
11
+ end
12
+
13
+ Primitive.register("list", "*") {|args, env| Lisp::PrimListSupport::list_impl(args, env) }
14
+ Primitive.register("cons*", "*") {|args, env| Lisp::PrimListSupport::cons_star_impl(args, env) }
15
+ Primitive.register("cons", "2") {|args, env| Lisp::PrimListSupport::cons_impl(args, env) }
16
+ Primitive.register("make-list", "1|2") {|args, env| Lisp::PrimListSupport::make_list_impl(args, env) }
17
+ Primitive.register("iota", "1|2|3") {|args, env| Lisp::PrimListSupport::iota_impl(args, env) }
18
+
19
+ Primitive.register("length", "1") {|args, env| Lisp::PrimListSupport::length_impl(args, env) }
20
+ Primitive.register("first", "1") {|args, env| Lisp::PrimListSupport::first_impl(args, env) }
21
+ Primitive.register("head", "1") {|args, env| Lisp::PrimListSupport::first_impl(args, env) }
22
+ Primitive.register("rest", "1") {|args, env| Lisp::PrimListSupport::rest_impl(args, env) }
23
+ Primitive.register("tail", "1") {|args, env| Lisp::PrimListSupport::rest_impl(args, env) }
24
+ Primitive.register("second", "1") {|args, env| Lisp::PrimListSupport::second_impl(args, env) }
25
+ Primitive.register("third", "1") {|args, env| Lisp::PrimListSupport::third_impl(args, env) }
26
+ Primitive.register("fourth", "1") {|args, env| Lisp::PrimListSupport::fourth_impl(args, env) }
27
+ Primitive.register("fifth", "1") {|args, env| Lisp::PrimListSupport::fifth_impl(args, env) }
28
+ Primitive.register("sixth", "1") {|args, env| Lisp::PrimListSupport::sixth_impl(args, env) }
29
+ Primitive.register("seventh", "1") {|args, env| Lisp::PrimListSupport::seventh_impl(args, env) }
30
+ Primitive.register("eighth", "1") {|args, env| Lisp::PrimListSupport::eighth_impl(args, env) }
31
+ Primitive.register("ninth", "1") {|args, env| Lisp::PrimListSupport::ninth_impl(args, env) }
32
+ Primitive.register("tenth", "1") {|args, env| Lisp::PrimListSupport::tenth_impl(args, env) }
33
+ Primitive.register("nth", "2") {|args, env| Lisp::PrimListSupport::nth_impl(args, env) }
34
+
35
+ Primitive.register("sublist", "3") {|args, env| Lisp::PrimListSupport::sublist_impl(args, env) }
36
+ Primitive.register("list-head", "2") {|args, env| Lisp::PrimListSupport::list_head_impl(args, env) }
37
+ Primitive.register("take", "2") {|args, env| Lisp::PrimListSupport::take_impl(args, env) }
38
+ Primitive.register("list-tail", "2") {|args, env| Lisp::PrimListSupport::list_tail_impl(args, env) }
39
+ Primitive.register("drop", "2") {|args, env| Lisp::PrimListSupport::drop_impl(args, env) }
40
+ Primitive.register("last-pair", "1") {|args, env| Lisp::PrimListSupport::last_pair_impl(args, env) }
41
+
42
+ Primitive.register("memq", "2") {|args, env| Lisp::PrimListSupport::memq_impl(args, env) }
43
+ Primitive.register("memv", "2") {|args, env| Lisp::PrimListSupport::memv_impl(args, env) }
44
+ Primitive.register("member", "2") {|args, env| Lisp::PrimListSupport::member_impl(args, env) }
45
+
46
+ Primitive.register("filter", "2") {|args, env| Lisp::PrimListSupport::filter_impl(args, env) }
47
+ Primitive.register("remove", "2") {|args, env| Lisp::PrimListSupport::remove_impl(args, env) }
48
+ Primitive.register("partition", "2") {|args, env| Lisp::PrimListSupport::partition_impl(args, env) }
49
+ Primitive.register("map", ">=2") {|args, env| Lisp::PrimListSupport::map_impl(args, env) }
50
+ Primitive.register("for-each", ">=2") {|args, env| Lisp::PrimListSupport::for_each_impl(args, env) }
51
+ Primitive.register("reduce-left", "3") {|args, env| Lisp::PrimListSupport::reduce_left_impl(args, env) }
52
+ Primitive.register("any", ">=2") {|args, env| Lisp::PrimListSupport::any_impl(args, env) }
53
+ Primitive.register("every", ">=2") {|args, env| Lisp::PrimListSupport::every_impl(args, env) }
54
+ Primitive.register("reverse", "1") {|args, env| Lisp::PrimListSupport::reverse_impl(args, env) }
55
+ Primitive.register("append", ">=1") {|args, env| Lisp::PrimListSupport::append_impl(args, env) }
56
+ Primitive.register("append!", ">=1") {|args, env| Lisp::PrimListSupport::appendbang_impl(args, env) }
57
+ Primitive.register("flatten", "1") {|args, env| Lisp::PrimListSupport::flatten_impl(args, env) }
58
+ # Primitive.register("flatten*") {|args, env| Lisp::PrimListSupport::recursive_flatten_impl(args, env) }
59
+ end
60
+
61
+
62
+ def self.cons_impl(args, env)
63
+ Lisp::ConsCell.cons(args.car, args.cadr)
64
+ end
65
+
66
+
67
+ def self.cons_star_impl(args, env)
68
+ return args.car if args.length == 1
69
+ arg_ary = args.to_a
70
+ Lisp::ConsCell::array_to_list(arg_ary[0..-2], arg_ary[-1])
71
+ end
72
+
73
+
74
+ def self.list_impl(args, env)
75
+ args
76
+ end
77
+
78
+
79
+ def self.make_list_impl(args, env)
80
+ return Lisp::Debug.process_error("make-list requires an integer for it's first argument, received: #{args.car}", env) unless args.car.integer?
81
+ count = args.car.value
82
+ val = if args.length == 1
83
+ nil
84
+ else
85
+ args.cadr
86
+ end
87
+
88
+ vals = Array.new(count, val)
89
+ Lisp::ConsCell::array_to_list(vals)
90
+ end
91
+
92
+
93
+ def self.iota_impl(args, env)
94
+ arg1 = args.car
95
+ return Lisp::Debug.process_error("iota requires an positive integer for it's first argument, received: #{arg1}", env) unless arg1.integer? && arg1.positive?
96
+ count = arg1.value
97
+
98
+ start = if args.length < 2
99
+ 0
100
+ else
101
+ arg2 = args.cadr
102
+ return Lisp::Debug.process_error("iota requires an number for it's second argument, received: #{arg2}", env) unless arg2.number?
103
+ arg2.value
104
+ end
105
+
106
+ step = if args.length < 3
107
+ 1
108
+ else
109
+ arg3 = args.caddr
110
+ return Lisp::Debug.process_error("iota requires an number for it's third argument, received: #{arg3}", env) unless arg3.number?
111
+ arg3.value
112
+ end
113
+
114
+ vals = []
115
+ count.times do |c|
116
+ vals << start
117
+ start += step
118
+ end
119
+
120
+ Lisp::ConsCell::array_to_list(vals.map {|v| Number.with_value(v) })
121
+ end
122
+
123
+
124
+ def self.length_impl(args, env)
125
+ Lisp::Number.with_value(args.car.length)
126
+ end
127
+
128
+
129
+ # in support of all the CxR functions
130
+ def self.ad_impl(args, env, f)
131
+ l = args.car
132
+ return Lisp::Debug.process_error("list required.", env) unless l.list?
133
+ l.send(f)
134
+ end
135
+
136
+
137
+ def self.first_impl(args, env)
138
+ l = args.car
139
+ return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
140
+ return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 1
141
+ l.nth(0)
142
+ end
143
+
144
+
145
+ def self.rest_impl(args, env)
146
+ l = args.car
147
+ return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
148
+ l.cdr
149
+ end
150
+
151
+
152
+ def self.second_impl(args, env)
153
+ l = args.car
154
+ return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
155
+ return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 2
156
+ l.nth(1)
157
+ end
158
+
159
+ def self.third_impl(args, env)
160
+ l = args.car
161
+ return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
162
+ return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 3
163
+ l.nth(2)
164
+ end
165
+
166
+
167
+ def self.fourth_impl(args, env)
168
+ l = args.car
169
+ return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
170
+ return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 4
171
+ l.nth(3)
172
+ end
173
+
174
+
175
+ def self.fifth_impl(args, env)
176
+ l = args.car
177
+ return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
178
+ return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 5
179
+ l.nth(4)
180
+ end
181
+
182
+
183
+ def self.sixth_impl(args, env)
184
+ l = args.car
185
+ return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
186
+ return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 6
187
+ l.nth(5)
188
+ end
189
+
190
+
191
+ def self.seventh_impl(args, env)
192
+ l = args.car
193
+ return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
194
+ return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 7
195
+ l.nth(6)
196
+ end
197
+
198
+
199
+ def self.eighth_impl(args, env)
200
+ l = args.car
201
+ return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
202
+ return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 8
203
+ l.nth(7)
204
+ end
205
+
206
+
207
+ def self.ninth_impl(args, env)
208
+ l = args.car
209
+ return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
210
+ return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 9
211
+ l.nth(8)
212
+ end
213
+
214
+
215
+ def self.tenth_impl(args, env)
216
+ l = args.car
217
+ return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
218
+ return Lisp::Debug.process_error("list index out of bounds", env) unless l.length >= 10
219
+ l.nth(9)
220
+ end
221
+
222
+
223
+ def self.nth_impl(args, env)
224
+ n = args.car
225
+ return Lisp::Debug.process_error("The first argument of nth has to be an number.", env) unless n.number?
226
+ return Lisp::Debug.process_error("The first argument of nth has to be non-negative.", env) unless n.value >= 0
227
+ l = args.cadr
228
+ return Lisp::Debug.process_error("rest requires a list.", env) unless l.list?
229
+ l.nth(n.value)
230
+ end
231
+
232
+
233
+ def self.make_same_kind_as(sequence, value)
234
+ if sequence.vector?
235
+ Lisp::Vector.new(value)
236
+ else
237
+ Lisp::ConsCell.array_to_list(value)
238
+ end
239
+ end
240
+
241
+
242
+ def self.sublist_impl(args, env)
243
+ l = args.car
244
+ return Lisp::Debug.process_error("sublist requires it's first argument to be a list, but received #{l}", env) unless l.list?
245
+ st = args.cadr
246
+ 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
247
+ return Lisp::Debug.process_error("sublist requires it's second argument to be <= the list length", env) unless st.value < l.length
248
+ en = args.caddr
249
+ 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
250
+ return Lisp::Debug.process_error("sublist requires it's third argument to be <= the list length", env) unless en.value < l.length
251
+ return Lisp::Debug.process_error("sublist requires it's second argument to be <= the third argument", env) unless st.value <= en.value
252
+ Lisp::ConsCell.array_to_list(l.to_a[st.value...en.value])
253
+ end
254
+
255
+
256
+ def self.list_head_impl(args, env)
257
+ l = args.car
258
+ return Lisp::Debug.process_error("list_head requires it's first argument to be a list, but received #{l}", env) unless l.list?
259
+ k = args.cadr
260
+ 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
261
+ return Lisp::Debug.process_error("list_head requires it's second argument to be <= the list length", env) unless k.value <= l.length
262
+ Lisp::ConsCell.array_to_list(l.to_a[0...k.value])
263
+ end
264
+
265
+
266
+ def self.take_impl(args, env)
267
+ k = args.car
268
+ 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
269
+ l = args.cadr
270
+ return Lisp::Debug.process_error("take requires it's second argument to be a list, but received #{l}", env) unless l.list?
271
+ return Lisp::Debug.process_error("take requires it's first argument to be <= the list length", env) unless k.value <= l.length
272
+ Lisp::ConsCell.array_to_list(l.to_a[0...k.value])
273
+ end
274
+
275
+
276
+ def self.list_tail_impl(args, env)
277
+ l = args.car
278
+ return Lisp::Debug.process_error("list_head requires it's first argument to be a list, but received #{l}", env) unless l.list?
279
+ k = args.cadr
280
+ 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
281
+ return Lisp::Debug.process_error("list_head requires it's second argument to be <= the list length", env) unless k.value <= l.length
282
+ l.nth_tail(k.value)
283
+ end
284
+
285
+
286
+ def self.drop_impl(args, env)
287
+ k = args.car
288
+ 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
289
+ l = args.cadr
290
+ return Lisp::Debug.process_error("drop requires it's second argument to be a list, but received #{l}", env) unless l.list?
291
+ return Lisp::Debug.process_error("drop requires it's first argument to be <= the list length", env) unless k.value <= l.length
292
+ l.nth_tail(k.value)
293
+ end
294
+
295
+
296
+ def self.last_pair_impl(args, env)
297
+ l = args.car
298
+ return Lisp::Debug.process_error("last_pair requires it's argument to be a list, but received #{l}", env) unless l.list?
299
+ l.last
300
+ end
301
+
302
+
303
+ def self.memq_impl(args, env)
304
+ item = args.car
305
+ collection = args.cadr
306
+ return Lisp::Debug.process_error("memq requires a list as it's second argument.", env) unless collection.list?
307
+ collection.length.times do |i|
308
+ if item.eq?(collection.nth(i))
309
+ return collection.nth_tail(i)
310
+ end
311
+ end
312
+ Lisp::FALSE
313
+ end
314
+
315
+
316
+ def self.memv_impl(args, env)
317
+ item = args.car
318
+ collection = args.cadr
319
+ return Lisp::Debug.process_error("memv requires a list as it's second argument.", env) unless collection.list?
320
+ collection.length.times do |i|
321
+ if item.eqv?(collection.nth(i))
322
+ return collection.nth_tail(i)
323
+ end
324
+ end
325
+ Lisp::FALSE
326
+ end
327
+
328
+
329
+ def self.member_impl(args, env)
330
+ item = args.car
331
+ collection = args.cadr
332
+ return Lisp::Debug.process_error("member requires a list as it's second argument.", env) unless collection.list?
333
+ collection.length.times do |i|
334
+ if item.equal?(collection.nth(i))
335
+ return collection.nth_tail(i)
336
+ end
337
+ end
338
+ Lisp::FALSE
339
+ end
340
+
341
+
342
+ def self.filter_impl(args, env)
343
+ f = args.car
344
+ return Lisp::Debug.process_error("filter requires a function as it's first argument but received #{args.car}.", env) unless f.function? || f.primitive?
345
+ collection = args.cadr
346
+ return Lisp::Debug.process_error("filter requires a list as it's second argument but received #{args.cadr}.", env) unless collection.list?
347
+ results = collection.to_a.select {|item| f.apply_to_without_evaluating(Lisp::ConsCell.cons(item, nil), env).value }
348
+ Lisp::ConsCell.array_to_list(results)
349
+ end
350
+
351
+
352
+ def self.remove_impl(args, env)
353
+ f = args.car
354
+ return Lisp::Debug.process_error("remove requires a function as it's first argument but received #{args.car}.", env) unless f.function? || f.primitive?
355
+ collection = args.cadr
356
+ return Lisp::Debug.process_error("remove requires a list as it's second argument but received #{args.cadr}.", env) unless collection.list?
357
+ results = collection.to_a.reject {|item| f.apply_to_without_evaluating(Lisp::ConsCell.cons(item, nil), env).value }
358
+ Lisp::ConsCell.array_to_list(results)
359
+ end
360
+
361
+
362
+ def self.partition_impl(args, env)
363
+ f = args.car
364
+ return Lisp::Debug.process_error("partition requires a function as it's first argument.", env) unless f.function? || f.primitive?
365
+ collection = args.cadr
366
+ return Lisp::Debug.process_error("partition requires a list as it's second argument.", env) unless collection.list?
367
+ results = collection.to_a.partition {|item| f.apply_to_without_evaluating(Lisp::ConsCell.cons(item, nil), env).value }
368
+ matches = Lisp::ConsCell.array_to_list(results[0])
369
+ non_matches = Lisp::ConsCell.array_to_list(results[1])
370
+ Lisp::ConsCell.array_to_list([matches, non_matches])
371
+ end
372
+
373
+
374
+ def self.map_impl(args, env)
375
+ f = args.car
376
+ return Lisp::Debug.process_error("map requires a function as it's first argument but received #{args.car}.", env) unless f.function? || f.primitive?
377
+ collections = args.cdr.to_a
378
+ return Lisp::Debug.process_error("map requires all subsequent arguments to be lists", env) unless collections.all? {|l| l.list?}
379
+ lists = collections.collect {|l| l.to_a }
380
+
381
+ map_args = []
382
+ while (lists.all? {|l| !l.empty? })
383
+ map_args << Lisp::ConsCell.array_to_list(lists.map {|l| l.shift })
384
+ end
385
+ results = map_args.collect {|item| f.apply_to_without_evaluating(item, env) }
386
+ Lisp::ConsCell.array_to_list(results)
387
+ end
388
+
389
+
390
+ def self.for_each_impl(args, env)
391
+ f = args.car
392
+ 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?
393
+ collections = args.cdr
394
+ return Lisp::Debug.process_error("for-each requires all subsequent arguments to be lists", env) unless collections.all? {|l| l.list?}
395
+ lists = collections.collect {|l| l.to_a }
396
+
397
+ map_args = []
398
+ while (lists.all? {|l| !l.empty? })
399
+ map_args << Lisp::ConsCell.array_to_list(lists.map {|l| l.shift })
400
+ end
401
+ map_args.collect {|item| f.apply_to_without_evaluating(item, env) }
402
+
403
+ nil
404
+ end
405
+
406
+
407
+ def self.quote_if_required(thing)
408
+ return thing unless thing.list? || thing.symbol?
409
+ thing.quoted
410
+ end
411
+
412
+
413
+ def self.reduce_left_impl(args, env)
414
+ f = args.car
415
+ 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?
416
+ initial = args.cadr
417
+ collection = args.caddr
418
+ return Lisp::Debug.process_error("reduce-left requires a list as it's third argument but received #{args.caddr}.", env) unless collection.list?
419
+ return initial if collection.empty?
420
+ return collection.nth(0) if collection.length == 1
421
+ collection.to_a.inject do |acc, item|
422
+ f.apply_to_without_evaluating(Lisp::ConsCell.array_to_list([acc, item]), env)
423
+ end
424
+ end
425
+
426
+
427
+ def self.any_impl(args, env)
428
+ p = args.car
429
+ return Lisp::Debug.process_error("any requires a function as it's first argument", env) unless p.function? || p.primitive?
430
+ lists = args.cdr.to_a
431
+ return Lisp::Debug.process_error("any requires all subsequent arguments to be lists", env) unless lists.all? {|l| l.list?}
432
+
433
+ while true
434
+ cars = lists.collect {|l| l.nth(0)}
435
+ return_val = p.apply_to(Lisp::ConsCell.array_to_list(cars), env)
436
+ return Lisp::TRUE if return_val.value
437
+ lists = lists.collect {|l| l.nth_tail(1)}
438
+ return Lisp::FALSE if lists.any? {|l| l.empty?}
439
+ end
440
+ end
441
+
442
+
443
+ def self.every_impl(args, env)
444
+ p = args.car
445
+ return Lisp::Debug.process_error("every requires a function as it's first argument", env) unless p.function? || p.primitive?
446
+ lists = args.cdr.to_a
447
+ return Lisp::Debug.process_error("every requires all subsequent arguments to be lists", env) unless lists.all? {|l| l.list?}
448
+
449
+
450
+ while true
451
+ cars = lists.collect {|l| l.nth(0)}
452
+ return_val = p.apply_to(Lisp::ConsCell.array_to_list(cars), env)
453
+ return Lisp::FALSE unless return_val.value
454
+ lists = lists.collect {|l| l.nth_tail(1)}
455
+ return Lisp::TRUE if lists.any? {|l| l.empty?}
456
+ end
457
+ end
458
+
459
+
460
+ def self.reverse_impl(args, env)
461
+ l = args.car
462
+ return Lisp::Debug.process_error("reverse requires a list", env) unless l.list?
463
+ Lisp::ConsCell.array_to_list(l.to_a.reverse)
464
+ end
465
+
466
+
467
+ def self.append_impl(args, env)
468
+ l = args
469
+ return Lisp::Debug.process_error("append requires lists", env) unless l.all? {|i| i.list? }
470
+ new_items = []
471
+ l.each do |sublist|
472
+ sublist.each {|item| new_items << item.copy}
473
+ end
474
+
475
+ Lisp::ConsCell.array_to_list(new_items)
476
+ end
477
+
478
+
479
+ def self.appendbang_impl(args, env)
480
+ arg_array = args.to_a
481
+ return Lisp::Debug.process_error("append! requires lists", env) unless arg_array.all? {|i| i.list?}
482
+ (0...(arg_array.length-1)). each do |i|
483
+ arg_array[i].last.set_cdr!(arg_array[i+1])
484
+ end
485
+ arg_array[0]
486
+ end
487
+
488
+
489
+ def self.flatten_impl(args, env)
490
+ l = args.car
491
+ return Lisp::Debug.process_error("flatten requires a list argument", env) unless l.list?
492
+ l.flatten
493
+ end
494
+
495
+ end
496
+ end
@@ -1,37 +1,32 @@
1
1
  module Lisp
2
2
 
3
- class Logical
3
+ class PrimLogical
4
4
 
5
5
  def self.register
6
- Primitive.register("or",
6
+ Primitive.register("or", ">=2",
7
7
  "(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.",
8
8
  true) do |args, env|
9
- Lisp::Logical::or_impl(args, env)
9
+ Lisp::PrimLogical::or_impl(args, env)
10
10
  end
11
- Primitive.register("and",
11
+ Primitive.register("and", ">=2",
12
12
  "(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.",
13
13
  true) do |args, env|
14
- Lisp::Logical::and_impl(args, env)
14
+ Lisp::PrimLogical::and_impl(args, env)
15
15
  end
16
- Primitive.register("not") {|args, env| Lisp::Logical::not_impl(args, env) }
16
+ Primitive.register("not", "1") {|args, env| Lisp::PrimLogical::not_impl(args, env) }
17
17
  end
18
18
 
19
19
 
20
20
  def self.or_impl(args, env)
21
- return Lisp::Debug.process_error("or needs at least 2 arguments", env) unless args.length > 1
22
- value = !!args.inject(false) {|acc, item| acc || item.evaluate(env).value}
23
- return Lisp::Boolean.with_value(value)
21
+ Lisp::Boolean.with_value(args.inject(false) {|acc, item| acc || item.evaluate(env).value})
24
22
  end
25
23
 
26
24
  def self.and_impl(args, env)
27
- return Lisp::Debug.process_error("and needs at least 2 arguments", env) unless args.length > 1
28
- value = !!args.inject(true) {|acc, item| acc && item.evaluate(env).value}
29
- return Lisp::Boolean.with_value(value)
25
+ Lisp::Boolean.with_value(args.inject(true) {|acc, item| acc && item.evaluate(env).value})
30
26
  end
31
27
 
32
28
  def self.not_impl(args, env)
33
- return Lisp::Debug.process_error("not needs a single argument", env) unless args.length == 1
34
- return Lisp::Boolean.with_value(!(args.car.evaluate(env).value))
29
+ return Lisp::Boolean.with_value(!(args.car.value))
35
30
  end
36
31
 
37
32
  end