diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/bootstrap/environment.c | 13 | ||||
-rw-r--r-- | src/bootstrap/gc.c | 128 | ||||
-rwxr-xr-x | src/bootstrap/main.c | 117 | ||||
-rw-r--r-- | src/bootstrap/objects.c | 35 | ||||
-rw-r--r-- | src/bootstrap/primitives.c | 47 |
5 files changed, 193 insertions, 147 deletions
diff --git a/src/bootstrap/environment.c b/src/bootstrap/environment.c index 78f31fb..57baea6 100644 --- a/src/bootstrap/environment.c +++ b/src/bootstrap/environment.c | |||
@@ -8,15 +8,18 @@ typedef struct Environment { | |||
8 | EnvEntry *buf; | 8 | EnvEntry *buf; |
9 | size_t size; | 9 | size_t size; |
10 | size_t cap; | 10 | size_t cap; |
11 | bool marked; | ||
11 | } Environment; | 12 | } Environment; |
12 | 13 | ||
13 | static Environment *global_env; | 14 | static Environment *global_env; |
14 | 15 | ||
15 | #define ENV_BUF_CAP 8 | 16 | #define ENV_BUF_CAP 8 |
16 | 17 | ||
18 | Environment *alloc_env(void); | ||
19 | |||
17 | Environment * | 20 | Environment * |
18 | env_create(Environment *parent) { | 21 | env_create(Environment *parent) { |
19 | Environment *env = malloc(sizeof(Environment)); | 22 | Environment *env = alloc_env(); |
20 | env->parent = parent; | 23 | env->parent = parent; |
21 | env->buf = NULL; | 24 | env->buf = NULL; |
22 | env->size = 0; | 25 | env->size = 0; |
@@ -66,7 +69,7 @@ env_update(Environment *env, Object *symbol, Object *value) { | |||
66 | for (size_t i = 0; i < env->size; i++) { | 69 | for (size_t i = 0; i < env->size; i++) { |
67 | EnvEntry entry = env->buf[i]; | 70 | EnvEntry entry = env->buf[i]; |
68 | if (obj_eq(symbol, entry.symbol)) { | 71 | if (obj_eq(symbol, entry.symbol)) { |
69 | env->buf[i].value = obj_duplicate(value); | 72 | env->buf[i].value = value; |
70 | return obj_nil; | 73 | return obj_nil; |
71 | } | 74 | } |
72 | } | 75 | } |
@@ -94,9 +97,9 @@ void | |||
94 | env_add_or_update_current(Environment *env, Object *symbol, Object *value) { | 97 | env_add_or_update_current(Environment *env, Object *symbol, Object *value) { |
95 | ssize_t index = env_index_current(env, symbol); | 98 | ssize_t index = env_index_current(env, symbol); |
96 | if (index == -1) { | 99 | if (index == -1) { |
97 | env_add_symbol(env, obj_duplicate(symbol), obj_duplicate(value)); | 100 | env_add_symbol(env, symbol, value); |
98 | } else { | 101 | } else { |
99 | env->buf[index].value = obj_duplicate(value); | 102 | env->buf[index].value = value; |
100 | } | 103 | } |
101 | } | 104 | } |
102 | 105 | ||
@@ -115,7 +118,7 @@ env_extend(Environment *parent, Environment *extra) { | |||
115 | tmp = tmp->parent; | 118 | tmp = tmp->parent; |
116 | } | 119 | } |
117 | if (!found) { | 120 | if (!found) { |
118 | env_add_symbol(env, obj_duplicate(entry.symbol), obj_duplicate(entry.value)); | 121 | env_add_symbol(env, entry.symbol, entry.value); |
119 | } | 122 | } |
120 | } | 123 | } |
121 | return env; | 124 | return env; |
diff --git a/src/bootstrap/gc.c b/src/bootstrap/gc.c index 8ca99b7..6e15c63 100644 --- a/src/bootstrap/gc.c +++ b/src/bootstrap/gc.c | |||
@@ -5,8 +5,15 @@ typedef struct RootNodes { | |||
5 | size_t cap; | 5 | size_t cap; |
6 | } RootNodes; | 6 | } RootNodes; |
7 | 7 | ||
8 | typedef struct Environments { | ||
9 | Environment *buf; | ||
10 | size_t size; | ||
11 | size_t cap; | ||
12 | } Environments; | ||
13 | |||
8 | typedef struct GC { | 14 | typedef struct GC { |
9 | RootNodes roots; | 15 | RootNodes roots; |
16 | Environments envs; | ||
10 | Object *obj_list; | 17 | Object *obj_list; |
11 | // Free list keeps track of the offset numbers from the obj_list | 18 | // Free list keeps track of the offset numbers from the obj_list |
12 | size_t *free_list; | 19 | size_t *free_list; |
@@ -16,11 +23,22 @@ typedef struct GC { | |||
16 | } GC; | 23 | } GC; |
17 | 24 | ||
18 | // FIXME: small value for testing purposes | 25 | // FIXME: small value for testing purposes |
19 | #define GC_INITIAL_HEAP 16 | 26 | // #define GC_INITIAL_HEAP 32 |
20 | #define GC_ROOTS_CAP 8 | 27 | #define GC_INITIAL_HEAP 1024 * 1.5 |
28 | #define GC_ROOTS_CAP 1024 * 1024 | ||
29 | #define GC_ENVS_CAP 1024 * 1024 | ||
21 | 30 | ||
22 | static GC gc; | 31 | static GC gc; |
23 | 32 | ||
33 | Environment * | ||
34 | alloc_env(void) { | ||
35 | if (gc.envs.size < gc.envs.cap) { | ||
36 | return &gc.envs.buf[gc.envs.size++]; | ||
37 | } | ||
38 | printf("error: not enough room for more environments\n"); | ||
39 | return NULL; | ||
40 | } | ||
41 | |||
24 | void | 42 | void |
25 | push_root(Object *obj) { | 43 | push_root(Object *obj) { |
26 | if (gc.roots.size == gc.roots.cap) { | 44 | if (gc.roots.size == gc.roots.cap) { |
@@ -38,13 +56,21 @@ pop_root(void) { | |||
38 | void | 56 | void |
39 | init_gc(void) { | 57 | init_gc(void) { |
40 | gc = (GC){ | 58 | gc = (GC){ |
59 | .free_list = malloc(GC_INITIAL_HEAP * sizeof(size_t)), | ||
60 | .obj_list = malloc(GC_INITIAL_HEAP * sizeof(Object)), | ||
41 | .obj_cap = GC_INITIAL_HEAP, | 61 | .obj_cap = GC_INITIAL_HEAP, |
42 | .available_slots = GC_INITIAL_HEAP, | 62 | .available_slots = GC_INITIAL_HEAP, |
63 | .envs = (Environments){ | ||
64 | .buf = malloc(GC_ENVS_CAP * sizeof(Environment)), | ||
65 | .size = 0, | ||
66 | .cap = GC_ENVS_CAP, | ||
67 | }, | ||
68 | .roots = (RootNodes){ | ||
69 | .buf = malloc(GC_ROOTS_CAP * sizeof(Object*)), | ||
70 | .size = 0, | ||
71 | .cap = GC_ROOTS_CAP, | ||
72 | }, | ||
43 | }; | 73 | }; |
44 | gc.free_list = malloc(GC_INITIAL_HEAP * sizeof(size_t)); | ||
45 | gc.obj_list = malloc(GC_INITIAL_HEAP * sizeof(Object)); | ||
46 | gc.roots.buf = malloc(GC_ROOTS_CAP * sizeof(Object*)); | ||
47 | gc.roots.cap = GC_ROOTS_CAP; | ||
48 | 74 | ||
49 | // The free list stores the offset from the initial position for all | 75 | // The free list stores the offset from the initial position for all |
50 | // available slots. | 76 | // available slots. |
@@ -55,7 +81,22 @@ init_gc(void) { | |||
55 | 81 | ||
56 | Object * | 82 | Object * |
57 | get_obj(size_t offset) { | 83 | get_obj(size_t offset) { |
58 | return gc.obj_list + offset; | 84 | return &gc.obj_list[offset]; |
85 | } | ||
86 | |||
87 | void mark_obj(Object *obj); | ||
88 | |||
89 | void | ||
90 | mark_environment(Environment *env) { | ||
91 | if (env->marked) { | ||
92 | return; | ||
93 | } | ||
94 | env->marked = true; | ||
95 | for (size_t i = 0; i < env->size; i++) { | ||
96 | EnvEntry entry = env->buf[i]; | ||
97 | mark_obj(entry.symbol); | ||
98 | mark_obj(entry.value); | ||
99 | } | ||
59 | } | 100 | } |
60 | 101 | ||
61 | void | 102 | void |
@@ -68,17 +109,27 @@ mark_obj(Object *obj) { | |||
68 | mark_obj(obj->car); | 109 | mark_obj(obj->car); |
69 | mark_obj(obj->cdr); | 110 | mark_obj(obj->cdr); |
70 | } | 111 | } |
112 | if (obj->type == OBJ_TYPE_LAMBDA) { | ||
113 | mark_obj(obj->params); | ||
114 | mark_obj(obj->body); | ||
115 | mark_environment(obj->env); | ||
116 | } | ||
71 | } | 117 | } |
72 | 118 | ||
73 | void | 119 | void |
74 | mark_and_sweep(void) { | 120 | mark_and_sweep(void) { |
75 | // Mark. | 121 | // Mark. |
122 | for (size_t i = 0; i < gc.envs.size; i++) { | ||
123 | mark_environment(&gc.envs.buf[i]); | ||
124 | } | ||
125 | |||
76 | for (size_t i = 0; i < gc.roots.size; i++) { | 126 | for (size_t i = 0; i < gc.roots.size; i++) { |
77 | if (gc.roots.buf[i]->marked) { | 127 | if (gc.roots.buf[i]->marked) { |
78 | continue; | 128 | continue; |
79 | } | 129 | } |
80 | mark_obj(gc.roots.buf[i]); | 130 | mark_obj(gc.roots.buf[i]); |
81 | } | 131 | } |
132 | // dump_gc() | ||
82 | 133 | ||
83 | // Reset the free list. | 134 | // Reset the free list. |
84 | gc.fl_pos = 0; | 135 | gc.fl_pos = 0; |
@@ -86,40 +137,59 @@ mark_and_sweep(void) { | |||
86 | 137 | ||
87 | // Sweep. | 138 | // Sweep. |
88 | for (size_t i = 0; i < gc.obj_cap; i++) { | 139 | for (size_t i = 0; i < gc.obj_cap; i++) { |
89 | if (!gc.obj_list[i].marked) { | 140 | Object *obj = &gc.obj_list[i]; |
141 | if (!obj->marked) { | ||
90 | // Free heap allocated memory for this object if needed. | 142 | // Free heap allocated memory for this object if needed. |
91 | Object obj = gc.obj_list[i]; | 143 | if (obj->type == OBJ_TYPE_SYMBOL) { |
92 | if (obj.type == OBJ_TYPE_SYMBOL) { | 144 | free(obj->symbol); |
93 | free(obj.symbol); | 145 | } else if (obj->type == OBJ_TYPE_STRING) { |
94 | } else if (obj.type == OBJ_TYPE_STRING) { | 146 | free(obj->string); |
95 | free(obj.string); | ||
96 | } | 147 | } |
97 | |||
98 | gc.free_list[gc.available_slots++] = i; | 148 | gc.free_list[gc.available_slots++] = i; |
99 | } | 149 | } |
100 | gc.obj_list[i].marked = false; | 150 | obj->marked = false; |
151 | } | ||
152 | for (size_t i = 0; i < gc.envs.size; i++) { | ||
153 | gc.envs.buf[i].marked = false; | ||
101 | } | 154 | } |
102 | } | 155 | } |
103 | 156 | ||
157 | void | ||
158 | dump_gc(void) { | ||
159 | printf("-------------- ROOTS -------------- \n"); | ||
160 | for (size_t i = 0; i < gc.roots.size; i++) { | ||
161 | display(gc.roots.buf[i]); | ||
162 | printf("\n"); | ||
163 | } | ||
164 | printf("------------- OBJECTS ------------- \n"); | ||
165 | // for (size_t i = 0; i < gc.obj_cap; i++) { | ||
166 | for (size_t i = 0; i < 20; i++) { | ||
167 | printf("i: %ld -> ", i); | ||
168 | Object *obj = &gc.obj_list[i]; | ||
169 | display(obj); | ||
170 | bool is_free = false; | ||
171 | for (size_t j = 0; j < gc.obj_cap; j++) { | ||
172 | if (gc.free_list[j] == i) { | ||
173 | is_free = true; | ||
174 | break; | ||
175 | } | ||
176 | } | ||
177 | if (is_free) { | ||
178 | printf(" [FREE]"); | ||
179 | } | ||
180 | printf("\n"); | ||
181 | } | ||
182 | printf("FREE OBJECTS: %ld\n", gc.available_slots); | ||
183 | printf("ENVIRONMENTS: %ld\n", gc.envs.size); | ||
184 | } | ||
185 | |||
104 | Object * | 186 | Object * |
105 | alloc_object(ObjectType type) { | 187 | alloc_object(ObjectType type) { |
106 | if (gc.available_slots == 0) { | 188 | if (gc.available_slots == 0) { |
107 | printf("triggering GC\n"); | ||
108 | mark_and_sweep(); | 189 | mark_and_sweep(); |
109 | if (gc.available_slots == 0) { | 190 | if (gc.available_slots == 0) { |
110 | printf("NOT MORE MEMORY AVAILABLE\n"); | 191 | printf("NOT MORE MEMORY AVAILABLE WHERE IS YOUR GOD NOW MWAHAHA\n"); |
111 | printf("-------------- ROOTS -------------- \n"); | 192 | dump_gc(); |
112 | for (size_t i = 0; i < gc.roots.size; i++) { | ||
113 | display(gc.roots.buf[i]); | ||
114 | printf("\n"); | ||
115 | } | ||
116 | printf("------------- OBJECTS ------------- \n"); | ||
117 | for (size_t i = 0; i < gc.obj_cap; i++) { | ||
118 | printf("i: %ld -> ", i); | ||
119 | Object *obj = &gc.obj_list[i]; | ||
120 | display(obj); | ||
121 | printf("\n"); | ||
122 | } | ||
123 | exit(EXIT_FAILURE); | 193 | exit(EXIT_FAILURE); |
124 | // TODO: grow heap tables. | 194 | // TODO: grow heap tables. |
125 | // NOTE: When growing the tables, we WILL lose the pointer | 195 | // NOTE: When growing the tables, we WILL lose the pointer |
diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c index ce1fdfe..66b1300 100755 --- a/src/bootstrap/main.c +++ b/src/bootstrap/main.c | |||
@@ -43,54 +43,56 @@ init(void) { | |||
43 | push_root(obj_err); | 43 | push_root(obj_err); |
44 | push_root(obj_quote); | 44 | push_root(obj_quote); |
45 | 45 | ||
46 | // // Global environment. | 46 | // Global environment. |
47 | // global_env = env_create(NULL); | 47 | global_env = env_create(NULL); |
48 | 48 | // TODO: make sure we create symbols and strings only once (interning | |
49 | // // Primitive symbols. | 49 | // strings?) |
50 | // MAKE_ENV_VAR(global_env, "else", obj_true); | 50 | |
51 | // MAKE_ENV_VAR(global_env, "nil", obj_nil); | 51 | // Primitive symbols. |
52 | 52 | MAKE_ENV_VAR(global_env, "else", obj_true); | |
53 | // // Primitive procedures. | 53 | MAKE_ENV_VAR(global_env, "nil", obj_nil); |
54 | // MAKE_ENV_PROC(global_env, "eval", proc_eval); | 54 | |
55 | // MAKE_ENV_PROC(global_env, "quote", proc_quote); | 55 | // Primitive procedures. |
56 | // MAKE_ENV_PROC(global_env, "car", proc_car); | 56 | MAKE_ENV_PROC(global_env, "eval", proc_eval); |
57 | // MAKE_ENV_PROC(global_env, "cdr", proc_cdr); | 57 | MAKE_ENV_PROC(global_env, "quote", proc_quote); |
58 | // MAKE_ENV_PROC(global_env, "cons", proc_cons); | 58 | MAKE_ENV_PROC(global_env, "car", proc_car); |
59 | // MAKE_ENV_PROC(global_env, "list", proc_list); | 59 | MAKE_ENV_PROC(global_env, "cdr", proc_cdr); |
60 | // MAKE_ENV_PROC(global_env, "+", proc_sum); | 60 | MAKE_ENV_PROC(global_env, "cons", proc_cons); |
61 | // MAKE_ENV_PROC(global_env, "-", proc_sub); | 61 | MAKE_ENV_PROC(global_env, "list", proc_list); |
62 | // MAKE_ENV_PROC(global_env, "*", proc_mul); | 62 | MAKE_ENV_PROC(global_env, "+", proc_sum); |
63 | // MAKE_ENV_PROC(global_env, "/", proc_div); | 63 | MAKE_ENV_PROC(global_env, "-", proc_sub); |
64 | // MAKE_ENV_PROC(global_env, "%", proc_mod); | 64 | MAKE_ENV_PROC(global_env, "*", proc_mul); |
65 | // MAKE_ENV_PROC(global_env, "print", proc_print); | 65 | MAKE_ENV_PROC(global_env, "/", proc_div); |
66 | // MAKE_ENV_PROC(global_env, "display", proc_display); | 66 | MAKE_ENV_PROC(global_env, "%", proc_mod); |
67 | // MAKE_ENV_PROC(global_env, "newline", proc_newline); | 67 | MAKE_ENV_PROC(global_env, "print", proc_print); |
68 | // MAKE_ENV_PROC(global_env, "boolean?", proc_is_boolean); | 68 | MAKE_ENV_PROC(global_env, "display", proc_display); |
69 | // MAKE_ENV_PROC(global_env, "nil?", proc_is_nil); | 69 | MAKE_ENV_PROC(global_env, "newline", proc_newline); |
70 | // MAKE_ENV_PROC(global_env, "symbol?", proc_is_symbol); | 70 | MAKE_ENV_PROC(global_env, "boolean?", proc_is_boolean); |
71 | // MAKE_ENV_PROC(global_env, "string?", proc_is_string); | 71 | MAKE_ENV_PROC(global_env, "nil?", proc_is_nil); |
72 | // MAKE_ENV_PROC(global_env, "fixnum?", proc_is_fixnum); | 72 | MAKE_ENV_PROC(global_env, "symbol?", proc_is_symbol); |
73 | // MAKE_ENV_PROC(global_env, "pair?", proc_is_pair); | 73 | MAKE_ENV_PROC(global_env, "string?", proc_is_string); |
74 | // MAKE_ENV_PROC(global_env, "procedure?", proc_is_procedure); | 74 | MAKE_ENV_PROC(global_env, "fixnum?", proc_is_fixnum); |
75 | // MAKE_ENV_PROC(global_env, "error?", proc_is_error); | 75 | MAKE_ENV_PROC(global_env, "pair?", proc_is_pair); |
76 | // MAKE_ENV_PROC(global_env, "not", proc_not); | 76 | MAKE_ENV_PROC(global_env, "procedure?", proc_is_procedure); |
77 | // MAKE_ENV_PROC(global_env, "and", proc_and); | 77 | MAKE_ENV_PROC(global_env, "error?", proc_is_error); |
78 | // MAKE_ENV_PROC(global_env, "or", proc_or); | 78 | MAKE_ENV_PROC(global_env, "not", proc_not); |
79 | // MAKE_ENV_PROC(global_env, "if", proc_if); | 79 | MAKE_ENV_PROC(global_env, "and", proc_and); |
80 | // MAKE_ENV_PROC(global_env, "cond", proc_cond); | 80 | MAKE_ENV_PROC(global_env, "or", proc_or); |
81 | // MAKE_ENV_PROC(global_env, "<", proc_num_less_than); | 81 | MAKE_ENV_PROC(global_env, "if", proc_if); |
82 | // MAKE_ENV_PROC(global_env, "<=", proc_num_lesseq_than); | 82 | MAKE_ENV_PROC(global_env, "cond", proc_cond); |
83 | // MAKE_ENV_PROC(global_env, ">", proc_num_greater_than); | 83 | MAKE_ENV_PROC(global_env, "<", proc_num_less_than); |
84 | // MAKE_ENV_PROC(global_env, ">=", proc_num_greatereq_than); | 84 | MAKE_ENV_PROC(global_env, "<=", proc_num_lesseq_than); |
85 | // MAKE_ENV_PROC(global_env, "=", proc_num_equal); | 85 | MAKE_ENV_PROC(global_env, ">", proc_num_greater_than); |
86 | // MAKE_ENV_PROC(global_env, "eq?", proc_equal); | 86 | MAKE_ENV_PROC(global_env, ">=", proc_num_greatereq_than); |
87 | // MAKE_ENV_PROC(global_env, "def", proc_define); | 87 | MAKE_ENV_PROC(global_env, "=", proc_num_equal); |
88 | // MAKE_ENV_PROC(global_env, "set!", proc_set); | 88 | MAKE_ENV_PROC(global_env, "eq?", proc_equal); |
89 | // MAKE_ENV_PROC(global_env, "lambda", proc_lambda); | 89 | MAKE_ENV_PROC(global_env, "def", proc_define); |
90 | // MAKE_ENV_PROC(global_env, "fun", proc_fun); | 90 | MAKE_ENV_PROC(global_env, "set!", proc_set); |
91 | 91 | MAKE_ENV_PROC(global_env, "lambda", proc_lambda); | |
92 | // // Runtime procedures. | 92 | MAKE_ENV_PROC(global_env, "fun", proc_fun); |
93 | // MAKE_ENV_PROC(global_env, "supress-errors", proc_supress_errors); | 93 | |
94 | // Runtime procedures. | ||
95 | MAKE_ENV_PROC(global_env, "supress-errors", proc_supress_errors); | ||
94 | } | 96 | } |
95 | 97 | ||
96 | void | 98 | void |
@@ -113,24 +115,6 @@ process_source(const StringView *source) { | |||
113 | Object *root = parse_tree(&visitor); | 115 | Object *root = parse_tree(&visitor); |
114 | gc.roots.size = root_stack_size; | 116 | gc.roots.size = root_stack_size; |
115 | push_root(root); | 117 | push_root(root); |
116 | // printf("AFTER: %ld\n", gc.roots.size); | ||
117 | // return the stack before parsing to previous state except we now have | ||
118 | // the root object as well. | ||
119 | // printf("-----------\n"); | ||
120 | // printf("ROOTS: \n"); | ||
121 | // for (size_t i = 0; i < gc.roots.size; i++) { | ||
122 | // display(gc.roots.buf[i]); | ||
123 | // printf("\n"); | ||
124 | // } | ||
125 | // printf("...........\n"); | ||
126 | for (size_t i = 0; i < gc.obj_cap; i++) { | ||
127 | Object *obj = &gc.obj_list[i]; | ||
128 | printf("marked? : %d ", obj->marked); | ||
129 | printf("type: %d ", obj->type); | ||
130 | display(obj); | ||
131 | printf("\n"); | ||
132 | } | ||
133 | // printf("===========\n"); | ||
134 | if (root == obj_err || errors_n != 0) { | 118 | if (root == obj_err || errors_n != 0) { |
135 | break; | 119 | break; |
136 | } | 120 | } |
@@ -141,7 +125,6 @@ process_source(const StringView *source) { | |||
141 | printf("\n"); | 125 | printf("\n"); |
142 | } | 126 | } |
143 | pop_root(); | 127 | pop_root(); |
144 | // mark_and_sweep(); | ||
145 | } | 128 | } |
146 | 129 | ||
147 | if (tokens.buf != NULL) { | 130 | if (tokens.buf != NULL) { |
diff --git a/src/bootstrap/objects.c b/src/bootstrap/objects.c index 2bd5b1a..09076db 100644 --- a/src/bootstrap/objects.c +++ b/src/bootstrap/objects.c | |||
@@ -116,41 +116,6 @@ append_string(Object *obj, const StringView sv) { | |||
116 | obj->string_n += sv.n; | 116 | obj->string_n += sv.n; |
117 | } | 117 | } |
118 | 118 | ||
119 | Object * | ||
120 | obj_duplicate(Object *obj) { | ||
121 | Object *copy = obj_err; | ||
122 | switch (obj->type) { | ||
123 | case OBJ_TYPE_BOOL: | ||
124 | case OBJ_TYPE_NIL: | ||
125 | case OBJ_TYPE_PROCEDURE: | ||
126 | case OBJ_TYPE_LAMBDA: // TODO: should we duplicate everything inside? | ||
127 | case OBJ_TYPE_ERR: { | ||
128 | copy = obj; | ||
129 | } break; | ||
130 | case OBJ_TYPE_FIXNUM: { | ||
131 | copy = make_fixnum(obj->fixnum); | ||
132 | } break; | ||
133 | case OBJ_TYPE_SYMBOL: { | ||
134 | copy = make_symbol((StringView){obj->symbol, obj->symbol_n}); | ||
135 | } break; | ||
136 | case OBJ_TYPE_STRING: { | ||
137 | copy = make_string(); | ||
138 | append_string(copy, (StringView){obj->string, obj->string_n}); | ||
139 | } break; | ||
140 | case OBJ_TYPE_PAIR: { | ||
141 | Object *root = make_pair(obj_duplicate(obj->car), obj_nil); | ||
142 | copy = root; | ||
143 | obj = obj->cdr; | ||
144 | while (obj != obj_nil) { | ||
145 | root->cdr = make_pair(obj_duplicate(obj->car), obj_nil); | ||
146 | root = root->cdr; | ||
147 | obj = obj->cdr; | ||
148 | } | ||
149 | } break; | ||
150 | } | ||
151 | return copy; | ||
152 | } | ||
153 | |||
154 | void display(Object *root); | 119 | void display(Object *root); |
155 | 120 | ||
156 | void | 121 | void |
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index 35208b0..abb87e7 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c | |||
@@ -2,7 +2,6 @@ | |||
2 | 2 | ||
3 | Object * | 3 | Object * |
4 | eval(Environment* env, Object *root) { | 4 | eval(Environment* env, Object *root) { |
5 | return obj_nil; // DEBUG: gc | ||
6 | switch (root->type) { | 5 | switch (root->type) { |
7 | case OBJ_TYPE_ERR: | 6 | case OBJ_TYPE_ERR: |
8 | case OBJ_TYPE_PROCEDURE: | 7 | case OBJ_TYPE_PROCEDURE: |
@@ -95,7 +94,8 @@ eval_lambda: | |||
95 | }; | 94 | }; |
96 | root = root->cdr; | 95 | root = root->cdr; |
97 | } | 96 | } |
98 | return eval(env, root->car); | 97 | root = eval(env, root->car); |
98 | return root; | ||
99 | } | 99 | } |
100 | } break; | 100 | } break; |
101 | } | 101 | } |
@@ -630,9 +630,20 @@ proc_cons(Environment *env, Object *obj) { | |||
630 | }); | 630 | }); |
631 | return obj_err; | 631 | return obj_err; |
632 | } | 632 | } |
633 | Object *a = eval(env, obj->car); | 633 | Object *head = make_pair(obj_nil, obj_nil); |
634 | Object *b = eval(env, obj->cdr->car); | 634 | push_root(head); |
635 | return make_pair(a, b); | 635 | head->car = eval(env, obj->car); |
636 | if (head->car == obj_err) { | ||
637 | pop_root(); | ||
638 | return obj_err; | ||
639 | } | ||
640 | head->cdr = eval(env, obj->cdr->car); | ||
641 | if (head->cdr == obj_err) { | ||
642 | pop_root(); | ||
643 | return obj_err; | ||
644 | } | ||
645 | pop_root(); | ||
646 | return head; | ||
636 | } | 647 | } |
637 | 648 | ||
638 | Object * | 649 | Object * |
@@ -640,14 +651,28 @@ proc_list(Environment *env, Object *obj) { | |||
640 | if (obj == obj_nil) { | 651 | if (obj == obj_nil) { |
641 | return obj_nil; | 652 | return obj_nil; |
642 | } | 653 | } |
643 | Object *head = make_pair(eval(env, obj->car), obj_nil); | 654 | |
655 | Object *head = make_pair(obj_nil, obj_nil); | ||
656 | push_root(head); | ||
657 | Object *tmp = eval(env, obj->car); | ||
658 | if (tmp == obj_err) { | ||
659 | pop_root(); | ||
660 | return obj_err; | ||
661 | } | ||
662 | head->car = tmp; | ||
644 | Object *curr = head; | 663 | Object *curr = head; |
645 | obj = obj->cdr; | 664 | obj = obj->cdr; |
646 | while (obj != obj_nil) { | 665 | while (obj != obj_nil) { |
647 | curr->cdr = make_pair(eval(env, obj->car), obj_nil); | 666 | tmp = eval(env, obj->car); |
667 | if (tmp == obj_err) { | ||
668 | pop_root(); | ||
669 | return obj_err; | ||
670 | } | ||
671 | curr->cdr = make_pair(tmp, obj_nil); | ||
648 | curr = curr->cdr; | 672 | curr = curr->cdr; |
649 | obj = obj->cdr; | 673 | obj = obj->cdr; |
650 | } | 674 | } |
675 | pop_root(); | ||
651 | return head; | 676 | return head; |
652 | } | 677 | } |
653 | 678 | ||
@@ -753,8 +778,8 @@ proc_lambda(Environment *env, Object *obj) { | |||
753 | } | 778 | } |
754 | Object *body = obj->cdr; | 779 | Object *body = obj->cdr; |
755 | Object *fun = alloc_object(OBJ_TYPE_LAMBDA); | 780 | Object *fun = alloc_object(OBJ_TYPE_LAMBDA); |
756 | fun->params = obj_duplicate(params); | 781 | fun->params = params; |
757 | fun->body = obj_duplicate(body); | 782 | fun->body = body; |
758 | fun->env = env; | 783 | fun->env = env; |
759 | return fun; | 784 | return fun; |
760 | } | 785 | } |
@@ -788,8 +813,8 @@ proc_fun(Environment *env, Object *obj) { | |||
788 | } | 813 | } |
789 | Object *body = obj->cdr->cdr; | 814 | Object *body = obj->cdr->cdr; |
790 | Object *fun = alloc_object(OBJ_TYPE_LAMBDA); | 815 | Object *fun = alloc_object(OBJ_TYPE_LAMBDA); |
791 | fun->params = obj_duplicate(params); | 816 | fun->params = params; |
792 | fun->body = obj_duplicate(body); | 817 | fun->body = body; |
793 | fun->env = env; | 818 | fun->env = env; |
794 | env_add_or_update_current(env, name, fun); | 819 | env_add_or_update_current(env, name, fun); |
795 | return obj_nil; | 820 | return obj_nil; |