diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/bootstrap/gc.c | 2 | ||||
-rwxr-xr-x | src/bootstrap/main.c | 4 | ||||
-rw-r--r-- | src/bootstrap/primitives.c | 84 |
3 files changed, 37 insertions, 53 deletions
diff --git a/src/bootstrap/gc.c b/src/bootstrap/gc.c index 5f023bc..11a1f5a 100644 --- a/src/bootstrap/gc.c +++ b/src/bootstrap/gc.c | |||
@@ -270,7 +270,7 @@ alloc_object(ObjectType type) { | |||
270 | // references! Should we work with offsets all the way? That is for | 270 | // references! Should we work with offsets all the way? That is for |
271 | // cdr and car? Should we have a utility function? All in all, we | 271 | // cdr and car? Should we have a utility function? All in all, we |
272 | // need to refactor the codebase first to work with pointer offsets | 272 | // need to refactor the codebase first to work with pointer offsets |
273 | // rather than objects. This issue is very important, if we are in | 273 | // rather than objects. This issue is very important, if we are in |
274 | // the middle of an operation that tries to allocate memory but we | 274 | // the middle of an operation that tries to allocate memory but we |
275 | // had saved pointers to some object, the pointer references may be | 275 | // had saved pointers to some object, the pointer references may be |
276 | // invalidated, crashing or worse, silently returning garbage! Let's | 276 | // invalidated, crashing or worse, silently returning garbage! Let's |
diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c index bf2354b..2d24f92 100755 --- a/src/bootstrap/main.c +++ b/src/bootstrap/main.c | |||
@@ -37,11 +37,13 @@ init(void) { | |||
37 | obj_false = alloc_object(OBJ_TYPE_BOOL); | 37 | obj_false = alloc_object(OBJ_TYPE_BOOL); |
38 | obj_err = alloc_object(OBJ_TYPE_ERR); | 38 | obj_err = alloc_object(OBJ_TYPE_ERR); |
39 | obj_quote = make_symbol((StringView){"quote", 5}); | 39 | obj_quote = make_symbol((StringView){"quote", 5}); |
40 | proc_if = alloc_object(OBJ_TYPE_ERR); | ||
40 | push_root(obj_nil); | 41 | push_root(obj_nil); |
41 | push_root(obj_true); | 42 | push_root(obj_true); |
42 | push_root(obj_false); | 43 | push_root(obj_false); |
43 | push_root(obj_err); | 44 | push_root(obj_err); |
44 | push_root(obj_quote); | 45 | push_root(obj_quote); |
46 | push_root(proc_if); | ||
45 | 47 | ||
46 | // Global environment. | 48 | // Global environment. |
47 | global_env = env_create(NULL); | 49 | global_env = env_create(NULL); |
@@ -52,6 +54,7 @@ init(void) { | |||
52 | // Primitive symbols. | 54 | // Primitive symbols. |
53 | MAKE_ENV_VAR(global_env, "else", obj_true); | 55 | MAKE_ENV_VAR(global_env, "else", obj_true); |
54 | MAKE_ENV_VAR(global_env, "nil", obj_nil); | 56 | MAKE_ENV_VAR(global_env, "nil", obj_nil); |
57 | MAKE_ENV_VAR(global_env, "if", proc_if); | ||
55 | 58 | ||
56 | // Primitive procedures. | 59 | // Primitive procedures. |
57 | MAKE_ENV_PROC(global_env, "eval", proc_eval); | 60 | MAKE_ENV_PROC(global_env, "eval", proc_eval); |
@@ -79,7 +82,6 @@ init(void) { | |||
79 | MAKE_ENV_PROC(global_env, "not", proc_not); | 82 | MAKE_ENV_PROC(global_env, "not", proc_not); |
80 | MAKE_ENV_PROC(global_env, "and", proc_and); | 83 | MAKE_ENV_PROC(global_env, "and", proc_and); |
81 | MAKE_ENV_PROC(global_env, "or", proc_or); | 84 | MAKE_ENV_PROC(global_env, "or", proc_or); |
82 | MAKE_ENV_PROC(global_env, "if", proc_if); | ||
83 | MAKE_ENV_PROC(global_env, "cond", proc_cond); | 85 | MAKE_ENV_PROC(global_env, "cond", proc_cond); |
84 | MAKE_ENV_PROC(global_env, "<", proc_num_less_than); | 86 | MAKE_ENV_PROC(global_env, "<", proc_num_less_than); |
85 | MAKE_ENV_PROC(global_env, "<=", proc_num_lesseq_than); | 87 | MAKE_ENV_PROC(global_env, "<=", proc_num_lesseq_than); |
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){ |