rubymotionlisp 0.1.3

Sign up to get free protection for your applications and to get access to all the features.
@@ -0,0 +1,403 @@
1
+ module Lisp
2
+
3
+ class Math
4
+
5
+ def self.register
6
+ self.bind("PI", ::Math::PI)
7
+ self.bind("E", ::Math::E)
8
+
9
+ Primitive.register("+", "(+ number...)\n\nAdds a series of numbers.") do |args, env|
10
+ Lisp::Math.add_impl(args, env)
11
+ end
12
+
13
+ Primitive.register("-", "(- number...)\n\nSequentially subtracts a sequence of numbers.\nAs expected, a unary form of - is available as well.") do |args, env|
14
+ Lisp::Math.subtract_impl(args, env)
15
+ end
16
+
17
+ Primitive.register("*", "(* number...)\n\nMultiplies a series of numbers.") do |args, env|
18
+ Lisp::Math.multiply_impl(args, env)
19
+ end
20
+
21
+ Primitive.register("/", "(/ number...)\n\nSequentially divides a sequence of numbers.") do |args, env|
22
+ Lisp::Math.quotient_impl(args, env)
23
+ end
24
+
25
+ Primitive.register("%", "(% number number)\n\nReturns the remainder of the division of two numbers. NOTE: modulus only works for integers.") do |args, env|
26
+ Lisp::Math.remainder_impl(args, env)
27
+ end
28
+
29
+ Primitive.register("modulo", "(modulo number number)\n\nReturns the remainder of the division of two numbers. NOTE: modulus only works for integers.") do |args, env|
30
+ Lisp::Math.remainder_impl(args, env)
31
+ end
32
+
33
+ Primitive.register("even?", "(even? number)\n\nReturns whether the argument is even.") do |args, env|
34
+ Lisp::Math.even_impl(args, env)
35
+ end
36
+
37
+ Primitive.register("odd?", "(odd? number)\n\nReturns whether the argument is odd.") do |args, env|
38
+ Lisp::Math.odd_impl(args, env)
39
+ end
40
+
41
+ Primitive.register("zero?", "(zero? _number_)\n\nReturns whether the argument is zero.") do |args, env|
42
+ Lisp::Math.zero_impl(args, env)
43
+ end
44
+
45
+ Primitive.register("positive?", "(positive? _number_)\n\nReturns whether the argument is positive.") do |args, env|
46
+ Lisp::Math.positive_impl(args, env)
47
+ end
48
+
49
+ Primitive.register("negative?", "(negative? _number_)\n\nReturns whether the argument is negative.") do |args, env|
50
+ Lisp::Math.negative_impl(args, env)
51
+ end
52
+
53
+ Primitive.register("interval", "(interval _lo_ _hi_)\n\nCreates a list of numbers from `lo` to `hi`, inclusive.") do |args, env|
54
+ Lisp::Math.interval_impl(args, env)
55
+ end
56
+
57
+ Primitive.register("truncate", "(truncate number)\n\nReturns the integer value of number. If it is an integer, it is simply returned. However, if it is a float the integer part is returned.") do |args, env|
58
+ Lisp::Math.truncate_impl(args, env)
59
+ end
60
+
61
+ Primitive.register("round", "(round number)\n\nIf number is an integer, it is simply returned. However, if it is a float the closest integer is returned.") do |args, env|
62
+ Lisp::Math.round_impl(args, env)
63
+ end
64
+
65
+ Primitive.register("ceiling", "(ceiling _number_)\n\nIf `number` is an integer, it is simply returned. However, if it is a float the smallest integer greater than or equal to `number` is returned.") do |args, env|
66
+ Lisp::Math.ceiling_impl(args, env)
67
+ end
68
+
69
+ Primitive.register("floor", "(floor _number_)\n\nIf `number` is an integer, it is simply returned. However, if it is a float the
70
+ largest integer less than or equal to `number` is returned.") do |args, env|
71
+ Lisp::Math.floor_impl(args, env)
72
+ end
73
+
74
+ Primitive.register("random", "(random)\n\nReturns a pseudo-random floating point number between 0.0 and 1.0, including 0.0 and excluding 1.0.\n\n(random n)\n\nReturns a pseudo-random integer greater than or equal to 0 and less than n.") do |args, env|
75
+ Lisp::Math.random_impl(args, env)
76
+ end
77
+
78
+ Primitive.register("float", "(float number)\n\nReturns the floating point value of number. If it is a float, it is simply returned. However, if it is an integer it is converted to float and returned.") do |args, env|
79
+ Lisp::Math.float_impl(args, env)
80
+ end
81
+
82
+ Primitive.register("integer", "(integer number)\n\nReturns the integer value of number. If it is an integer, it is simply returned. However, if it is a float the integer part is returned. This is the same as tuncate.") do |args, env|
83
+ Lisp::Math.integer_impl(args, env)
84
+ end
85
+
86
+ Primitive.register("sqrt", "(sqrt _number_)\n\nReturns the square root of `number'.") do |args, env|
87
+ Lisp::Math.sqrt_impl(args, env)
88
+ end
89
+
90
+ Primitive.register("min", "(min _number_...)\n\nReturns the smallest of all the `number` arguments.") do |args, env|
91
+ Lisp::Math.min_impl(args, env)
92
+ end
93
+
94
+ Primitive.register("max", "(max _number_...)\n\nReturns the largest of all the `number` arguments.") do |args, env|
95
+ Lisp::Math.max_impl(args, env)
96
+ end
97
+
98
+ Primitive.register("abs", "(abs _number_)\n\nReturns the absolute value of `number'.") do |args, env|
99
+ Lisp::Math.abs_impl(args, env)
100
+ end
101
+
102
+ Primitive.register("sin", "(sin _number_)\n\nReturns the sine of `number'.") do |args, env|
103
+ Lisp::Math.sin_impl(args, env)
104
+ end
105
+
106
+ Primitive.register("cos", " (cos _number_)\n\nReturns the cosine of `number'.") do |args, env|
107
+ Lisp::Math.cos_impl(args, env)
108
+ end
109
+
110
+ Primitive.register("tan", "(tan _number_)\n\nReturns the tangent of `number'.") do |args, env|
111
+ Lisp::Math.tan_impl(args, env)
112
+ end
113
+
114
+
115
+ end
116
+
117
+
118
+ def self.bind(name, number)
119
+ EnvironmentFrame.global.bind(Symbol.named(name), Number.with_value(number))
120
+ end
121
+
122
+ def self.add_impl(args, env)
123
+ raise "add needs at least 1 argument" if args.empty?
124
+
125
+ acc = 0
126
+ c = args
127
+ while !c.nil?
128
+ n = c.car.evaluate(env)
129
+ raise "add needs number arguments but was given a #{n.type}: #{n}" unless n.type == :number
130
+ acc += n.value
131
+ c = c.cdr
132
+ end
133
+
134
+ Number.with_value(acc)
135
+ end
136
+
137
+
138
+ def self.subtract_impl(args, env)
139
+ raise "subtract needs at least 1 argument" if args.empty?
140
+
141
+ return Number.with_value(-1 * args.car.evaluate(env).value) if args.length == 1
142
+
143
+ first = args.car.evaluate(env)
144
+ raise "subtract needs number arguments, but received #{first}" unless first.type == :number
145
+ acc = first.value
146
+ c = args.cdr
147
+ while !c.nil?
148
+ n = c.car.evaluate(env)
149
+ raise "subtract needs number arguments, but received #{n}" unless n.type == :number
150
+ acc -= n.value
151
+ c = c.cdr
152
+ end
153
+
154
+ Number.with_value(acc)
155
+ end
156
+
157
+
158
+ def self.multiply_impl(args, env)
159
+ raise "multiply needs at least 1 argument" if args.empty?
160
+
161
+ acc = 1
162
+ c = args
163
+ while !c.nil?
164
+ n = c.car.evaluate(env)
165
+ raise "multiply needs number arguments, but received #{n}" unless n.type == :number
166
+ acc *= n.value
167
+ c = c.cdr
168
+ end
169
+
170
+ Number.with_value(acc)
171
+ end
172
+
173
+
174
+ def self.quotient_impl(args, env)
175
+ raise "quotient needs at least 1 argument" if args.empty?
176
+
177
+ first = args.car.evaluate(env)
178
+ raise "quotient needs number arguments, but received #{first}" unless first.type == :number
179
+ return first if args.length == 1
180
+ acc = first.value
181
+ c = args.cdr
182
+ while !c.nil?
183
+ n = c.car.evaluate(env)
184
+ raise "quotient needs number arguments, but received #{n}" unless n.type == :number
185
+ acc /= n.value
186
+ c = c.cdr
187
+ end
188
+
189
+ Number.with_value(acc)
190
+ end
191
+
192
+
193
+ def self.remainder_impl(args, env)
194
+ raise "remainder needs at least 1 argument" if args.empty?
195
+
196
+ first = args.car.evaluate(env)
197
+ raise "remainder needs number arguments, but received #{first}" unless first.type == :number
198
+ return first if args.length == 1
199
+ acc = first.value
200
+ c = args.cdr
201
+ while !c.nil?
202
+ n = c.car.evaluate(env)
203
+ raise "remainder needs number arguments, but received #{n}" unless n.type == :number
204
+ acc %= n.value
205
+ c = c.cdr
206
+ end
207
+
208
+ Number.with_value(acc)
209
+ end
210
+
211
+ def self.truncate_impl(args, env)
212
+ raise "truncate needs 1 argument, but received #{args.length}" if args.length != 1
213
+ arg = args.car.evaluate(env)
214
+ raise "truncate needs a number argument, but received #{arg}" unless arg.type == :number
215
+ Number.with_value(arg.value.truncate)
216
+ end
217
+
218
+
219
+ def self.round_impl(args, env)
220
+ raise "round needs 1 argument, but received #{args.length}" if args.length != 1
221
+ arg = args.car.evaluate(env)
222
+ raise "round needs a number argument, but received #{arg}" unless arg.type == :number
223
+ num = arg.value
224
+ int = num.to_i
225
+ Number.with_value(if (num - int).abs == 0.5
226
+ if int.even?
227
+ int
228
+ else
229
+ int + (int < 0 ? -1 : 1)
230
+ end
231
+ else
232
+ arg.value.round
233
+ end)
234
+ end
235
+
236
+
237
+ def self.ceiling_impl(args, env)
238
+ raise "ceiling needs 1 argument, but received #{args.length}" if args.length != 1
239
+ arg = args.car.evaluate(env)
240
+ raise "ceiling needs a number argument, but received #{arg}" unless arg.type == :number
241
+ Number.with_value(arg.value.ceil)
242
+ end
243
+
244
+
245
+ def self.floor_impl(args, env)
246
+ raise "floor needs 1 argument, but received #{args.length}" if args.length != 1
247
+ arg = args.car.evaluate(env)
248
+ raise "floor needs a number argument, but received #{arg}" unless arg.type == :number
249
+ Number.with_value(arg.value.floor)
250
+ end
251
+
252
+
253
+ def self.even_impl(args, env)
254
+ raise "even? needs 1 argument, but received #{args.length}" if args.length != 1
255
+ arg = args.car.evaluate(env)
256
+ raise "even? needs a number argument, but received #{arg}" unless arg.type == :number
257
+ Boolean.with_value(arg.value.even?)
258
+ end
259
+
260
+
261
+ def self.odd_impl(args, env)
262
+ raise "odd? needs 1 argument, but received #{args.length}" if args.length != 1
263
+ arg = args.car.evaluate(env)
264
+ raise "odd? needs a number argument, but received #{arg}" unless arg.type == :number
265
+ Boolean.with_value(arg.value.odd?)
266
+ end
267
+
268
+
269
+ def self.zero_impl(args, env)
270
+ raise "zero? needs 1 argument, but received #{args.length}" if args.length != 1
271
+ arg = args.car.evaluate(env)
272
+ raise "zero? needs a number argument, but received #{arg}" unless arg.type == :number
273
+ Boolean.with_value(arg.value.zero?)
274
+ end
275
+
276
+
277
+ def self.positive_impl(args, env)
278
+ raise "positive? needs 1 argument, but received #{args.length}" if args.length != 1
279
+ arg = args.car.evaluate(env)
280
+ raise "positive? needs a number argument, but received #{arg}" unless arg.type == :number
281
+ Boolean.with_value(arg.value > 0)
282
+ end
283
+
284
+
285
+ def self.negative_impl(args, env)
286
+ raise "negative? needs 1 argument, but received #{args.length}" if args.length != 1
287
+ arg = args.car.evaluate(env)
288
+ raise "negative? needs a number argument, but received #{arg}" unless arg.type == :number
289
+ Boolean.with_value(arg.value < 0)
290
+ end
291
+
292
+
293
+ def self.interval_impl(args, env)
294
+ raise "interval needs 2 arguments, but received #{args.length}" if args.length != 2
295
+ initial = args.car.evaluate(env)
296
+ raise "interval needs number arguments, but received #{initial}" unless initial.type == :number
297
+ final = args.cadr.evaluate(env)
298
+ raise "interval needs number arguments, but received #{final}" unless final.type == :number
299
+ raise "interval's arguments need to be in natural order" unless initial.value <= final.value
300
+ Lisp::ConsCell.array_to_list((initial.value..final.value).to_a.map {|n| Number.with_value(n)})
301
+ end
302
+
303
+
304
+ def self.random_impl(args, env)
305
+ arg = args.car.evaluate(env)
306
+ raise "random needs a number argument, but received #{arg}" unless arg.nil? || arg.type == :number
307
+ Number.with_value(arg.nil? ? rand() : rand(arg.value))
308
+ end
309
+
310
+
311
+ def self.float_impl(args, env)
312
+ raise "float needs 1 argument, but received #{args.length}" if args.length != 1
313
+ arg = args.car.evaluate(env)
314
+ raise "float needs a numeric or string argument, but received #{arg}" unless arg.number? || arg.string?
315
+ Number.with_value(arg.value.to_f)
316
+ end
317
+
318
+
319
+ def self.integer_impl(args, env)
320
+ raise "integer needs 1 argument, but received #{args.length}" if args.length != 1
321
+ arg = args.car.evaluate(env)
322
+ raise "integer needs a numeric or string argument, but received #{arg}" unless arg.number? || arg.string?
323
+ Number.with_value(arg.value.to_i)
324
+ end
325
+
326
+
327
+ def self.abs_impl(args, env)
328
+ raise "abs needs 1 argument, but received #{args.length}" if args.length != 1
329
+ arg = args.car.evaluate(env)
330
+ raise "abs needs a numeric argument, but received #{arg}" unless arg.number?
331
+ Number.with_value(arg.value.abs)
332
+ end
333
+
334
+
335
+ def self.sqrt_impl(args, env)
336
+ raise "sqrt needs 1 argument, but received #{args.length}" if args.length != 1
337
+ arg = args.car.evaluate(env)
338
+ raise "sqrt needs a numeric argument, but received #{arg}" unless arg.number?
339
+ Number.with_value(::Math.sqrt(arg.value).round(5))
340
+ end
341
+
342
+
343
+ def self.min_impl(args, env)
344
+ raise "min needs at least 1 argument" if args.length == 0
345
+
346
+ initial = args.car.evaluate(env)
347
+ raise "min requires numeric arguments, but received #{initial}" unless initial.type ==:number
348
+ acc = initial.value
349
+ c = args.cdr
350
+ while !c.nil?
351
+ n = c.car.evaluate(env)
352
+ raise "min needs number arguments, but received #{n}" unless n.type == :number
353
+ acc = n.value if n.value < acc
354
+ c = c.cdr
355
+ end
356
+
357
+ Number.with_value(acc)
358
+ end
359
+
360
+
361
+ def self.max_impl(args, env)
362
+ raise "max needs at least 1 argumenta" if args.length == 0
363
+ initial = args.car.evaluate(env)
364
+ raise "max requires numeric arguments, but received #{initial}" unless initial.type ==:number
365
+ acc = initial.value
366
+ c = args.cdr
367
+ while !c.nil?
368
+ n = c.car.evaluate(env)
369
+ raise "max needs number arguments, but received #{n}" unless n.type == :number
370
+ acc = n.value if n.value > acc
371
+ c = c.cdr
372
+ end
373
+
374
+ Number.with_value(acc)
375
+ end
376
+
377
+
378
+ def self.sin_impl(args, env)
379
+ raise "sin needs 1 argument, but received #{args.length}" if args.length != 1
380
+ arg = args.car.evaluate(env)
381
+ raise "sin needs a numeric argument, but received #{arg}" unless arg.number?
382
+ Number.with_value(::Math.sin(arg.value).round(5))
383
+ end
384
+
385
+
386
+ def self.cos_impl(args, env)
387
+ raise "cos needs 1 argument, but received #{args.length}" if args.length != 1
388
+ arg = args.car.evaluate(env)
389
+ raise "cos needs a numeric argument, but received #{arg}" unless arg.number?
390
+ Number.with_value(::Math.cos(arg.value).round(5))
391
+ end
392
+
393
+
394
+ def self.tan_impl(args, env)
395
+ raise "tan needs 1 argument, but received #{args.length}" if args.length != 1
396
+ arg = args.car.evaluate(env)
397
+ raise "tan needs a numeric argument, but received #{arg}" unless arg.number?
398
+ Number.with_value(::Math.tan(arg.value).round(5))
399
+ end
400
+
401
+
402
+ end
403
+ end
@@ -0,0 +1,63 @@
1
+ module Lisp
2
+
3
+ class Number < Atom
4
+
5
+ def self.with_value(n)
6
+ self.new(n)
7
+ end
8
+
9
+ def initialize(n = 0)
10
+ @value = n
11
+ end
12
+
13
+ def set!(n)
14
+ @value = n
15
+ end
16
+
17
+ def number?
18
+ true
19
+ end
20
+
21
+ def integer?
22
+ @value.integer?
23
+ end
24
+
25
+ def float?
26
+ !@value.integer?
27
+ end
28
+
29
+ def integer
30
+ @value.to_i
31
+ end
32
+
33
+ def positive?
34
+ @value > 0
35
+ end
36
+
37
+ def zero?
38
+ @value == 0
39
+ end
40
+
41
+ def negative?
42
+ @value < 0
43
+ end
44
+
45
+ def type
46
+ :number
47
+ end
48
+
49
+ def to_s
50
+ "#{@value}"
51
+ end
52
+
53
+ def true?
54
+ @value != 0
55
+ end
56
+
57
+ def false?
58
+ @value == 0
59
+ end
60
+
61
+ end
62
+
63
+ end
@@ -0,0 +1,62 @@
1
+ module Lisp
2
+
3
+ class NativeObject < Atom
4
+
5
+ def self.register
6
+ Primitive.register("wrap-object") {|args, env| Lisp::NativeObject::wrap_impl(args, env) }
7
+ end
8
+
9
+ def self.wrap_impl(args, env)
10
+ raise "wrap-object requires 1 argument" unless args.length == 1
11
+ raw_val = args.car.evaluate(env)
12
+ val = if raw_val.list?
13
+ raw_val.to_a
14
+ else
15
+ raw_val
16
+ end
17
+ NativeObject.with_value(val)
18
+ end
19
+
20
+ def self.new_instance_of(c)
21
+ self.new(c.alloc.init)
22
+ end
23
+
24
+ def self.with_value(o)
25
+ self.new(o)
26
+ end
27
+
28
+ def initialize(o=nil)
29
+ @value = o
30
+ end
31
+
32
+ def with_value(&block)
33
+ block.call(@value)
34
+ end
35
+
36
+ def object?
37
+ true
38
+ end
39
+
40
+ def type
41
+ :object
42
+ end
43
+
44
+ def native_type
45
+ @value.class
46
+ end
47
+
48
+ def to_s
49
+ "<a #{@value.class}: #{@value}>"
50
+ end
51
+
52
+ def true?
53
+ @value != nil
54
+ end
55
+
56
+ def false?
57
+ @value == nil
58
+ end
59
+
60
+ end
61
+
62
+ end