diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/bootstrap/environment.c | 43 | ||||
-rwxr-xr-x | src/bootstrap/main.c | 5 | ||||
-rw-r--r-- | src/bootstrap/objects.c | 36 | ||||
-rw-r--r-- | src/bootstrap/primitives.c | 47 |
4 files changed, 70 insertions, 61 deletions
diff --git a/src/bootstrap/environment.c b/src/bootstrap/environment.c index 1bbe844..0a6a866 100644 --- a/src/bootstrap/environment.c +++ b/src/bootstrap/environment.c | |||
@@ -1,7 +1,3 @@ | |||
1 | // | ||
2 | // Environment. | ||
3 | // | ||
4 | |||
5 | typedef struct EnvEntry { | 1 | typedef struct EnvEntry { |
6 | Object *symbol; | 2 | Object *symbol; |
7 | Object *value; | 3 | Object *value; |
@@ -50,45 +46,6 @@ env_add_symbol(Environment *env, Object *symbol, Object *value) { | |||
50 | env->buf[env->size++] = (EnvEntry){symbol, value}; | 46 | env->buf[env->size++] = (EnvEntry){symbol, value}; |
51 | } | 47 | } |
52 | 48 | ||
53 | bool | ||
54 | obj_eq(Object *a, Object* b) { | ||
55 | if (a->type != b->type) { | ||
56 | return false; | ||
57 | } | ||
58 | switch (a->type) { | ||
59 | case OBJ_TYPE_FIXNUM: { | ||
60 | return a->fixnum == b->fixnum; | ||
61 | } break; | ||
62 | case OBJ_TYPE_STRING: { | ||
63 | if (a->string_n != b->string_n) { | ||
64 | return false; | ||
65 | } | ||
66 | for (size_t i = 0; i < a->string_n; i++) { | ||
67 | if (a->string[i] != b->string[i]) { | ||
68 | return false; | ||
69 | } | ||
70 | } | ||
71 | } break; | ||
72 | case OBJ_TYPE_SYMBOL: { | ||
73 | if (a->symbol_n != b->symbol_n) { | ||
74 | return false; | ||
75 | } | ||
76 | for (size_t i = 0; i < a->symbol_n; i++) { | ||
77 | if (a->symbol[i] != b->symbol[i]) { | ||
78 | return false; | ||
79 | } | ||
80 | } | ||
81 | } break; | ||
82 | case OBJ_TYPE_PAIR: { | ||
83 | // TODO: needs evaluation of parameters... | ||
84 | } break; | ||
85 | default: { | ||
86 | return a == b; | ||
87 | } break; | ||
88 | } | ||
89 | return true; | ||
90 | } | ||
91 | |||
92 | Object * | 49 | Object * |
93 | env_lookup(Environment *env, Object *symbol) { | 50 | env_lookup(Environment *env, Object *symbol) { |
94 | while (env != NULL) { | 51 | while (env != NULL) { |
diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c index 8092bbd..945e121 100755 --- a/src/bootstrap/main.c +++ b/src/bootstrap/main.c | |||
@@ -14,6 +14,10 @@ | |||
14 | #include "environment.c" | 14 | #include "environment.c" |
15 | #include "primitives.c" | 15 | #include "primitives.c" |
16 | 16 | ||
17 | // | ||
18 | // Utility macros. | ||
19 | // | ||
20 | |||
17 | #define MAKE_SYM(STR) make_symbol((StringView){(STR), sizeof(STR) - 1}) | 21 | #define MAKE_SYM(STR) make_symbol((StringView){(STR), sizeof(STR) - 1}) |
18 | #define MAKE_ENV_VAR(ENV,STR,VAR) \ | 22 | #define MAKE_ENV_VAR(ENV,STR,VAR) \ |
19 | (env_add_symbol((ENV), MAKE_SYM(STR), (VAR))) | 23 | (env_add_symbol((ENV), MAKE_SYM(STR), (VAR))) |
@@ -66,6 +70,7 @@ init(void) { | |||
66 | MAKE_ENV_PROC(global_env, ">", proc_num_greater_than); | 70 | MAKE_ENV_PROC(global_env, ">", proc_num_greater_than); |
67 | MAKE_ENV_PROC(global_env, ">=", proc_num_greatereq_than); | 71 | MAKE_ENV_PROC(global_env, ">=", proc_num_greatereq_than); |
68 | MAKE_ENV_PROC(global_env, "=", proc_num_equal); | 72 | MAKE_ENV_PROC(global_env, "=", proc_num_equal); |
73 | MAKE_ENV_PROC(global_env, "eq?", proc_equal); | ||
69 | } | 74 | } |
70 | 75 | ||
71 | void | 76 | void |
diff --git a/src/bootstrap/objects.c b/src/bootstrap/objects.c index 0361ae8..497a04d 100644 --- a/src/bootstrap/objects.c +++ b/src/bootstrap/objects.c | |||
@@ -197,3 +197,39 @@ display(Object *root) { | |||
197 | } | 197 | } |
198 | return; | 198 | return; |
199 | } | 199 | } |
200 | |||
201 | bool | ||
202 | obj_eq(Object *a, Object* b) { | ||
203 | if (a->type != b->type) { | ||
204 | return false; | ||
205 | } | ||
206 | switch (a->type) { | ||
207 | case OBJ_TYPE_FIXNUM: { | ||
208 | return a->fixnum == b->fixnum; | ||
209 | } break; | ||
210 | case OBJ_TYPE_STRING: { | ||
211 | if (a->string_n != b->string_n) { | ||
212 | return false; | ||
213 | } | ||
214 | for (size_t i = 0; i < a->string_n; i++) { | ||
215 | if (a->string[i] != b->string[i]) { | ||
216 | return false; | ||
217 | } | ||
218 | } | ||
219 | } break; | ||
220 | case OBJ_TYPE_SYMBOL: { | ||
221 | if (a->symbol_n != b->symbol_n) { | ||
222 | return false; | ||
223 | } | ||
224 | for (size_t i = 0; i < a->symbol_n; i++) { | ||
225 | if (a->symbol[i] != b->symbol[i]) { | ||
226 | return false; | ||
227 | } | ||
228 | } | ||
229 | } break; | ||
230 | default: { | ||
231 | return a == b; | ||
232 | } break; | ||
233 | } | ||
234 | return true; | ||
235 | } | ||
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index 8369fa8..2a82782 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c | |||
@@ -880,21 +880,32 @@ proc_list(Environment *env, Object *obj) { | |||
880 | // Polymorphic procedures. | 880 | // Polymorphic procedures. |
881 | // | 881 | // |
882 | 882 | ||
883 | //Object * | 883 | Object * |
884 | //proc_equal(Object *args) { | 884 | proc_equal(Environment *env, Object *obj) { |
885 | // // TODO: stub | 885 | if (obj == obj_nil || obj->cdr == obj_nil) { |
886 | // (void) args; | 886 | error_push((Error){ |
887 | // return NULL; | 887 | .type = ERR_TYPE_RUNTIME, |
888 | //} | 888 | .value = ERR_NOT_ENOUGH_ARGS, |
889 | 889 | }); | |
890 | //// TODO: fixnum left/right shift, mask, invert | 890 | return obj_err; |
891 | //// TODO: implement and test missing procedures | 891 | } |
892 | //// TODO: add primitives for type transforms: string->symbol, symbol->string, etc | 892 | Object *a = eval(env, obj->car); |
893 | //// TODO: properly implement nested environments | 893 | if (a == obj_err) { |
894 | //// TODO: implement support for quotes and semi-quotes | 894 | return obj_err; |
895 | //// TODO: LAMBDA | 895 | } |
896 | //// TODO: let | 896 | Object *b = eval(env, obj->cdr->car); |
897 | //// TODO: better error handling? | 897 | if (b == obj_err) { |
898 | //// TODO: Revise all instances where we are returning an object, since currently | 898 | return obj_err; |
899 | //// we may be returning a pointer to an object instead of a new one. Check also | 899 | } |
900 | //// on eval function and everytime we do make_xxx(obj). | 900 | return obj_eq(a, b) ? obj_true : obj_false; |
901 | } | ||
902 | |||
903 | |||
904 | // TODO: fixnum left/right shift, mask, invert | ||
905 | // TODO: add primitives for type transforms: string->symbol, symbol->string, etc | ||
906 | // TODO: implement support for semi-quotes | ||
907 | // TODO: LAMBDA | ||
908 | // TODO: let | ||
909 | // TODO: Revise all instances where we are returning an object, since currently | ||
910 | // we may be returning a pointer to an object instead of a new one. Check also | ||
911 | // on eval function and everytime we do make_xxx(obj). | ||