Line data Source code
1 : #include <assert.h>
2 : #include <stdarg.h>
3 : #include <string.h>
4 :
5 : #include "libstephen/lisp.h"
6 :
7 0 : static lisp_list *lisp_new_pair_list(lisp_runtime *rt, lisp_value *one, lisp_value *two)
8 : {
9 0 : lisp_list *first_node = (lisp_list*) lisp_new(rt, type_list);
10 0 : lisp_list *second_node = (lisp_list*) lisp_new(rt, type_list);
11 0 : first_node->left = one;
12 0 : first_node->right = (lisp_value*) second_node;
13 0 : second_node->left = two;
14 0 : second_node->right = lisp_nil_new(rt);
15 0 : return first_node;
16 : }
17 :
18 0 : void lisp_scope_bind(lisp_scope *scope, lisp_symbol *symbol, lisp_value *value)
19 : {
20 0 : ht_insert(&scope->scope, PTR(symbol), PTR(value));
21 0 : }
22 :
23 0 : lisp_value *lisp_scope_lookup(lisp_runtime *rt, lisp_scope *scope,
24 : lisp_symbol *symbol)
25 : {
26 0 : smb_status status = SMB_SUCCESS;
27 0 : lisp_value *v = ht_get(&scope->scope, PTR(symbol), &status).data_ptr;
28 0 : if (status == SMB_NOT_FOUND_ERROR) {
29 0 : if (scope->up) {
30 0 : return lisp_scope_lookup(rt, scope->up, symbol);
31 : } else {
32 0 : return (lisp_value*)lisp_error_new(rt, "symbol not found in scope");
33 : }
34 : } else {
35 0 : return v;
36 : }
37 : }
38 :
39 0 : void lisp_scope_add_builtin(lisp_runtime *rt, lisp_scope *scope, char *name,
40 : lisp_builtin_func call)
41 : {
42 0 : lisp_symbol *symbol = lisp_symbol_new(rt, name);
43 0 : lisp_builtin *builtin = lisp_builtin_new(rt, name, call);
44 0 : lisp_scope_bind(scope, symbol, (lisp_value*)builtin);
45 0 : }
46 :
47 0 : void lisp_scope_replace_or_insert(lisp_scope *scope, lisp_symbol *key, lisp_value *value)
48 : {
49 0 : lisp_scope *s = scope;
50 :
51 : // First go up the chain checking for the name.
52 0 : while (s) {
53 0 : if (ht_contains(&s->scope, PTR(key))) {
54 : // If we find it, replace it.
55 0 : ht_insert(&s->scope, PTR(key), PTR(value));
56 0 : return;
57 : }
58 0 : s = s->up;
59 : }
60 :
61 : // If we never find it, insert it in the "lowest" scope.
62 0 : ht_insert(&scope->scope, PTR(key), PTR(value));
63 : }
64 :
65 0 : lisp_symbol *lisp_symbol_new(lisp_runtime *rt, char *sym)
66 : {
67 0 : lisp_symbol *err = (lisp_symbol*)lisp_new(rt, type_symbol);
68 0 : int len = strlen(sym);
69 0 : err->sym = malloc(len + 1);
70 0 : strncpy(err->sym, sym, len);
71 0 : err->sym[len] = '\0';
72 0 : return err;
73 : }
74 :
75 0 : lisp_error *lisp_error_new(lisp_runtime *rt, char *message)
76 : {
77 0 : lisp_error *err = (lisp_error*)lisp_new(rt, type_error);
78 0 : int len = strlen(message);
79 0 : err->message = malloc(len + 1);
80 0 : strncpy(err->message, message, len);
81 0 : err->message[len] = '\0';
82 0 : return err;
83 : }
84 :
85 0 : lisp_builtin *lisp_builtin_new(lisp_runtime *rt, char *name,
86 : lisp_builtin_func call)
87 : {
88 0 : lisp_builtin *builtin = (lisp_builtin*)lisp_new(rt, type_builtin);
89 0 : builtin->call = call;
90 0 : builtin->name = name;
91 0 : return builtin;
92 : }
93 :
94 0 : lisp_value *lisp_nil_new(lisp_runtime *rt)
95 : {
96 0 : if (rt->nil == NULL) {
97 0 : rt->nil = lisp_new(rt, type_list);
98 : }
99 0 : return rt->nil;
100 : }
101 :
102 0 : lisp_value *lisp_eval_list(lisp_runtime *rt, lisp_scope *scope, lisp_value *l)
103 : {
104 0 : if (lisp_nil_p(l)) {
105 0 : return l;
106 : }
107 0 : lisp_list *list = (lisp_list*) l;
108 0 : lisp_list *result = (lisp_list*)lisp_new(rt, type_list);
109 0 : result->left = lisp_eval(rt, scope, list->left);
110 0 : result->right = lisp_eval_list(rt, scope, list->right);
111 0 : return (lisp_value*) result;
112 : }
113 :
114 0 : int lisp_list_length(lisp_list *list)
115 : {
116 0 : int length = 0;
117 0 : while (list->type == type_list && !lisp_nil_p((lisp_value*)list)) {
118 0 : length++;
119 0 : list = (lisp_list*)list->right;
120 : }
121 0 : return length;
122 : }
123 :
124 0 : lisp_value *lisp_quote(lisp_runtime *rt, lisp_value *value) {
125 0 : lisp_list *l = (lisp_list*)lisp_new(rt, type_list);
126 0 : lisp_symbol *q = lisp_symbol_new(rt, "quote");
127 0 : l->left = (lisp_value*)q;
128 0 : lisp_list *s = (lisp_list*) lisp_new(rt, type_list);
129 0 : s->right = lisp_nil_new(rt);
130 0 : l->right = (lisp_value*)s;
131 0 : s->left = value;
132 0 : return (lisp_value*)l;
133 : }
134 :
135 0 : static lisp_type *lisp_get_type(char c)
136 : {
137 0 : switch (c) {
138 : case 'd':
139 0 : return type_integer;
140 : case 'l':
141 0 : return type_list;
142 : case 's':
143 0 : return type_symbol;
144 : case 'S':
145 0 : return type_string;
146 : case 'o':
147 0 : return type_scope;
148 : case 'e':
149 0 : return type_error;
150 : case 'b':
151 0 : return type_builtin;
152 : case 't':
153 0 : return type_type;
154 : }
155 0 : return NULL;
156 : }
157 :
158 0 : bool lisp_get_args(lisp_list *list, char *format, ...)
159 : {
160 : va_list va;
161 0 : va_start(va, format);
162 : lisp_value **v;
163 0 : while (!lisp_nil_p((lisp_value*)list) && *format != '\0') {
164 0 : lisp_type *type = lisp_get_type(*format);
165 0 : if (type != NULL && type != list->left->type) {
166 0 : return false;
167 : }
168 0 : v = va_arg(va, lisp_value**);
169 0 : *v = list->left;
170 0 : list = (lisp_list*)list->right;
171 0 : format += 1;
172 : }
173 0 : if (strlen(format) != 0 || !lisp_nil_p((lisp_value*)list)) {
174 0 : return false;
175 : }
176 0 : return true;
177 : }
178 :
179 0 : static lisp_value *lisp_builtin_eval(lisp_runtime *rt, lisp_scope *scope,
180 : lisp_value *arguments)
181 : {
182 0 : lisp_list *evald = (lisp_list*)lisp_eval_list(rt, scope, arguments);
183 0 : lisp_value *result = lisp_eval(rt, scope, evald->left);
184 0 : return result;
185 : }
186 :
187 0 : static lisp_value *lisp_builtin_car(lisp_runtime *rt, lisp_scope *scope,
188 : lisp_value *a)
189 : {
190 : lisp_list *firstarg;
191 0 : lisp_list *arglist = (lisp_list*) lisp_eval_list(rt, scope, a);
192 0 : if (!lisp_get_args(arglist, "l", &firstarg)) {
193 0 : return (lisp_value*)lisp_error_new(rt, "wrong arguments to car");
194 : }
195 0 : if (lisp_list_length(firstarg) == 0) {
196 0 : return (lisp_value*)lisp_error_new(rt, "expected at least one item");
197 : }
198 0 : return firstarg->left;
199 : }
200 :
201 0 : static lisp_value *lisp_builtin_cdr(lisp_runtime *rt, lisp_scope *scope,
202 : lisp_value *a)
203 : {
204 : lisp_list *firstarg;
205 0 : lisp_list *arglist = (lisp_list*) lisp_eval_list(rt, scope, a);
206 0 : if (!lisp_get_args(arglist, "l", &firstarg)) {
207 0 : return (lisp_value*) lisp_error_new(rt, "wrong arguments to cdr");
208 : }
209 : // save rv because firstarg may be deleted after decref
210 0 : return firstarg->right;
211 : }
212 :
213 0 : static lisp_value *lisp_builtin_quote(lisp_runtime *rt, lisp_scope *scope,
214 : lisp_value *a)
215 : {
216 : (void)scope;
217 : lisp_value *firstarg;
218 0 : lisp_list *arglist = (lisp_list*) a;
219 0 : if (!lisp_get_args(arglist, "*", &firstarg)) {
220 0 : return (lisp_value*) lisp_error_new(rt, "wrong arguments to quote");
221 : }
222 0 : return arglist->left;
223 : }
224 :
225 0 : static lisp_value *lisp_builtin_cons(lisp_runtime *rt, lisp_scope *scope,
226 : lisp_value *a)
227 : {
228 : lisp_value *a1;
229 : lisp_value *l;
230 0 : lisp_list *arglist = (lisp_list*) lisp_eval_list(rt, scope, a);
231 0 : if (!lisp_get_args(arglist, "**", &a1, &l)) {
232 0 : return (lisp_value*) lisp_error_new(rt, "wrong arguments to cons");
233 : }
234 0 : lisp_list *new = (lisp_list*)lisp_new(rt, type_list);
235 0 : new->left = a1;
236 0 : new->right = (lisp_value*)l;
237 0 : return (lisp_value*)new;
238 : }
239 :
240 0 : static lisp_value *lisp_builtin_lambda(lisp_runtime *rt, lisp_scope *scope,
241 : lisp_value *a)
242 : {
243 : lisp_list *argnames;
244 : lisp_value *code;
245 0 : lisp_list *our_args = (lisp_list*)a;
246 : (void)scope;
247 :
248 0 : if (!lisp_get_args(our_args, "l*", &argnames, &code)) {
249 0 : return (lisp_value*) lisp_error_new(rt, "expected argument list and code");
250 : }
251 :
252 0 : lisp_list *it = argnames;
253 0 : while (!lisp_nil_p((lisp_value*)it)) {
254 0 : if (it->left->type != type_symbol) {
255 0 : return (lisp_value*) lisp_error_new(rt, "argument names must be symbols");
256 : }
257 0 : it = (lisp_list*) it->right;
258 : }
259 :
260 0 : lisp_lambda *lambda = (lisp_lambda*)lisp_new(rt, type_lambda);
261 0 : lambda->args = argnames;
262 0 : lambda->code = code;
263 0 : lambda->closure = scope;
264 0 : return (lisp_value*) lambda;
265 : }
266 :
267 0 : static lisp_value *lisp_builtin_define(lisp_runtime *rt, lisp_scope *scope,
268 : lisp_value *a)
269 : {
270 : lisp_symbol *s;
271 : lisp_value *expr;
272 :
273 0 : if (!lisp_get_args((lisp_list*)a, "s*", &s, &expr)) {
274 0 : return (lisp_value*) lisp_error_new(rt, "expected name and expression");
275 : }
276 :
277 0 : lisp_value *evald = lisp_eval(rt, scope, expr);
278 0 : lisp_scope_replace_or_insert(scope, s, evald);
279 : //lisp_scope_bind(scope, s, evald);
280 0 : return evald;
281 : }
282 :
283 0 : static lisp_value *lisp_builtin_plus(lisp_runtime *rt, lisp_scope *scope,
284 : lisp_value *a)
285 : {
286 : lisp_integer *i;
287 0 : lisp_list *args = (lisp_list*)lisp_eval_list(rt, scope, a);
288 0 : int sum = 0;
289 :
290 0 : while (!lisp_nil_p((lisp_value*)args)) {
291 0 : if (args->left->type != type_integer) {
292 0 : return (lisp_value*) lisp_error_new(rt, "expect integers for addition");
293 : }
294 0 : i = (lisp_integer*) args->left;
295 0 : sum += i->x;
296 0 : args = (lisp_list*)args->right;
297 : }
298 :
299 0 : i = (lisp_integer*)lisp_new(rt, type_integer);
300 0 : i->x = sum;
301 0 : return (lisp_value*)i;
302 : }
303 :
304 0 : static lisp_value *lisp_builtin_minus(lisp_runtime *rt, lisp_scope *scope,
305 : lisp_value *a)
306 : {
307 : lisp_integer *i;
308 0 : lisp_list *args = (lisp_list*)lisp_eval_list(rt, scope, a);
309 0 : int val = 0;
310 0 : int len = lisp_list_length(args);
311 :
312 0 : if (len < 1) {
313 0 : return (lisp_value*) lisp_error_new(rt, "expected at least one arg");
314 0 : } else if (len == 1) {
315 0 : i = (lisp_integer*) args->left;
316 0 : val = - i->x;
317 : } else {
318 0 : i = (lisp_integer*) args->left;
319 0 : val = i->x;
320 0 : args = (lisp_list*)args->right;
321 0 : while (!lisp_nil_p((lisp_value*)args)) {
322 0 : if (args->left->type != type_integer) {
323 0 : return (lisp_value*)lisp_error_new(rt, "expected integer");
324 : }
325 0 : i = (lisp_integer*) args->left;
326 0 : val -= i->x;
327 0 : args = (lisp_list*) args->right;
328 : }
329 : }
330 :
331 0 : i = (lisp_integer*)lisp_new(rt, type_integer);
332 0 : i->x = val;
333 0 : return (lisp_value*)i;
334 : }
335 :
336 0 : static lisp_value *lisp_builtin_multiply(lisp_runtime *rt, lisp_scope *scope,
337 : lisp_value *a)
338 : {
339 : lisp_integer *i;
340 0 : lisp_list *args = (lisp_list*) lisp_eval_list(rt, scope, a);
341 0 : int product = 1;
342 :
343 0 : while (!lisp_nil_p((lisp_value*)args)) {
344 0 : if (args->left->type != type_integer) {
345 0 : return (lisp_value*) lisp_error_new(rt, "expect integers for multiplication");
346 : }
347 0 : i = (lisp_integer*) args->left;
348 0 : product *= i->x;
349 0 : args = (lisp_list*)args->right;
350 : }
351 :
352 0 : i = (lisp_integer*)lisp_new(rt, type_integer);
353 0 : i->x = product;
354 0 : return (lisp_value*)i;
355 : }
356 :
357 0 : static lisp_value *lisp_builtin_divide(lisp_runtime *rt, lisp_scope *scope,
358 : lisp_value *a)
359 : {
360 : lisp_integer *i;
361 0 : lisp_list *args = (lisp_list*)lisp_eval_list(rt, scope, a);
362 0 : int val = 0;
363 0 : int len = lisp_list_length(args);
364 :
365 0 : if (len < 1) {
366 0 : return (lisp_value*) lisp_error_new(rt, "expected at least one arg");
367 : }
368 0 : i = (lisp_integer*) args->left;
369 0 : val = i->x;
370 0 : args = (lisp_list*)args->right;
371 0 : while (!lisp_nil_p((lisp_value*)args)) {
372 0 : if (args->left->type != type_integer) {
373 0 : return (lisp_value*)lisp_error_new(rt, "expected integer");
374 : }
375 0 : i = (lisp_integer*) args->left;
376 0 : if (i->x == 0) {
377 0 : return (lisp_value*) lisp_error_new(rt, "divide by zero");
378 : }
379 0 : val /= i->x;
380 0 : args = (lisp_list*) args->right;
381 : }
382 :
383 0 : i = (lisp_integer*)lisp_new(rt, type_integer);
384 0 : i->x = val;
385 0 : return (lisp_value*)i;
386 : }
387 :
388 0 : static lisp_value *lisp_builtin_cmp_util(lisp_runtime *rt, lisp_scope *scope,
389 : lisp_value *a)
390 : {
391 : lisp_integer *first, *second;
392 0 : lisp_list *args = (lisp_list*) lisp_eval_list(rt, scope, a);
393 :
394 0 : if (!lisp_get_args((lisp_list*)args, "dd", &first, &second)) {
395 0 : return (lisp_value*) lisp_error_new(rt, "expected two integers");
396 : }
397 :
398 0 : lisp_integer *result = (lisp_integer*)lisp_new(rt, type_integer);
399 0 : result->x = first->x - second->x;
400 0 : return (lisp_value*)result;
401 : }
402 :
403 0 : static lisp_value *lisp_builtin_eq(lisp_runtime *rt, lisp_scope *scope,
404 : lisp_value *a)
405 : {
406 0 : lisp_integer *v = (lisp_integer*)lisp_builtin_cmp_util(rt, scope, a);
407 0 : if (v->type == type_integer) {
408 0 : v->x = (v->x == 0);
409 : }
410 0 : return (lisp_value*)v;
411 : }
412 :
413 0 : static lisp_value *lisp_builtin_gt(lisp_runtime *rt, lisp_scope *scope,
414 : lisp_value *a)
415 : {
416 0 : lisp_integer *v = (lisp_integer*)lisp_builtin_cmp_util(rt, scope, a);
417 0 : if (v->type == type_integer) {
418 0 : v->x = (v->x > 0);
419 : }
420 0 : return (lisp_value*)v;
421 : }
422 :
423 0 : static lisp_value *lisp_builtin_ge(lisp_runtime *rt, lisp_scope *scope,
424 : lisp_value *a)
425 : {
426 0 : lisp_integer *v = (lisp_integer*)lisp_builtin_cmp_util(rt, scope, a);
427 0 : if (v->type == type_integer) {
428 0 : v->x = (v->x >= 0);
429 : }
430 0 : return (lisp_value*)v;
431 : }
432 :
433 0 : static lisp_value *lisp_builtin_lt(lisp_runtime *rt, lisp_scope *scope,
434 : lisp_value *a)
435 : {
436 0 : lisp_integer *v = (lisp_integer*)lisp_builtin_cmp_util(rt, scope, a);
437 0 : if (v->type == type_integer) {
438 0 : v->x = (v->x < 0);
439 : }
440 0 : return (lisp_value*)v;
441 : }
442 :
443 0 : static lisp_value *lisp_builtin_le(lisp_runtime *rt, lisp_scope *scope,
444 : lisp_value *a)
445 : {
446 0 : lisp_integer *v = (lisp_integer*)lisp_builtin_cmp_util(rt, scope, a);
447 0 : if (v->type == type_integer) {
448 0 : v->x = (v->x <= 0);
449 : }
450 0 : return (lisp_value*)v;
451 : }
452 :
453 0 : static lisp_value *lisp_builtin_if(lisp_runtime *rt, lisp_scope *scope,
454 : lisp_value *a)
455 : {
456 : lisp_value *condition, *body_true, *body_false;
457 :
458 0 : if (!lisp_get_args((lisp_list*)a, "***", &condition, &body_true, &body_false)) {
459 0 : return (lisp_value*) lisp_error_new(rt, "expected condition and two bodies");
460 : }
461 :
462 0 : condition = lisp_eval(rt, scope, condition);
463 0 : if (condition->type == type_integer && ((lisp_integer*)condition)->x) {
464 0 : return lisp_eval(rt, scope, body_true);
465 : } else {
466 0 : return lisp_eval(rt, scope, body_false);
467 : }
468 : }
469 :
470 0 : static lisp_value *lisp_builtin_null_p(lisp_runtime *rt, lisp_scope *scope,
471 : lisp_value *a)
472 : {
473 : lisp_value *v;
474 0 : lisp_list *args = (lisp_list*) lisp_eval_list(rt, scope, a);
475 :
476 0 : if (!lisp_get_args(args, "*", &v)) {
477 0 : return (lisp_value*) lisp_error_new(rt, "expected one argument");
478 : }
479 :
480 0 : lisp_integer *result = (lisp_integer*) lisp_new(rt, type_integer);
481 0 : result->x = (int) lisp_nil_p(v);
482 0 : return (lisp_value*)result;
483 : }
484 :
485 0 : static lisp_list *get_quoted_left_items(lisp_runtime *rt, lisp_list *list_of_lists)
486 : {
487 0 : lisp_list *left_items = NULL, *rv;
488 0 : while (!lisp_nil_p((lisp_value*)list_of_lists)) {
489 : // Create or advance left_items to the next list.
490 0 : if (left_items == NULL) {
491 0 : left_items = (lisp_list*) lisp_new(rt, type_list);
492 0 : rv = left_items;
493 : } else {
494 0 : left_items->right = lisp_new(rt, type_list);
495 0 : left_items = (lisp_list*) left_items->right;
496 : }
497 : // Check the next node in the list to make sure it's actually a list.
498 0 : if (lisp_nil_p(list_of_lists->left)) {
499 0 : return NULL;
500 : }
501 : // Get the next node in the list and get the argument.
502 0 : lisp_list *l = (lisp_list*) list_of_lists->left;
503 0 : left_items->left = lisp_quote(rt, l->left);
504 0 : list_of_lists = (lisp_list*) list_of_lists->right;
505 : }
506 0 : left_items->right = lisp_nil_new(rt);
507 0 : return rv;
508 : }
509 :
510 0 : static lisp_list *advance_lists(lisp_runtime *rt, lisp_list *list_of_lists)
511 : {
512 0 : lisp_list *right_items = NULL, *rv;
513 0 : while (!lisp_nil_p((lisp_value*)list_of_lists)) {
514 : // Create or advance left_items to the next list.
515 0 : if (right_items == NULL) {
516 0 : right_items = (lisp_list*) lisp_new(rt, type_list);
517 0 : rv = right_items;
518 : } else {
519 0 : right_items->right = lisp_new(rt, type_list);
520 0 : right_items = (lisp_list*) right_items->right;
521 : }
522 : // Check the next node in the list to make sure it's actually a list.
523 0 : if (list_of_lists->left->type != type_list) {
524 0 : return NULL;
525 : }
526 : // Get the next node in the list and get the argument.
527 0 : lisp_list *l = (lisp_list*) list_of_lists->left;
528 0 : right_items->left = l->right;
529 0 : list_of_lists = (lisp_list*) list_of_lists->right;
530 : }
531 0 : right_items->right = lisp_nil_new(rt);
532 0 : return rv;
533 : }
534 :
535 0 : static lisp_value *lisp_builtin_map(lisp_runtime *rt, lisp_scope *scope,
536 : lisp_value *a)
537 : {
538 : lisp_value *f;
539 0 : lisp_list *ret = NULL, *args, *rv;
540 0 : lisp_list *map_args = (lisp_list *) lisp_eval_list(rt, scope, a);
541 :
542 : // Get the function from the first argument in the list.
543 0 : f = map_args->left;
544 0 : if (map_args->right->type != type_list) {
545 0 : return (lisp_value*) lisp_error_new(rt, "need at least two arguments");
546 : }
547 0 : map_args = (lisp_list*) map_args->right;
548 0 : while ((args = get_quoted_left_items(rt, map_args)) != NULL) {
549 0 : if (ret == NULL) {
550 0 : ret = (lisp_list*) lisp_new(rt, type_list);
551 0 : rv = ret;
552 : } else {
553 0 : ret->right = lisp_new(rt, type_list);
554 0 : ret = (lisp_list*) ret->right;
555 : }
556 0 : ret->left = lisp_call(rt, scope, f, (lisp_value*)args);
557 0 : map_args = advance_lists(rt, map_args);
558 : }
559 0 : ret->right = lisp_nil_new(rt);
560 0 : return (lisp_value*) rv;
561 : }
562 :
563 0 : static lisp_value *lisp_builtin_reduce(lisp_runtime *rt, lisp_scope *scope, lisp_value *a)
564 : {
565 0 : lisp_list *args = (lisp_list*) lisp_eval_list(rt, scope, a);
566 0 : int length = lisp_list_length(args);
567 : lisp_value *callable, *initializer;
568 : lisp_list *list;
569 :
570 0 : if (length == 2) {
571 0 : if (!lisp_get_args(args, "*l", &callable, &list)) {
572 0 : return (lisp_value*) lisp_error_new(rt, "reduce: callable and list required");
573 : }
574 0 : if (lisp_list_length(list) < 2) {
575 0 : return (lisp_value*) lisp_error_new(rt, "reduce: list must have at least 2 entries");
576 : }
577 0 : initializer = list->left;
578 0 : list = (lisp_list*)list->right;
579 0 : } else if (length == 3) {
580 0 : if (!lisp_get_args(args, "**l", &callable, &initializer, &list)) {
581 0 : return (lisp_value*) lisp_error_new(rt, "reduce: callable, initializer, and list required");
582 : }
583 0 : if (lisp_list_length(list) < 1) {
584 0 : return (lisp_value*) lisp_error_new(rt, "reduce: list must have at least 1 entry");
585 : }
586 : } else {
587 0 : return (lisp_value*) lisp_error_new(rt, "reduce: 2 or 3 arguments required");
588 : }
589 :
590 0 : while (!lisp_nil_p((lisp_value*)list)) {
591 0 : initializer = lisp_call(rt, scope, callable,
592 0 : (lisp_value*) lisp_new_pair_list(rt, initializer, list->left));
593 0 : list = (lisp_list*) list->right;
594 : }
595 0 : return initializer;
596 : }
597 :
598 0 : void lisp_scope_populate_builtins(lisp_runtime *rt, lisp_scope *scope)
599 : {
600 0 : lisp_scope_add_builtin(rt, scope, "eval", lisp_builtin_eval);
601 0 : lisp_scope_add_builtin(rt, scope, "car", lisp_builtin_car);
602 0 : lisp_scope_add_builtin(rt, scope, "cdr", lisp_builtin_cdr);
603 0 : lisp_scope_add_builtin(rt, scope, "quote", lisp_builtin_quote);
604 0 : lisp_scope_add_builtin(rt, scope, "cons", lisp_builtin_cons);
605 0 : lisp_scope_add_builtin(rt, scope, "lambda", lisp_builtin_lambda);
606 0 : lisp_scope_add_builtin(rt, scope, "define", lisp_builtin_define);
607 0 : lisp_scope_add_builtin(rt, scope, "+", lisp_builtin_plus);
608 0 : lisp_scope_add_builtin(rt, scope, "-", lisp_builtin_minus);
609 0 : lisp_scope_add_builtin(rt, scope, "*", lisp_builtin_multiply);
610 0 : lisp_scope_add_builtin(rt, scope, "/", lisp_builtin_divide);
611 0 : lisp_scope_add_builtin(rt, scope, "==", lisp_builtin_eq);
612 0 : lisp_scope_add_builtin(rt, scope, "=", lisp_builtin_eq);
613 0 : lisp_scope_add_builtin(rt, scope, ">", lisp_builtin_gt);
614 0 : lisp_scope_add_builtin(rt, scope, ">=", lisp_builtin_ge);
615 0 : lisp_scope_add_builtin(rt, scope, "<", lisp_builtin_lt);
616 0 : lisp_scope_add_builtin(rt, scope, "<=", lisp_builtin_le);
617 0 : lisp_scope_add_builtin(rt, scope, "if", lisp_builtin_if);
618 0 : lisp_scope_add_builtin(rt, scope, "null?", lisp_builtin_null_p);
619 0 : lisp_scope_add_builtin(rt, scope, "map", lisp_builtin_map);
620 0 : lisp_scope_add_builtin(rt, scope, "reduce", lisp_builtin_reduce);
621 0 : }
|
