aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBad Diode <bd@badd10de.dev>2021-10-13 18:49:04 +0200
committerBad Diode <bd@badd10de.dev>2021-10-13 18:49:04 +0200
commitb2426dc8cc473a4b796f0f96136b2f254c84913f (patch)
treea54b3065b79d2c3d8384dc132e3bf4bfb7ac0e3b
parente068d45199bb23452821727e5b82a2307ae0256d (diff)
downloadbdl-b2426dc8cc473a4b796f0f96136b2f254c84913f.tar.gz
bdl-b2426dc8cc473a4b796f0f96136b2f254c84913f.zip
Cleanup primitive proceduresv0.4
-rw-r--r--src/bootstrap/primitives.c409
1 files changed, 55 insertions, 354 deletions
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c
index 2a82782..39229ff 100644
--- a/src/bootstrap/primitives.c
+++ b/src/bootstrap/primitives.c
@@ -1,6 +1,8 @@
1Object * 1Object *
2eval(Environment* env, Object *root) { 2eval(Environment* env, Object *root) {
3 switch (root->type) { 3 switch (root->type) {
4 case OBJ_TYPE_ERR:
5 case OBJ_TYPE_PROCEDURE:
4 case OBJ_TYPE_FIXNUM: 6 case OBJ_TYPE_FIXNUM:
5 case OBJ_TYPE_BOOL: 7 case OBJ_TYPE_BOOL:
6 case OBJ_TYPE_NIL: 8 case OBJ_TYPE_NIL:
@@ -38,15 +40,8 @@ eval(Environment* env, Object *root) {
38 return obj_err; 40 return obj_err;
39 } 41 }
40 } break; 42 } break;
41 default: {
42 break;
43 } break;
44 } 43 }
45 44
46 printf("DING\n");
47 display(root);
48 printf("\nTYPE: %d\n", root->type);
49
50 error_push((Error){ 45 error_push((Error){
51 .type = ERR_TYPE_RUNTIME, 46 .type = ERR_TYPE_RUNTIME,
52 .value = ERR_UNKNOWN_OBJ_TYPE, 47 .value = ERR_UNKNOWN_OBJ_TYPE,
@@ -60,13 +55,8 @@ proc_quote(Environment *env, Object *obj) {
60 return obj->car; 55 return obj->car;
61} 56}
62 57
63// 58static inline Object *
64// Arithmetic procedures. 59extract_car_with_type(Environment *env, Object *obj, ObjectType expected_type) {
65//
66
67Object *
68proc_sum(Environment *env, Object *obj) {
69 // First argument.
70 if (obj == obj_nil) { 60 if (obj == obj_nil) {
71 error_push((Error){ 61 error_push((Error){
72 .type = ERR_TYPE_RUNTIME, 62 .type = ERR_TYPE_RUNTIME,
@@ -78,29 +68,27 @@ proc_sum(Environment *env, Object *obj) {
78 if (car == obj_err) { 68 if (car == obj_err) {
79 return obj_err; 69 return obj_err;
80 } 70 }
81 if (car->type != OBJ_TYPE_FIXNUM) { 71 if (car->type != expected_type) {
82 error_push((Error){ 72 error_push((Error){
83 .type = ERR_TYPE_RUNTIME, 73 .type = ERR_TYPE_RUNTIME,
84 .value = ERR_WRONG_ARG_TYPE, 74 .value = ERR_WRONG_ARG_TYPE,
85 }); 75 });
86 return obj_err; 76 return obj_err;
87 } 77 }
78 return car;
79}
88 80
89 // Traverse the list. 81//
82// Arithmetic procedures.
83//
84
85Object *
86proc_sum(Environment *env, Object *obj) {
87 Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
90 obj = obj->cdr; 88 obj = obj->cdr;
91 ssize_t tot = car->fixnum; 89 ssize_t tot = car->fixnum;
92 while (obj != obj_nil) { 90 while (obj != obj_nil) {
93 car = eval(env, obj->car); 91 car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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; 92 tot += car->fixnum;
105 obj = obj->cdr; 93 obj = obj->cdr;
106 } 94 }
@@ -109,41 +97,11 @@ proc_sum(Environment *env, Object *obj) {
109 97
110Object * 98Object *
111proc_sub(Environment *env, Object *obj) { 99proc_sub(Environment *env, Object *obj) {
112 // First argument. 100 Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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; 101 obj = obj->cdr;
134 ssize_t tot = car->fixnum; 102 ssize_t tot = car->fixnum;
135 while (obj != obj_nil) { 103 while (obj != obj_nil) {
136 car = eval(env, obj->car); 104 car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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; 105 tot -= car->fixnum;
148 obj = obj->cdr; 106 obj = obj->cdr;
149 } 107 }
@@ -152,41 +110,11 @@ proc_sub(Environment *env, Object *obj) {
152 110
153Object * 111Object *
154proc_mul(Environment *env, Object *obj) { 112proc_mul(Environment *env, Object *obj) {
155 // First argument. 113 Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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; 114 obj = obj->cdr;
177 ssize_t tot = car->fixnum; 115 ssize_t tot = car->fixnum;
178 while (obj != obj_nil) { 116 while (obj != obj_nil) {
179 Object *car = eval(env, obj->car); 117 car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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; 118 tot *= car->fixnum;
191 obj = obj->cdr; 119 obj = obj->cdr;
192 } 120 }
@@ -195,41 +123,11 @@ proc_mul(Environment *env, Object *obj) {
195 123
196Object * 124Object *
197proc_div(Environment *env, Object *obj) { 125proc_div(Environment *env, Object *obj) {
198 // First argument. 126 Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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; 127 obj = obj->cdr;
220 ssize_t tot = car->fixnum; 128 ssize_t tot = car->fixnum;
221 while (obj != obj_nil) { 129 while (obj != obj_nil) {
222 Object *car = eval(env, obj->car); 130 car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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) { 131 if (car->fixnum == 0) {
234 error_push((Error){ 132 error_push((Error){
235 .type = ERR_TYPE_RUNTIME, 133 .type = ERR_TYPE_RUNTIME,
@@ -245,41 +143,11 @@ proc_div(Environment *env, Object *obj) {
245 143
246Object * 144Object *
247proc_mod(Environment *env, Object *obj) { 145proc_mod(Environment *env, Object *obj) {
248 // First argument. 146 Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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; 147 obj = obj->cdr;
270 ssize_t tot = car->fixnum; 148 ssize_t tot = car->fixnum;
271 while (obj != obj_nil) { 149 while (obj != obj_nil) {
272 Object *car = eval(env, obj->car); 150 car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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) { 151 if (car->fixnum == 0) {
284 error_push((Error){ 152 error_push((Error){
285 .type = ERR_TYPE_RUNTIME, 153 .type = ERR_TYPE_RUNTIME,
@@ -305,25 +173,7 @@ proc_display(Environment *env, Object *obj) {
305 173
306Object * 174Object *
307proc_print(Environment *env, Object *obj) { 175proc_print(Environment *env, Object *obj) {
308 if (obj == obj_nil) { 176 Object *car = extract_car_with_type(env, obj, OBJ_TYPE_STRING);
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) { 177 StringView scanner = (StringView) {
328 .start = car->string, 178 .start = car->string,
329 .n = car->string_n, 179 .n = car->string_n,
@@ -522,17 +372,16 @@ proc_if(Environment *env, Object *obj) {
522 } 372 }
523 Object *car = obj->car; 373 Object *car = obj->car;
524 Object *cdr = obj->cdr; 374 Object *cdr = obj->cdr;
525 Object *clause = eval(env, car); 375 Object *condition = eval(env, car);
526 if (obj == obj_err) { 376 if (condition == obj_err) {
527 return obj_err; 377 return obj_err;
528 } 378 }
529 if (clause == obj_true) { 379 if (condition == obj_true) {
530 return eval(env, cdr->car); 380 return eval(env, cdr->car);
531 } 381 }
532 if (obj->cdr->cdr != obj_nil) { 382 if (cdr->cdr != obj_nil) {
533 return eval(env, cdr->cdr->car); 383 return eval(env, cdr->cdr->car);
534 } 384 }
535
536 return obj_nil; 385 return obj_nil;
537} 386}
538 387
@@ -545,24 +394,23 @@ proc_cond(Environment *env, Object *obj) {
545 }); 394 });
546 return obj_err; 395 return obj_err;
547 } 396 }
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) { 397 while (obj != obj_nil) {
559 Object *clause = obj->car; 398 Object *clause = obj->car;
560 Object *result = eval(env, clause->car); 399 if (clause->type != OBJ_TYPE_PAIR || clause->cdr == obj_nil) {
400 error_push((Error){
401 .type = ERR_TYPE_RUNTIME,
402 .value = ERR_WRONG_ARG_TYPE,
403 });
404 return obj_err;
405 }
406 Object *test = clause->car;
407 Object *value = clause->cdr->car;
408 Object *result = eval(env, test);
561 if (result == obj_err) { 409 if (result == obj_err) {
562 return obj_err; 410 return obj_err;
563 } 411 }
564 if (result == obj_true) { 412 if (result == obj_true) {
565 return eval(env, clause->cdr->car); 413 return eval(env, value);
566 } 414 }
567 obj = obj->cdr; 415 obj = obj->cdr;
568 } 416 }
@@ -571,41 +419,11 @@ proc_cond(Environment *env, Object *obj) {
571 419
572Object * 420Object *
573proc_num_less_than(Environment *env, Object *obj) { 421proc_num_less_than(Environment *env, Object *obj) {
574 // First argument. 422 Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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; 423 obj = obj->cdr;
596 ssize_t prev = car->fixnum; 424 ssize_t prev = car->fixnum;
597 while (obj != obj_nil) { 425 while (obj != obj_nil) {
598 car = eval(env, obj->car); 426 car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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) { 427 if (prev >= car->fixnum) {
610 return obj_false; 428 return obj_false;
611 } 429 }
@@ -617,41 +435,11 @@ proc_num_less_than(Environment *env, Object *obj) {
617 435
618Object * 436Object *
619proc_num_greater_than(Environment *env, Object *obj) { 437proc_num_greater_than(Environment *env, Object *obj) {
620 // First argument. 438 Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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; 439 obj = obj->cdr;
642 ssize_t prev = car->fixnum; 440 ssize_t prev = car->fixnum;
643 while (obj != obj_nil) { 441 while (obj != obj_nil) {
644 car = eval(env, obj->car); 442 car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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) { 443 if (prev <= car->fixnum) {
656 return obj_false; 444 return obj_false;
657 } 445 }
@@ -663,41 +451,11 @@ proc_num_greater_than(Environment *env, Object *obj) {
663 451
664Object * 452Object *
665proc_num_lesseq_than(Environment *env, Object *obj) { 453proc_num_lesseq_than(Environment *env, Object *obj) {
666 // First argument. 454 Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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; 455 obj = obj->cdr;
688 ssize_t prev = car->fixnum; 456 ssize_t prev = car->fixnum;
689 while (obj != obj_nil) { 457 while (obj != obj_nil) {
690 car = eval(env, obj->car); 458 car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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) { 459 if (prev > car->fixnum) {
702 return obj_false; 460 return obj_false;
703 } 461 }
@@ -709,41 +467,11 @@ proc_num_lesseq_than(Environment *env, Object *obj) {
709 467
710Object * 468Object *
711proc_num_greatereq_than(Environment *env, Object *obj) { 469proc_num_greatereq_than(Environment *env, Object *obj) {
712 // First argument. 470 Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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; 471 obj = obj->cdr;
734 ssize_t prev = car->fixnum; 472 ssize_t prev = car->fixnum;
735 while (obj != obj_nil) { 473 while (obj != obj_nil) {
736 car = eval(env, obj->car); 474 car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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) { 475 if (prev < car->fixnum) {
748 return obj_false; 476 return obj_false;
749 } 477 }
@@ -755,41 +483,11 @@ proc_num_greatereq_than(Environment *env, Object *obj) {
755 483
756Object * 484Object *
757proc_num_equal(Environment *env, Object *obj) { 485proc_num_equal(Environment *env, Object *obj) {
758 // First argument. 486 Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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; 487 obj = obj->cdr;
780 ssize_t prev = car->fixnum; 488 ssize_t prev = car->fixnum;
781 while (obj != obj_nil) { 489 while (obj != obj_nil) {
782 car = eval(env, obj->car); 490 car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
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) { 491 if (prev != car->fixnum) {
794 return obj_false; 492 return obj_false;
795 } 493 }
@@ -851,9 +549,12 @@ proc_cdr(Environment *env, Object *obj) {
851 549
852Object * 550Object *
853proc_cons(Environment *env, Object *obj) { 551proc_cons(Environment *env, Object *obj) {
854 if (obj == obj_nil || obj->cdr == obj_nil) { 552 if (obj == obj_nil) {
855 fprintf(stderr, "error: not enough arguments\n"); 553 error_push((Error){
856 return obj_nil; 554 .type = ERR_TYPE_RUNTIME,
555 .value = ERR_NOT_ENOUGH_ARGS,
556 });
557 return obj_err;
857 } 558 }
858 Object *a = eval(env, obj->car); 559 Object *a = eval(env, obj->car);
859 Object *b = eval(env, obj->cdr->car); 560 Object *b = eval(env, obj->cdr->car);