aboutsummaryrefslogtreecommitdiffstats
path: root/src/bootstrap/primitives.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/bootstrap/primitives.c')
-rw-r--r--src/bootstrap/primitives.c900
1 files changed, 900 insertions, 0 deletions
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c
new file mode 100644
index 0000000..8369fa8
--- /dev/null
+++ b/src/bootstrap/primitives.c
@@ -0,0 +1,900 @@
1Object *
2eval(Environment* env, Object *root) {
3 switch (root->type) {
4 case OBJ_TYPE_FIXNUM:
5 case OBJ_TYPE_BOOL:
6 case OBJ_TYPE_NIL:
7 case OBJ_TYPE_STRING: {
8 return root;
9 } break;
10 case OBJ_TYPE_SYMBOL: {
11 Object *val = env_lookup(env, root);
12 if (val == obj_err) {
13 error_push((Error){
14 .type = ERR_TYPE_RUNTIME,
15 .value = ERR_SYMBOL_NOT_FOUND,
16 });
17 return obj_err;
18 }
19 return val;
20 } break;
21 case OBJ_TYPE_PAIR: {
22 if (root->car->type == OBJ_TYPE_SYMBOL) {
23 Object *val = env_lookup(env, root->car);
24 if (val == obj_err) {
25 error_push((Error){
26 .type = ERR_TYPE_RUNTIME,
27 .value = ERR_SYMBOL_NOT_FOUND,
28 });
29 return obj_err;
30 }
31 if (val->type == OBJ_TYPE_PROCEDURE) {
32 return val->proc(env, root->cdr);
33 }
34 error_push((Error){
35 .type = ERR_TYPE_RUNTIME,
36 .value = ERR_OBJ_NOT_CALLABLE,
37 });
38 return obj_err;
39 }
40 } break;
41 default: {
42 break;
43 } break;
44 }
45
46 printf("DING\n");
47 display(root);
48 printf("\nTYPE: %d\n", root->type);
49
50 error_push((Error){
51 .type = ERR_TYPE_RUNTIME,
52 .value = ERR_UNKNOWN_OBJ_TYPE,
53 });
54 return obj_err;
55}
56
57Object *
58proc_quote(Environment *env, Object *obj) {
59 (void)env;
60 return obj->car;
61}
62
63//
64// Arithmetic procedures.
65//
66
67Object *
68proc_sum(Environment *env, Object *obj) {
69 // First argument.
70 if (obj == obj_nil) {
71 error_push((Error){
72 .type = ERR_TYPE_RUNTIME,
73 .value = ERR_NOT_ENOUGH_ARGS,
74 });
75 return obj_err;
76 }
77 Object *car = eval(env, obj->car);
78 if (car == obj_err) {
79 return obj_err;
80 }
81 if (car->type != OBJ_TYPE_FIXNUM) {
82 error_push((Error){
83 .type = ERR_TYPE_RUNTIME,
84 .value = ERR_WRONG_ARG_TYPE,
85 });
86 return obj_err;
87 }
88
89 // Traverse the list.
90 obj = obj->cdr;
91 ssize_t tot = car->fixnum;
92 while (obj != obj_nil) {
93 car = eval(env, obj->car);
94 if (car == obj_err) {
95 return obj_err;
96 }
97 if (car->type != OBJ_TYPE_FIXNUM) {
98 error_push((Error){
99 .type = ERR_TYPE_RUNTIME,
100 .value = ERR_WRONG_ARG_TYPE,
101 });
102 return obj_err;
103 }
104 tot += car->fixnum;
105 obj = obj->cdr;
106 }
107 return make_fixnum(tot);
108}
109
110Object *
111proc_sub(Environment *env, Object *obj) {
112 // First argument.
113 if (obj == obj_nil) {
114 error_push((Error){
115 .type = ERR_TYPE_RUNTIME,
116 .value = ERR_NOT_ENOUGH_ARGS,
117 });
118 return obj_err;
119 }
120 Object *car = eval(env, obj->car);
121 if (car == obj_err) {
122 return obj_err;
123 }
124 if (car->type != OBJ_TYPE_FIXNUM) {
125 error_push((Error){
126 .type = ERR_TYPE_RUNTIME,
127 .value = ERR_WRONG_ARG_TYPE,
128 });
129 return obj_err;
130 }
131
132 // Traverse the list.
133 obj = obj->cdr;
134 ssize_t tot = car->fixnum;
135 while (obj != obj_nil) {
136 car = eval(env, obj->car);
137 if (car == obj_err) {
138 return obj_err;
139 }
140 if (car->type != OBJ_TYPE_FIXNUM) {
141 error_push((Error){
142 .type = ERR_TYPE_RUNTIME,
143 .value = ERR_WRONG_ARG_TYPE,
144 });
145 return obj_err;
146 }
147 tot -= car->fixnum;
148 obj = obj->cdr;
149 }
150 return make_fixnum(tot);
151}
152
153Object *
154proc_mul(Environment *env, Object *obj) {
155 // First argument.
156 if (obj == obj_nil) {
157 error_push((Error){
158 .type = ERR_TYPE_RUNTIME,
159 .value = ERR_NOT_ENOUGH_ARGS,
160 });
161 return obj_err;
162 }
163 Object *car = eval(env, obj->car);
164 if (car == obj_err) {
165 return obj_err;
166 }
167 if (car->type != OBJ_TYPE_FIXNUM) {
168 error_push((Error){
169 .type = ERR_TYPE_RUNTIME,
170 .value = ERR_WRONG_ARG_TYPE,
171 });
172 return obj_err;
173 }
174
175 // Traverse the list.
176 obj = obj->cdr;
177 ssize_t tot = car->fixnum;
178 while (obj != obj_nil) {
179 Object *car = eval(env, obj->car);
180 if (car == obj_err) {
181 return obj_err;
182 }
183 if (car->type != OBJ_TYPE_FIXNUM) {
184 error_push((Error){
185 .type = ERR_TYPE_RUNTIME,
186 .value = ERR_WRONG_ARG_TYPE,
187 });
188 return obj_err;
189 }
190 tot *= car->fixnum;
191 obj = obj->cdr;
192 }
193 return make_fixnum(tot);
194}
195
196Object *
197proc_div(Environment *env, Object *obj) {
198 // First argument.
199 if (obj == obj_nil) {
200 error_push((Error){
201 .type = ERR_TYPE_RUNTIME,
202 .value = ERR_NOT_ENOUGH_ARGS,
203 });
204 return obj_err;
205 }
206 Object *car = eval(env, obj->car);
207 if (car == obj_err) {
208 return obj_err;
209 }
210 if (car->type != OBJ_TYPE_FIXNUM) {
211 error_push((Error){
212 .type = ERR_TYPE_RUNTIME,
213 .value = ERR_WRONG_ARG_TYPE,
214 });
215 return obj_err;
216 }
217
218 // Traverse the list.
219 obj = obj->cdr;
220 ssize_t tot = car->fixnum;
221 while (obj != obj_nil) {
222 Object *car = eval(env, obj->car);
223 if (car == obj_err) {
224 return obj_err;
225 }
226 if (car->type != OBJ_TYPE_FIXNUM) {
227 error_push((Error){
228 .type = ERR_TYPE_RUNTIME,
229 .value = ERR_WRONG_ARG_TYPE,
230 });
231 return obj_err;
232 }
233 if (car->fixnum == 0) {
234 error_push((Error){
235 .type = ERR_TYPE_RUNTIME,
236 .value = ERR_DIVISION_BY_ZERO,
237 });
238 return obj_err;
239 }
240 tot /= car->fixnum;
241 obj = obj->cdr;
242 }
243 return make_fixnum(tot);
244}
245
246Object *
247proc_mod(Environment *env, Object *obj) {
248 // First argument.
249 if (obj == obj_nil) {
250 error_push((Error){
251 .type = ERR_TYPE_RUNTIME,
252 .value = ERR_NOT_ENOUGH_ARGS,
253 });
254 return obj_err;
255 }
256 Object *car = eval(env, obj->car);
257 if (car == obj_err) {
258 return obj_err;
259 }
260 if (car->type != OBJ_TYPE_FIXNUM) {
261 error_push((Error){
262 .type = ERR_TYPE_RUNTIME,
263 .value = ERR_WRONG_ARG_TYPE,
264 });
265 return obj_err;
266 }
267
268 // Traverse the list.
269 obj = obj->cdr;
270 ssize_t tot = car->fixnum;
271 while (obj != obj_nil) {
272 Object *car = eval(env, obj->car);
273 if (car == obj_err) {
274 return obj_err;
275 }
276 if (car->type != OBJ_TYPE_FIXNUM) {
277 error_push((Error){
278 .type = ERR_TYPE_RUNTIME,
279 .value = ERR_WRONG_ARG_TYPE,
280 });
281 return obj_err;
282 }
283 if (car->fixnum == 0) {
284 error_push((Error){
285 .type = ERR_TYPE_RUNTIME,
286 .value = ERR_DIVISION_BY_ZERO,
287 });
288 return obj_err;
289 }
290 tot %= car->fixnum;
291 obj = obj->cdr;
292 }
293 return make_fixnum(tot);
294}
295
296//
297// Display/Evaluation procedues.
298//
299
300Object *
301proc_display(Environment *env, Object *obj) {
302 display(eval(env, obj->car));
303 return obj_nil;
304}
305
306Object *
307proc_print(Environment *env, Object *obj) {
308 if (obj == obj_nil) {
309 error_push((Error){
310 .type = ERR_TYPE_RUNTIME,
311 .value = ERR_NOT_ENOUGH_ARGS,
312 });
313 return obj_err;
314 }
315 Object *car = eval(env, obj->car);
316 if (car == obj_err) {
317 return obj_err;
318 }
319 if (car->type != OBJ_TYPE_STRING) {
320 error_push((Error){
321 .type = ERR_TYPE_RUNTIME,
322 .value = ERR_WRONG_ARG_TYPE,
323 });
324 return obj_err;
325 }
326
327 StringView scanner = (StringView) {
328 .start = car->string,
329 .n = car->string_n,
330 };
331 while (scanner.n != 0) {
332 char c = sv_next(&scanner);
333 if (c == '\\' && sv_peek(&scanner) == 'n') {
334 putchar('\n');
335 sv_next(&scanner);
336 continue;
337 }
338 if (c == '\\' && sv_peek(&scanner) == '"') {
339 putchar('"');
340 sv_next(&scanner);
341 continue;
342 }
343 putchar(c);
344 }
345 return obj_nil;
346}
347
348Object *
349proc_newline(Environment *env, Object *obj) {
350 printf("\n");
351 (void)env;
352 (void)obj;
353 return obj_nil;
354}
355
356//
357// Type info procedures.
358//
359
360Object *
361proc_is_boolean(Environment *env, Object *obj) {
362 if (obj == obj_nil) {
363 error_push((Error){
364 .type = ERR_TYPE_RUNTIME,
365 .value = ERR_NOT_ENOUGH_ARGS,
366 });
367 return obj_err;
368 }
369 obj = eval(env, obj->car);
370 if (obj == obj_err) {
371 return obj_err;
372 }
373 return (obj == obj_true || obj == obj_false) ? obj_true : obj_false;
374}
375
376Object *
377proc_is_nil(Environment *env, Object *obj) {
378 if (obj == obj_nil) {
379 error_push((Error){
380 .type = ERR_TYPE_RUNTIME,
381 .value = ERR_NOT_ENOUGH_ARGS,
382 });
383 return obj_err;
384 }
385 obj = eval(env, obj->car);
386 if (obj == obj_err) {
387 return obj_err;
388 }
389 return obj == obj_nil ? obj_true : obj_false;
390}
391
392Object *
393proc_is_symbol(Environment *env, Object *obj) {
394 if (obj == obj_nil) {
395 error_push((Error){
396 .type = ERR_TYPE_RUNTIME,
397 .value = ERR_NOT_ENOUGH_ARGS,
398 });
399 return obj_err;
400 }
401 obj = eval(env, obj->car);
402 if (obj == obj_err) {
403 return obj_err;
404 }
405 return obj->type == OBJ_TYPE_SYMBOL ? obj_true : obj_false;
406}
407
408Object *
409proc_is_string(Environment *env, Object *obj) {
410 if (obj == obj_nil) {
411 error_push((Error){
412 .type = ERR_TYPE_RUNTIME,
413 .value = ERR_NOT_ENOUGH_ARGS,
414 });
415 return obj_err;
416 }
417 obj = eval(env, obj->car);
418 if (obj == obj_err) {
419 return obj_err;
420 }
421 return obj->type == OBJ_TYPE_STRING ? obj_true : obj_false;
422}
423
424Object *
425proc_is_fixnum(Environment *env, Object *obj) {
426 if (obj == obj_nil) {
427 error_push((Error){
428 .type = ERR_TYPE_RUNTIME,
429 .value = ERR_NOT_ENOUGH_ARGS,
430 });
431 return obj_err;
432 }
433 obj = eval(env, obj->car);
434 if (obj == obj_err) {
435 return obj_err;
436 }
437 return obj->type == OBJ_TYPE_FIXNUM ? obj_true : obj_false;
438}
439
440Object *
441proc_is_pair(Environment *env, Object *obj) {
442 if (obj == obj_nil) {
443 error_push((Error){
444 .type = ERR_TYPE_RUNTIME,
445 .value = ERR_NOT_ENOUGH_ARGS,
446 });
447 return obj_err;
448 }
449 obj = eval(env, obj->car);
450 if (obj == obj_err) {
451 return obj_err;
452 }
453 return obj->type == OBJ_TYPE_PAIR ? obj_true : obj_false;
454}
455
456Object *
457proc_is_procedure(Environment *env, Object *obj) {
458 if (obj == obj_nil) {
459 error_push((Error){
460 .type = ERR_TYPE_RUNTIME,
461 .value = ERR_NOT_ENOUGH_ARGS,
462 });
463 return obj_err;
464 }
465 obj = eval(env, obj->car);
466 if (obj == obj_err) {
467 return obj_err;
468 }
469 return obj->type == OBJ_TYPE_PROCEDURE ? obj_true : obj_false;
470}
471
472//
473// Boolean/conditional procedures.
474//
475
476Object *
477proc_not(Environment *env, Object *obj) {
478 if (obj == obj_nil) {
479 error_push((Error){
480 .type = ERR_TYPE_RUNTIME,
481 .value = ERR_NOT_ENOUGH_ARGS,
482 });
483 return obj_err;
484 }
485 obj = eval(env, obj->car);
486 if (obj == obj_err) {
487 return obj_err;
488 }
489 return obj == obj_false ? obj_true : obj_false;
490}
491
492Object *
493proc_and(Environment *env, Object *obj) {
494 while (obj != obj_nil) {
495 if (proc_not(env, obj) == obj_true) {
496 return obj_false;
497 }
498 obj = obj->cdr;
499 }
500 return obj_true;
501}
502
503Object *
504proc_or(Environment *env, Object *obj) {
505 while (obj != obj_nil) {
506 if (proc_not(env, obj) == obj_false) {
507 return obj_true;
508 }
509 obj = obj->cdr;
510 }
511 return obj_false;
512}
513
514Object *
515proc_if(Environment *env, Object *obj) {
516 if (obj == obj_nil || obj->cdr == obj_nil) {
517 error_push((Error){
518 .type = ERR_TYPE_RUNTIME,
519 .value = ERR_NOT_ENOUGH_ARGS,
520 });
521 return obj_err;
522 }
523 Object *car = obj->car;
524 Object *cdr = obj->cdr;
525 Object *clause = eval(env, car);
526 if (obj == obj_err) {
527 return obj_err;
528 }
529 if (clause == obj_true) {
530 return eval(env, cdr->car);
531 }
532 if (obj->cdr->cdr != obj_nil) {
533 return eval(env, cdr->cdr->car);
534 }
535
536 return obj_nil;
537}
538
539Object *
540proc_cond(Environment *env, Object *obj) {
541 if (obj == obj_nil) {
542 error_push((Error){
543 .type = ERR_TYPE_RUNTIME,
544 .value = ERR_NOT_ENOUGH_ARGS,
545 });
546 return obj_err;
547 }
548
549 if (obj->car->type != OBJ_TYPE_PAIR) {
550 error_push((Error){
551 .type = ERR_TYPE_RUNTIME,
552 .value = ERR_WRONG_ARG_TYPE,
553 });
554 return obj_err;
555 }
556
557 // TODO: review this, the cdr->car could cause issues?
558 while (obj != obj_nil) {
559 Object *clause = obj->car;
560 Object *result = eval(env, clause->car);
561 if (result == obj_err) {
562 return obj_err;
563 }
564 if (result == obj_true) {
565 return eval(env, clause->cdr->car);
566 }
567 obj = obj->cdr;
568 }
569 return obj_nil;
570}
571
572Object *
573proc_num_less_than(Environment *env, Object *obj) {
574 // First argument.
575 if (obj == obj_nil) {
576 error_push((Error){
577 .type = ERR_TYPE_RUNTIME,
578 .value = ERR_NOT_ENOUGH_ARGS,
579 });
580 return obj_err;
581 }
582 Object *car = eval(env, obj->car);
583 if (car == obj_err) {
584 return obj_err;
585 }
586 if (car->type != OBJ_TYPE_FIXNUM) {
587 error_push((Error){
588 .type = ERR_TYPE_RUNTIME,
589 .value = ERR_WRONG_ARG_TYPE,
590 });
591 return obj_err;
592 }
593
594 // Traverse the list.
595 obj = obj->cdr;
596 ssize_t prev = car->fixnum;
597 while (obj != obj_nil) {
598 car = eval(env, obj->car);
599 if (car == obj_err) {
600 return obj_err;
601 }
602 if (car->type != OBJ_TYPE_FIXNUM) {
603 error_push((Error){
604 .type = ERR_TYPE_RUNTIME,
605 .value = ERR_WRONG_ARG_TYPE,
606 });
607 return obj_err;
608 }
609 if (prev >= car->fixnum) {
610 return obj_false;
611 }
612 prev = car->fixnum;
613 obj = obj->cdr;
614 }
615 return obj_true;
616}
617
618Object *
619proc_num_greater_than(Environment *env, Object *obj) {
620 // First argument.
621 if (obj == obj_nil) {
622 error_push((Error){
623 .type = ERR_TYPE_RUNTIME,
624 .value = ERR_NOT_ENOUGH_ARGS,
625 });
626 return obj_err;
627 }
628 Object *car = eval(env, obj->car);
629 if (car == obj_err) {
630 return obj_err;
631 }
632 if (car->type != OBJ_TYPE_FIXNUM) {
633 error_push((Error){
634 .type = ERR_TYPE_RUNTIME,
635 .value = ERR_WRONG_ARG_TYPE,
636 });
637 return obj_err;
638 }
639
640 // Traverse the list.
641 obj = obj->cdr;
642 ssize_t prev = car->fixnum;
643 while (obj != obj_nil) {
644 car = eval(env, obj->car);
645 if (car == obj_err) {
646 return obj_err;
647 }
648 if (car->type != OBJ_TYPE_FIXNUM) {
649 error_push((Error){
650 .type = ERR_TYPE_RUNTIME,
651 .value = ERR_WRONG_ARG_TYPE,
652 });
653 return obj_err;
654 }
655 if (prev <= car->fixnum) {
656 return obj_false;
657 }
658 prev = car->fixnum;
659 obj = obj->cdr;
660 }
661 return obj_true;
662}
663
664Object *
665proc_num_lesseq_than(Environment *env, Object *obj) {
666 // First argument.
667 if (obj == obj_nil) {
668 error_push((Error){
669 .type = ERR_TYPE_RUNTIME,
670 .value = ERR_NOT_ENOUGH_ARGS,
671 });
672 return obj_err;
673 }
674 Object *car = eval(env, obj->car);
675 if (car == obj_err) {
676 return obj_err;
677 }
678 if (car->type != OBJ_TYPE_FIXNUM) {
679 error_push((Error){
680 .type = ERR_TYPE_RUNTIME,
681 .value = ERR_WRONG_ARG_TYPE,
682 });
683 return obj_err;
684 }
685
686 // Traverse the list.
687 obj = obj->cdr;
688 ssize_t prev = car->fixnum;
689 while (obj != obj_nil) {
690 car = eval(env, obj->car);
691 if (car == obj_err) {
692 return obj_err;
693 }
694 if (car->type != OBJ_TYPE_FIXNUM) {
695 error_push((Error){
696 .type = ERR_TYPE_RUNTIME,
697 .value = ERR_WRONG_ARG_TYPE,
698 });
699 return obj_err;
700 }
701 if (prev > car->fixnum) {
702 return obj_false;
703 }
704 prev = car->fixnum;
705 obj = obj->cdr;
706 }
707 return obj_true;
708}
709
710Object *
711proc_num_greatereq_than(Environment *env, Object *obj) {
712 // First argument.
713 if (obj == obj_nil) {
714 error_push((Error){
715 .type = ERR_TYPE_RUNTIME,
716 .value = ERR_NOT_ENOUGH_ARGS,
717 });
718 return obj_err;
719 }
720 Object *car = eval(env, obj->car);
721 if (car == obj_err) {
722 return obj_err;
723 }
724 if (car->type != OBJ_TYPE_FIXNUM) {
725 error_push((Error){
726 .type = ERR_TYPE_RUNTIME,
727 .value = ERR_WRONG_ARG_TYPE,
728 });
729 return obj_err;
730 }
731
732 // Traverse the list.
733 obj = obj->cdr;
734 ssize_t prev = car->fixnum;
735 while (obj != obj_nil) {
736 car = eval(env, obj->car);
737 if (car == obj_err) {
738 return obj_err;
739 }
740 if (car->type != OBJ_TYPE_FIXNUM) {
741 error_push((Error){
742 .type = ERR_TYPE_RUNTIME,
743 .value = ERR_WRONG_ARG_TYPE,
744 });
745 return obj_err;
746 }
747 if (prev < car->fixnum) {
748 return obj_false;
749 }
750 prev = car->fixnum;
751 obj = obj->cdr;
752 }
753 return obj_true;
754}
755
756Object *
757proc_num_equal(Environment *env, Object *obj) {
758 // First argument.
759 if (obj == obj_nil) {
760 error_push((Error){
761 .type = ERR_TYPE_RUNTIME,
762 .value = ERR_NOT_ENOUGH_ARGS,
763 });
764 return obj_err;
765 }
766 Object *car = eval(env, obj->car);
767 if (car == obj_err) {
768 return obj_err;
769 }
770 if (car->type != OBJ_TYPE_FIXNUM) {
771 error_push((Error){
772 .type = ERR_TYPE_RUNTIME,
773 .value = ERR_WRONG_ARG_TYPE,
774 });
775 return obj_err;
776 }
777
778 // Traverse the list.
779 obj = obj->cdr;
780 ssize_t prev = car->fixnum;
781 while (obj != obj_nil) {
782 car = eval(env, obj->car);
783 if (car == obj_err) {
784 return obj_err;
785 }
786 if (car->type != OBJ_TYPE_FIXNUM) {
787 error_push((Error){
788 .type = ERR_TYPE_RUNTIME,
789 .value = ERR_WRONG_ARG_TYPE,
790 });
791 return obj_err;
792 }
793 if (prev != car->fixnum) {
794 return obj_false;
795 }
796 prev = car->fixnum;
797 obj = obj->cdr;
798 }
799 return obj_true;
800}
801
802//
803// List operation procedures.
804//
805
806Object *
807proc_car(Environment *env, Object *obj) {
808 if (obj == obj_nil) {
809 error_push((Error){
810 .type = ERR_TYPE_RUNTIME,
811 .value = ERR_NOT_ENOUGH_ARGS,
812 });
813 return obj_err;
814 }
815 obj = eval(env, obj->car);
816 if (obj == obj_err) {
817 return obj_err;
818 }
819 if (obj->type != OBJ_TYPE_PAIR) {
820 error_push((Error){
821 .type = ERR_TYPE_RUNTIME,
822 .value = ERR_WRONG_ARG_TYPE,
823 });
824 return obj_err;
825 }
826 return obj->car;
827}
828
829Object *
830proc_cdr(Environment *env, Object *obj) {
831 if (obj == obj_nil) {
832 error_push((Error){
833 .type = ERR_TYPE_RUNTIME,
834 .value = ERR_NOT_ENOUGH_ARGS,
835 });
836 return obj_err;
837 }
838 obj = eval(env, obj->car);
839 if (obj == obj_err) {
840 return obj_err;
841 }
842 if (obj->type != OBJ_TYPE_PAIR) {
843 error_push((Error){
844 .type = ERR_TYPE_RUNTIME,
845 .value = ERR_WRONG_ARG_TYPE,
846 });
847 return obj_err;
848 }
849 return obj->cdr;
850}
851
852Object *
853proc_cons(Environment *env, Object *obj) {
854 if (obj == obj_nil || obj->cdr == obj_nil) {
855 fprintf(stderr, "error: not enough arguments\n");
856 return obj_nil;
857 }
858 Object *a = eval(env, obj->car);
859 Object *b = eval(env, obj->cdr->car);
860 return make_pair(a, b);
861}
862
863Object *
864proc_list(Environment *env, Object *obj) {
865 if (obj == obj_nil) {
866 return obj_nil;
867 }
868 Object *head = make_pair(eval(env, obj->car), obj_nil);
869 Object *curr = head;
870 obj = obj->cdr;
871 while (obj != obj_nil) {
872 curr->cdr = make_pair(eval(env, obj->car), obj_nil);
873 curr = curr->cdr;
874 obj = obj->cdr;
875 }
876 return head;
877}
878
879//
880// Polymorphic procedures.
881//
882
883//Object *
884//proc_equal(Object *args) {
885// // TODO: stub
886// (void) args;
887// return NULL;
888//}
889
890//// TODO: fixnum left/right shift, mask, invert
891//// TODO: implement and test missing procedures
892//// TODO: add primitives for type transforms: string->symbol, symbol->string, etc
893//// TODO: properly implement nested environments
894//// TODO: implement support for quotes and semi-quotes
895//// TODO: LAMBDA
896//// TODO: let
897//// TODO: better error handling?
898//// TODO: Revise all instances where we are returning an object, since currently
899//// we may be returning a pointer to an object instead of a new one. Check also
900//// on eval function and everytime we do make_xxx(obj).