diff options
Diffstat (limited to 'src/bootstrap/primitives.c')
-rw-r--r-- | src/bootstrap/primitives.c | 84 |
1 files changed, 33 insertions, 51 deletions
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index 0403e3a..ab147d4 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c | |||
@@ -1,6 +1,5 @@ | |||
1 | #define DEBUG_OBJ(MSG,OBJ) printf((MSG)); display(OBJ); printf("\n"); | 1 | #define DEBUG_OBJ(MSG,OBJ) printf((MSG)); display(OBJ); printf("\n"); |
2 | 2 | static Object *proc_if; | |
3 | Object * proc_if(Environment *env, Object *obj); | ||
4 | 3 | ||
5 | Object * | 4 | Object * |
6 | eval(Environment *env, Object *root) { | 5 | eval(Environment *env, Object *root) { |
@@ -41,32 +40,34 @@ eval_start: | |||
41 | }); | 40 | }); |
42 | return obj_err; | 41 | return obj_err; |
43 | } | 42 | } |
44 | if (val->type == OBJ_TYPE_PROCEDURE) { | 43 | |
45 | // TODO: This is very messy, needs refactoring. | 44 | // Primitive `if` procedure with TCO. |
46 | if (val->proc == proc_if) { | 45 | if (val == proc_if) { |
47 | Object *obj = root->cdr; | 46 | Object *obj = root->cdr; |
48 | if (obj == obj_nil || obj->cdr == obj_nil) { | 47 | if (obj == obj_nil || obj->cdr == obj_nil) { |
49 | error_push((Error){ | 48 | error_push((Error){ |
50 | .type = ERR_TYPE_RUNTIME, | 49 | .type = ERR_TYPE_RUNTIME, |
51 | .value = ERR_NOT_ENOUGH_ARGS, | 50 | .value = ERR_NOT_ENOUGH_ARGS, |
52 | }); | 51 | }); |
53 | return obj_err; | 52 | return obj_err; |
54 | } | ||
55 | Object *car = obj->car; | ||
56 | Object *cdr = obj->cdr; | ||
57 | Object *condition = eval(env, car); | ||
58 | if (condition == obj_err) { | ||
59 | return obj_err; | ||
60 | } | ||
61 | if (condition == obj_true) { | ||
62 | root = cdr->car; | ||
63 | } else if (cdr->cdr != obj_nil) { | ||
64 | root = cdr->cdr->car; | ||
65 | } else { | ||
66 | return obj_nil; | ||
67 | } | ||
68 | goto eval_start; | ||
69 | } | 53 | } |
54 | Object *car = obj->car; | ||
55 | Object *cdr = obj->cdr; | ||
56 | Object *condition = eval(env, car); | ||
57 | if (condition == obj_err) { | ||
58 | return obj_err; | ||
59 | } | ||
60 | if (condition == obj_true) { | ||
61 | root = cdr->car; | ||
62 | } else if (cdr->cdr != obj_nil) { | ||
63 | root = cdr->cdr->car; | ||
64 | } else { | ||
65 | return obj_nil; | ||
66 | } | ||
67 | goto eval_start; | ||
68 | } | ||
69 | |||
70 | if (val->type == OBJ_TYPE_PROCEDURE) { | ||
70 | ret = val->proc(env, root->cdr); | 71 | ret = val->proc(env, root->cdr); |
71 | goto eval_success; | 72 | goto eval_success; |
72 | } | 73 | } |
@@ -138,6 +139,11 @@ eval_lambda: | |||
138 | root = root->car; | 139 | root = root->car; |
139 | goto eval_start; | 140 | goto eval_start; |
140 | } | 141 | } |
142 | error_push((Error){ | ||
143 | .type = ERR_TYPE_RUNTIME, | ||
144 | .value = ERR_OBJ_NOT_CALLABLE, | ||
145 | }); | ||
146 | return obj_err; | ||
141 | } break; | 147 | } break; |
142 | } | 148 | } |
143 | 149 | ||
@@ -483,30 +489,6 @@ proc_or(Environment *env, Object *obj) { | |||
483 | } | 489 | } |
484 | 490 | ||
485 | Object * | 491 | Object * |
486 | proc_if(Environment *env, Object *obj) { | ||
487 | if (obj == obj_nil || obj->cdr == obj_nil) { | ||
488 | error_push((Error){ | ||
489 | .type = ERR_TYPE_RUNTIME, | ||
490 | .value = ERR_NOT_ENOUGH_ARGS, | ||
491 | }); | ||
492 | return obj_err; | ||
493 | } | ||
494 | Object *car = obj->car; | ||
495 | Object *cdr = obj->cdr; | ||
496 | Object *condition = eval(env, car); | ||
497 | if (condition == obj_err) { | ||
498 | return obj_err; | ||
499 | } | ||
500 | if (condition == obj_true) { | ||
501 | return eval(env, cdr->car); | ||
502 | } | ||
503 | if (cdr->cdr != obj_nil) { | ||
504 | return eval(env, cdr->cdr->car); | ||
505 | } | ||
506 | return obj_nil; | ||
507 | } | ||
508 | |||
509 | Object * | ||
510 | proc_cond(Environment *env, Object *obj) { | 492 | proc_cond(Environment *env, Object *obj) { |
511 | if (obj == obj_nil) { | 493 | if (obj == obj_nil) { |
512 | error_push((Error){ | 494 | error_push((Error){ |