rubymotionlisp 0.2.2 → 1.0.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/README.md +129 -2
- data/lib/rubylisp/atom.rb +25 -6
- data/lib/rubylisp/boolean.rb +9 -6
- data/lib/rubylisp/builtins.rb +33 -0
- data/lib/rubylisp/character.rb +14 -275
- data/lib/rubylisp/class_object.rb +56 -0
- data/lib/rubylisp/cons_cell.rb +50 -20
- data/lib/rubylisp/environment.rb +27 -0
- data/lib/rubylisp/environment_frame.rb +24 -6
- data/lib/rubylisp/eof_object.rb +26 -0
- data/lib/rubylisp/exception.rb +61 -61
- data/lib/rubylisp/ext.rb +32 -6
- data/lib/rubylisp/ffi_new.rb +2 -1
- data/lib/rubylisp/ffi_send.rb +15 -5
- data/lib/rubylisp/frame.rb +5 -164
- data/lib/rubylisp/function.rb +4 -3
- data/lib/rubylisp/macro.rb +13 -8
- data/lib/rubylisp/{object.rb → native_object.rb} +0 -15
- data/lib/rubylisp/number.rb +5 -0
- data/lib/rubylisp/parser.rb +81 -52
- data/lib/rubylisp/port.rb +27 -0
- data/lib/rubylisp/prim_alist.rb +115 -0
- data/lib/rubylisp/prim_assignment.rb +61 -0
- data/lib/rubylisp/prim_character.rb +273 -0
- data/lib/rubylisp/{ffi_class.rb → prim_class_object.rb} +16 -69
- data/lib/rubylisp/prim_environment.rb +203 -0
- data/lib/rubylisp/prim_equivalence.rb +93 -0
- data/lib/rubylisp/prim_frame.rb +166 -0
- data/lib/rubylisp/prim_io.rb +266 -0
- data/lib/rubylisp/prim_list_support.rb +496 -0
- data/lib/rubylisp/{logical.rb → prim_logical.rb} +9 -14
- data/lib/rubylisp/prim_math.rb +397 -0
- data/lib/rubylisp/prim_native_object.rb +21 -0
- data/lib/rubylisp/prim_relational.rb +42 -0
- data/lib/rubylisp/{special_forms.rb → prim_special_forms.rb} +97 -84
- data/lib/rubylisp/prim_string.rb +792 -0
- data/lib/rubylisp/prim_system.rb +55 -0
- data/lib/rubylisp/prim_type_checks.rb +58 -0
- data/lib/rubylisp/prim_vector.rb +497 -0
- data/lib/rubylisp/primitive.rb +51 -6
- data/lib/rubylisp/string.rb +4 -803
- data/lib/rubylisp/symbol.rb +0 -1
- data/lib/rubylisp/tokenizer.rb +160 -136
- data/lib/rubylisp/vector.rb +10 -31
- data/lib/rubymotion/debug.rb +40 -0
- data/lib/rubymotion/require-fix.rb +1 -0
- data/lib/rubymotionlisp.rb +4 -0
- metadata +28 -17
- data/lib/rubylisp/alist.rb +0 -230
- data/lib/rubylisp/assignment.rb +0 -65
- data/lib/rubylisp/equivalence.rb +0 -118
- data/lib/rubylisp/io.rb +0 -74
- data/lib/rubylisp/list_support.rb +0 -526
- data/lib/rubylisp/math.rb +0 -405
- data/lib/rubylisp/motion_builtins.rb +0 -31
- data/lib/rubylisp/relational.rb +0 -46
- data/lib/rubylisp/system.rb +0 -20
- data/lib/rubylisp/testing.rb +0 -136
- 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
|