rubymotionlisp 0.1.3

Sign up to get free protection for your applications and to get access to all the features.
@@ -0,0 +1,454 @@
1
+ # -*- coding: utf-8 -*-
2
+ module Lisp
3
+
4
+ class SpecialForms
5
+
6
+ def self.register
7
+ Primitive.register("cond",
8
+ "(cond (predicate sexpr...)... [(else sexpr...)])\n\nEach predicate is evaluated in order until one results in true value. The expressions associated with this predicate are then evaluated in order, and the result of the `cond` is the result of the last evaluation. If all predicates evaluate to false values, the value of `cond` in indeterminate. If, however, the final predicate is the symbol `else` the expressions associated with it are evaluated, and the value of `cond` is the value of the last evaluation.",
9
+ true) do |args, env|
10
+ Lisp::SpecialForms::cond_impl(args, env)
11
+ end
12
+
13
+ Primitive.register("case",
14
+ "(case target-sexpr ((value...) sexpr...)... [(else sexpr...)])\n\n`case` chooses code to evaluate based on the value of the target `sexpr`. Each condition clause is a list of possible values. A clause is selected if the target value is in it’s list of possible values. Any number of expressions can be associated with each target value.",
15
+ true) do |args, env|
16
+ Lisp::SpecialForms::case_impl(args, env)
17
+ end
18
+
19
+ Primitive.register("if",
20
+ "(if condition true-clause)\n(if condition true-clause false-clause)\n\n`if` has two forms, one that conditionally evaluates a single `sexpr` (see `begin` which provides a way to use multiple `sexprs` in this context) and one that chooses an `sexpr` to evaluate based on the value of the condition.\n\nIn the single action version, `nil` is the value of the form when the conditions evaluates to `false`. Note that it is preferable to use `when` (see below) instead of this form of `if`.",
21
+ true) do |args, env|
22
+ Lisp::SpecialForms::if_impl(args, env)
23
+ end
24
+
25
+ Primitive.register("when",
26
+ "(when condition sexpr...)\n\nIff the condition evaluates to logically true, the `sexprs` are evaluated and the result of the last one is the result of the form, otherwise nil is the result.",
27
+ true) do |args, env|
28
+ Lisp::SpecialForms::when_impl(args, env)
29
+ end
30
+
31
+ Primitive.register("unless",
32
+ "(unless condition sexpr...)\n\nIff the condition evaluates to logically false, the `sexprs` are evaluated and the result of the last one is the result of the form, otherwise nil is the result. This is the same functionally as `(when (not condition) sexpr...)` but is simpler and can be clearer.",
33
+ true) do |args, env|
34
+ Lisp::SpecialForms::unless_impl(args, env)
35
+ end
36
+
37
+ Primitive.register("lambda",
38
+ "(lambda (param...) sexpr...)\n\nCreates an anonymous function. This can then be used in a function call.\n\n ((lambda (x)\n (+ x x))\n 5) ⇒ 10\n\nFunctions can be named (i.e. bound to a symbol) and later referred to by using define (but using `defun` is preferred):\n\n (define foo (lambda (x)\n (+ x x)))\n (foo 5) ⇒ 10\n\n`lambda` creates a local environment at the point of it’s evaluation. This environment is attached to the resulting function, and any binding or symbol lookup starts in this local environment.",
39
+ true) do |args, env|
40
+ Lisp::SpecialForms::lambda_impl(args, env)
41
+ end
42
+
43
+ Primitive.register("define",
44
+ "(define symbol value)\n\nEvaluates the value expression and binds it to the symbol, returning the value.",
45
+ true) do |args, env|
46
+ Lisp::SpecialForms::define_impl(args, env)
47
+ end
48
+
49
+ Primitive.register("defun",
50
+ "(defun (symbol param...) doc-string sexpr...)\n\nCreate a named function:\n\n`symbol` specifies the name (how you reference the function)\n\n`param...` parameters of the function, these are bound to the respective arguments when the function is called.\n\n`doc-string` is an optional documentation string.\n\n`sexpr...` the sequence of expressions that are evaluated in order when the function is called. The final evaluation result becomes the value of evaluation of the function.",
51
+ true) do |args, env|
52
+ Lisp::SpecialForms::defun_impl(args, env)
53
+ end
54
+
55
+ Primitive.register("defmacro",
56
+ "(defmacro (symbol param...) sexpr)\n\nCreate a named macro:\n\n`symbol` specifies the name (how you reference the macro)\n\n`param...` parameters of the macro, these are bound to the respective arguments when the macro is invoked. **NOTE** that the arguments to a macro invokation are **not** evaluated, but are passed as is to the macro to do with as it wishes.\n\n`sexpr` the template expression that is processed when the macro is invoked. The result of evaluating the processed template expression becomes the value of the macro's invocation.",
57
+ true) do |args, env|
58
+ Lisp::SpecialForms::defmacro_impl(args, env)
59
+ end
60
+
61
+ Primitive.register("let",
62
+ "(let ((name value)...) sexpr...)\n\nCreate a local scope and bindings for evaluating a body of code. The first argument is a list of bindings. Each binding is a raw symbol (doesn’t get evaluated) that is the name to be bound, and a value (which is evaluated). These bindings are added to a scope that is local to the let. The body is evaluated in this local scope. The value of the `let` is the last evaluation result. Bindings values are evaluated in the environment where the `let` is defined, and so are independant.",
63
+ true) do |args, env|
64
+ Lisp::SpecialForms::let_impl(args, env)
65
+ end
66
+
67
+ Primitive.register("let*",
68
+ "(let* ((name value)...) sexpr...)\n\nCreate a local scope and bindings for evaluating a body of code. The first argument is a list of bindings. Each binding is a raw symbol (doesn’t get evaluated) that is the name to be bound, and a value (which is evaluated). Each binding’s value is evaluated in the context of the local scope. I.e. bindings cascade. The body is evaluated in this local scope. The value of the `let*` is the last evaluation result.",
69
+ true) do |args, env|
70
+ Lisp::SpecialForms::letstar_impl(args, env)
71
+ end
72
+
73
+ Primitive.register("begin",
74
+ "(begin sexpr...)\n\nEvaluates the each `sexpr` in order, returning the result of the last one evaluated. Used in a context that allows a single `sexpr` but you need multiple.",
75
+ true) do |args, env|
76
+ Lisp::SpecialForms::begin_impl(args, env)
77
+ end
78
+
79
+ Primitive.register("do",
80
+ "(do ((name initial next)...) ((test sexpr...)) sexpr...)\n\nThis is a general purpose iteration construct. There are three sections:\n\nbindings\nThis is similar to `let` in that it defines names that can be used in the remainder of the scope of the `do`. Like `let` it is a list of lists, each starting with the binding name followed by the initial value of the binding. The difference is that this is followed by an expression that is evaluated at the beginning of each subsequent pass through the loop, and whose result is used as a new binding of the name.\n\ntermination\nThis is a list whose first element is an expression which is evaluated before each pass through the loop (after rebinding the variables). If it evaluates to a truthy value, the remaining expressions are evaluated in turn. The result of the final one is used as the value of the `do`.\n\nbody\nThis is a sequence of expressions that are evaluated in order each time though the loop. This section can be empty.",
81
+ true) do |args, env|
82
+ Lisp::SpecialForms::do_impl(args, env)
83
+ end
84
+
85
+ Primitive.register("eval",
86
+ "(eval sexpr)\n\nEvaluate `sexpr`.",
87
+ true) do |args, env|
88
+ Lisp::SpecialForms::eval_impl(args, env)
89
+ end
90
+
91
+ Primitive.register("apply",
92
+ "(apply function sexpr...)\n\nApply the function that results from evaluating `function` to the argument list resulting from evaluating each `sexpr`. Each initial `sexpr` can evaluate to any type of object, but the final one (and there must be at least one `sexpr`) must evaluate to a list.",
93
+ true) do |args, env|
94
+ Lisp::SpecialForms::apply_impl(args, env)
95
+ end
96
+
97
+ Primitive.register("=>",
98
+ "(=> value sexpr|symbol...)\n\nThis creates a cascade.\n\n`value` (evaluated once at the beginning) is used as the initial argument to **each** function, and they are independent and do not pass results one to another. `value` is the result of the form.\n\nSince this is implemented by syntactic modification, a `lambda` form **cannot** be used here as an `sexpr`.",
99
+ true) do |args, env|
100
+ Lisp::SpecialForms::tap_impl(args, env)
101
+ end
102
+
103
+ Primitive.register("->",
104
+ "(-> value sexpr|symbol...)\n\nThis creates a function chain. `value` (evaluated first) is used as the first argument to the first `sexpr`. The result of each `sexpr` is used as the first argument of the next, and the result of the final `sexpr` is the value of the `->` form. If a `sexpr` would take a single argument (which would be provided by the `value` or the result of the previous `sexpr`, just the function name can be used. Since this is implemented by syntactic modification, a `lambda` form cannot be used here as an `sexpr`.\n\nThe form `(-> 0 a b c)` is equivalent to `(c (b (a 0)))`.",
105
+ true) do |args, env|
106
+ Lisp::SpecialForms::chain_impl(args, env)
107
+ end
108
+
109
+ Primitive.register("quote", "(quote _expr_)\n\nSurpresses evaluation of the expression.\n\n (quote (+ 1 2)) ⇒ (+ 1 2)\n\nThere is a shortcut for quote that uses the single quote:\n\n '(+ 1 2) ⇒ (+ 1 2)") do |args, env|
110
+ Lisp::SpecialForms::quote_impl(args, env)
111
+ end
112
+
113
+ Primitive.register("quasiquote", "(quasiquote _sexpr_)\n\nThis defines a template expression that can be filled in by unquote and unquote-splicing. The backquote character can be used as a shorthand for quasiquote: `sexpr.") do |args, env|
114
+ Lisp::SpecialForms::quasiquote_impl(args, env)
115
+ end
116
+
117
+ Primitive.register("gensym", "(gensym)\n(gensym _prefix_)\n\nThis creates a unique symbol. If you provide the optional prefix string it is
118
+ used as the initial part of the symbol, otherwise GENSYM is used. gensym is
119
+ useful in macros when you need a unique name for something.") do |args, env|
120
+ Lisp::SpecialForms::gensym_impl(args, env)
121
+ end
122
+
123
+ Primitive.register("expand", "(expand _symbol_ _sexpr_...)\n\nExpands the macro named by symbol, passing the evaluated sequence of sexpr as arguments.\n\nNOTE: whereas invoking the macro (in the same way you invoke a function) expands and evaluates, expand (as you would expect) only expands the macro, resulting in the expanded template sexpr. This can then be evaluated as desired.") do |args, env|
124
+ Lisp::SpecialForms::expand_impl(args, env)
125
+ end
126
+
127
+ @@SYMBOL_COUNT = 0
128
+ end
129
+
130
+ def self.cond_impl(args, env)
131
+ unless args.nil?
132
+ args.each do |clause|
133
+ body = clause.cdr
134
+ if clause.car.to_s == "else"
135
+ result = body.evaluate_each(env) unless body.nil?
136
+ return result
137
+ else
138
+ condition = clause.car.evaluate(env)
139
+ if condition.value
140
+ result = body.evaluate_each(env) unless body.nil?
141
+ return result
142
+ end
143
+ end
144
+ end
145
+ end
146
+ nil
147
+ end
148
+
149
+
150
+ def self.case_impl(args, env)
151
+ result = nil
152
+ key_value = args.car.evaluate(env)
153
+ args.cdr.each do |clause|
154
+ if clause.pair?
155
+ body = clause.cdr
156
+ if clause.car.to_s == "else"
157
+ result = body.evaluate_each(env) unless body.nil?
158
+ return result
159
+ elsif clause.car.any? {|item| item.eq?(key_value)}
160
+ result = body.evaluate_each(env) unless body.nil?
161
+ return result
162
+ end
163
+ else
164
+ raise "Case requires non-atomic clauses"
165
+ end
166
+ end
167
+ return nil
168
+ end
169
+
170
+
171
+ def self.if_impl(args, env)
172
+ raise "IF requires a condition, true action, and possibly an else action" unless args.length == 2 || args.length == 3
173
+ condition = args.car.evaluate(env)
174
+ if condition.true?
175
+ args.cadr.evaluate(env)
176
+ elsif args.length == 3
177
+ args.caddr.evaluate(env)
178
+ else
179
+ nil
180
+ end
181
+ end
182
+
183
+
184
+ def self.when_impl(args, env)
185
+ raise "WHEN requires a condition and sexprs to evaluate." unless args.length >= 2
186
+ condition = args.car.evaluate(env)
187
+ return args.cdr.evaluate_each(env) if condition.true?
188
+ nil
189
+ end
190
+
191
+
192
+ def self.unless_impl(args, env)
193
+ raise "UNLESS requires a condition and sexprs to evaluate." unless args.length >= 2
194
+ condition = args.car.evaluate(env)
195
+ return args.cdr.evaluate_each(env) unless condition.true?
196
+ nil
197
+ end
198
+
199
+
200
+ def self.lambda_impl(args, env)
201
+ arguments = args.car
202
+ body = args.cdr
203
+ Lisp::Function.new("lambda", arguments, "", body, env)
204
+ end
205
+
206
+
207
+ def self.define_variable(definition, value, env)
208
+ raise "Variable names must be literal symbols." unless definition.symbol?
209
+
210
+ ev = value.evaluate(env)
211
+ Lisp::EnvironmentFrame.global.bind(definition, ev)
212
+ ev
213
+ end
214
+
215
+
216
+ def self.define_function(definition, body, env)
217
+ name = definition.car
218
+ raise "Function name must be a symbol" unless name.symbol?
219
+ arguments = definition.cdr
220
+ doc = nil
221
+ if body.car.string?
222
+ doc = body.car
223
+ body = body.cdr
224
+ end
225
+ f = Lisp::Function.new(name, arguments, doc, body, env)
226
+ env.bind_locally(name, f)
227
+ f
228
+ end
229
+
230
+
231
+ def self.defun_impl(args, env)
232
+ definition = args.car
233
+ raise("Function definition must specify name and parameters in a list") unless definition.list?
234
+ define_function(definition, args.cdr, env)
235
+ end
236
+
237
+
238
+ def self.define_impl(args, env)
239
+ definition = args.car
240
+ if definition.list?
241
+ define_function(definition, args.cdr, env)
242
+ else
243
+ raise "A symbol can be bound to only a single value." unless args.cdr.length == 1
244
+ define_variable(definition, args.cadr, env)
245
+ end
246
+ end
247
+
248
+
249
+ def self.defmacro_impl(args, env)
250
+ raise "defmacro requires 2 or 3 arguments: a name and argument list, and a template expression." unless args.length == 2 || args.length == 3
251
+ definition = args.car
252
+ raise "defmacro requires macro name and args in a list as it's first argument." if definition.nil? || !definition.list?
253
+ name = definition.car
254
+ arguments = definition.cdr
255
+ doc = nil
256
+ if args.cadr.string?
257
+ doc = args.cadr
258
+ body = args.caddr
259
+ else
260
+ body = args.cadr
261
+ end
262
+ m = Lisp::Macro.new(name, arguments, doc, body, env)
263
+ env.bind_locally(name, m)
264
+ m
265
+ end
266
+
267
+ def self.quote_impl(args, env)
268
+ args.car
269
+ end
270
+
271
+
272
+ def self.gensym_impl(args, env)
273
+ raise "gensym requires 0 or 1 argument" if args.length > 1
274
+ prefix = if args.length == 0
275
+ "GENSYM"
276
+ else
277
+ raise "gensym's argument must be a string" unless args.car.string?
278
+ args.car.to_s
279
+ end
280
+ sym = Lisp::Symbol.named("#{prefix}-#{@@SYMBOL_COUNT}")
281
+ @@SYMBOL_COUNT += 1
282
+ sym
283
+ end
284
+
285
+
286
+ def self.expand_impl(args, env)
287
+ macro = args.car.evaluate(env)
288
+ raise "The first argument to expand must be a macro" unless macro.macro?
289
+ macro.expand(args.cdr, env, true)
290
+ end
291
+
292
+
293
+ def self.process_quasiquoted(sexpr, level, env)
294
+ if !sexpr.list?
295
+ ConsCell.cons(sexpr)
296
+ elsif sexpr.car.symbol? && sexpr.car.name == "quasiquote"
297
+ ConsCell.cons(ConsCell.cons(Symbol.named("quasiquote"), process_quasiquoted(sexpr.cadr, level + 1, env)))
298
+ elsif sexpr.car.symbol? && sexpr.car.name == "unquote"
299
+ if level == 1
300
+ ConsCell.cons(process_quasiquoted(sexpr.cadr, level, env).car.evaluate(env))
301
+ else
302
+ ConsCell.cons(ConsCell.cons(Symbol.named("unquote"), process_quasiquoted(sexpr.cadr, level - 1, env)))
303
+ end
304
+ elsif sexpr.car.symbol? && sexpr.car.name == "unquote-splicing"
305
+ if level == 1
306
+ process_quasiquoted(sexpr.cadr, level, env).car.evaluate(env)
307
+ else
308
+ ConsCell.cons(ConsCell.cons(Symbol.named("unquote-splicing"), process_quasiquoted(sexpr.cadr, level - 1, env)))
309
+ end
310
+ else
311
+ l = ConsCell.array_to_list(sexpr.to_a.map {|e| process_quasiquoted(e, level, env)}).flatten
312
+ ConsCell.cons(l)
313
+ end
314
+ end
315
+
316
+
317
+ def self.quasiquote_impl(args, env)
318
+ return process_quasiquoted(args.car, 1, env).car
319
+ end
320
+
321
+
322
+ def self.do_let_bindings(bindings, binding_env, local_env)
323
+ bindings.each do |binding_pair|
324
+ raise "let requires a list of bindings (that are 2 element lists) as it's first argument" unless binding_pair.list?
325
+ name = binding_pair.car
326
+ raise "the first part of a let binding pair must be a symbol" unless name.symbol?
327
+ value = binding_pair.cadr.evaluate(binding_env)
328
+ local_env.bind_locally(name, value)
329
+ end
330
+ end
331
+
332
+
333
+ def self.let_impl(args, env)
334
+ bindings = args.car || Lisp::ConsCell.new
335
+ raise "let requires a list of bindings as it's firest argument" unless bindings.list?
336
+ local_frame = EnvironmentFrame.extending(env)
337
+ do_let_bindings(bindings, env, local_frame)
338
+ args.cdr.evaluate_each(local_frame)
339
+ end
340
+
341
+
342
+ def self.letstar_impl(args, env)
343
+ bindings = args.car || Lisp::ConsCell.new
344
+ raise "let requires a list of bindings as it's firest argument" unless bindings.list?
345
+ local_frame = EnvironmentFrame.extending(env)
346
+ do_let_bindings(bindings, local_frame, local_frame)
347
+ args.cdr.evaluate_each(local_frame)
348
+ end
349
+
350
+
351
+ def self.begin_impl(args, env)
352
+ args.evaluate_each(env)
353
+ end
354
+
355
+
356
+ def self.do_impl(args, env)
357
+ raise "Do requires at least a list of bindings and a test clause" if args.length < 2
358
+ bindings = args.car
359
+ raise "Do requires a list of bindings as it's first argument" unless bindings.list?
360
+ test_clause = args.cadr
361
+ raise "Do requires a list of termination condition and result expressions as it's second argument" unless test_clause.list?
362
+ body = args.cddr
363
+
364
+ local_frame = EnvironmentFrame.extending(env)
365
+
366
+ bindings.each do |binding|
367
+ raise "do bindings must be (name initial next)" unless binding.list?
368
+ name = binding.car
369
+ raise "binding name must be a symbol" unless name.symbol?
370
+ value = binding.cadr.evaluate(local_frame)
371
+ local_frame.bind_locally(name, value)
372
+ end
373
+
374
+ while true do
375
+ if test_clause.car.evaluate(local_frame).value
376
+ result = nil
377
+ test_clause.cdr.each {|sexpr| result = sexpr.evaluate(local_frame) } unless test_clause.cdr.nil?
378
+ return result
379
+ end
380
+
381
+ body.each {|sexpr| sexpr.evaluate(local_frame) } unless body.nil?
382
+
383
+ bindings.each do |binding|
384
+ unless binding.caddr.nil?
385
+ value = binding.caddr.evaluate(local_frame)
386
+ local_frame.bind_locally(binding.car, value)
387
+ end
388
+ end
389
+ end
390
+ end
391
+
392
+
393
+ def self.eval_impl(args, env)
394
+ raise "eval expects a single argument, received #{args.length}." if args.length != 1
395
+ arg = args.car.evaluate(env)
396
+ raise "eval expect a list argument, received a #{arg.type}." unless arg.list?
397
+ arg.evaluate(env)
398
+ end
399
+
400
+
401
+ def self.apply_impl(args, env)
402
+ func = args.car.evaluate(env)
403
+ raise "Expected #{args.car} to evaluate to a function." unless func.primitive? || func.function?
404
+
405
+ a = args.cdr.to_a.collect {|sexpr| sexpr.evaluate(env)}
406
+ arg_list = if a[-1].list?
407
+ Lisp::ConsCell.array_to_list(a[0..-2], a[-1])
408
+ else
409
+ args.cdr
410
+ end
411
+ func.apply_to(arg_list, env)
412
+ end
413
+
414
+
415
+ def self.chain_impl(args, env)
416
+ raise "-> requires at the very least an initial value." unless args.length > 0
417
+ value = args.car.evaluate(env)
418
+ cell = args.cdr
419
+ while !cell.nil?
420
+ sexpr = cell.car
421
+
422
+ new_expr = if sexpr.list?
423
+ Lisp::ConsCell.cons(sexpr.car, Lisp::ConsCell.cons(value, sexpr.cdr))
424
+ else
425
+ Lisp::ConsCell.array_to_list([sexpr, value])
426
+ end
427
+ value = new_expr.evaluate(env)
428
+ cell = cell.cdr
429
+ end
430
+ value
431
+ end
432
+
433
+
434
+ def self.tap_impl(args, env)
435
+ raise "tap requires at the very least an initial value." unless args.length > 0
436
+ value = args.car.evaluate(env)
437
+ cell = args.cdr
438
+ while !cell.nil?
439
+ sexpr = cell.car
440
+ new_expr = if sexpr.list?
441
+ Lisp::ConsCell.cons(sexpr.car, Lisp::ConsCell.cons(value, sexpr.cdr))
442
+ else
443
+ Lisp::ConsCell.array_to_list([sexpr, value])
444
+ end
445
+ new_expr.evaluate(env)
446
+ cell = cell.cdr
447
+ end
448
+ value
449
+ end
450
+
451
+
452
+ end
453
+
454
+ end