-
Notifications
You must be signed in to change notification settings - Fork 0
/
eval.c
295 lines (245 loc) · 10.6 KB
/
eval.c
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
#include <assert.h>
#include <stdio.h>
#include "shoelaces.h"
#include "internal.h"
sl_value
sl_symbol_table_get(struct sl_interpreter_state *state, char *name)
{
khiter_t iter;
iter = kh_get(str, state->symbol_table, name);
if (iter == kh_end(state->symbol_table)) {
return NULL;
} else {
return kh_value(state->symbol_table, iter);
}
}
void
sl_symbol_table_put(struct sl_interpreter_state *state, char *name, sl_value value)
{
assert(sl_type(value) == state->tSymbol);
/* TODO: Check for ENOMEM */
char *duped_name = strdup(name);
int ret;
khiter_t iter;
iter = kh_put(str, state->symbol_table, duped_name, &ret);
kh_value(state->symbol_table, iter) = value;
}
size_t
sl_symbol_table_size(struct sl_interpreter_state *state)
{
return kh_size(state->symbol_table);
}
void boot_type(struct sl_interpreter_state *state);
void boot_string(struct sl_interpreter_state *state);
void fix_type_names(struct sl_interpreter_state *state);
void boot_list(struct sl_interpreter_state *state);
void boot_symbol(struct sl_interpreter_state *state);
void boot_keyword(struct sl_interpreter_state *state);
void boot_boolean(struct sl_interpreter_state *state);
void sl_init_type(struct sl_interpreter_state *state);
void sl_init_string(struct sl_interpreter_state *state);
void sl_init_list(struct sl_interpreter_state *state);
void sl_init_symbol(struct sl_interpreter_state *state);
void sl_init_keyword(struct sl_interpreter_state *state);
void sl_init_number(struct sl_interpreter_state *state);
void sl_init_boolean(struct sl_interpreter_state *state);
void sl_init_function(struct sl_interpreter_state *state);
void sl_init_io(struct sl_interpreter_state *state);
void sl_init_eval(struct sl_interpreter_state *state);
void sl_init_gc(struct sl_interpreter_state *state);
void sl_init_reader(struct sl_interpreter_state *state);
struct sl_interpreter_state *
sl_init()
{
struct sl_interpreter_state *state = sl_native_malloc(sizeof(struct sl_interpreter_state));
state->symbol_table = kh_init(str);
state->keyword_table = kh_init(str);
sl_init_gc(state);
sl_gc_disable(state);
/* The order of these next three function calls is
* important. Because type names are strings, and
* state->tString isn't set until after boot_string is
* called, the names of state->tType and state->tString
* both have their types pointed at something other than
* state->tString. We fix this in fix_type_names.
*
* An alternative approach (that the Ruby interpreter
* takes) is making type names Symbols instead of strings.
* In the symbol table lookup function, the class of the
* symbol name is checked before the symbol is returned. If
* it's NULL, it is changed to the String class. The value
* of doing things that way is that the order of the type
* init functions would no longer matter and we could get
* rid of sl_fix_type_names. I may experiment with doing
* that at some point in the future.
*/
/* bootstrap types necessary for interpreter interals */
boot_type(state);
boot_string(state);
fix_type_names(state);
boot_list(state);
boot_symbol(state);
boot_keyword(state);
boot_boolean(state);
/* set up global environment and add existing types to it */
state->global_env = state->sl_empty_list;
boot_def_type(state, state->tType);
boot_def_type(state, state->tAny);
boot_def_type(state, state->tString);
boot_def_type(state, state->tList);
boot_def_type(state, state->tSymbol);
boot_def_type(state, state->tKeyword);
boot_def_type(state, state->tBoolean);
/* initialize functions (the rest of the initialization methods depend on this */
sl_init_function(state);
/* finish initialization of bootstrapped types */
sl_init_type(state);
sl_init_string(state);
sl_init_list(state);
sl_init_symbol(state);
sl_init_keyword(state);
sl_init_boolean(state);
/* initialize other types here */
sl_init_number(state);
sl_init_io(state);
sl_init_eval(state);
/* initialize the reader */
sl_init_reader(state);
sl_gc_enable(state);
return state;
}
void
sl_destroy(struct sl_interpreter_state *state)
{
kh_destroy(str, state->symbol_table);
kh_destroy(str, state->keyword_table);
sl_free_keep_list(state->keep_list, NULL);
sl_gc_free_all(state);
free(state);
}
int
sl_env_has_key(struct sl_interpreter_state *state, sl_value environment, sl_value name)
{
assert(sl_type(name) == state->tSymbol);
return sl_alist_has_key(state, environment, name) == state->sl_true;
}
sl_value
sl_env_get(struct sl_interpreter_state *state, sl_value environment, sl_value name)
{
assert(sl_type(name) == state->tSymbol);
return sl_alist_get(state, environment, name);
}
static sl_value
eval_each(struct sl_interpreter_state *state, sl_value args, sl_value environment)
{
assert(sl_type(args) == state->tList);
if (args == state->sl_empty_list) {
return state->sl_empty_list;
} else {
sl_value first = sl_first(state, args);
sl_value rest = sl_rest(state, args);
return sl_list_new(state, sl_eval(state, first, environment), eval_each(state, rest, environment));
}
}
sl_value
sl_eval(struct sl_interpreter_state *state, sl_value expression, sl_value environment)
{
if (sl_type(expression) == state->tSymbol) {
if (sl_env_has_key(state, environment, expression)) {
return sl_env_get(state, environment, expression);
} else {
fprintf(stderr, "Error: `%s' is undefined\n", sl_string_cstring(state, sl_inspect(state, expression)));
abort();
}
} else if (sl_type(expression) != state->tList) {
return expression;
} else if (sl_empty(state, expression) == state->sl_true) {
return expression;
} else if (sl_type(sl_first(state, expression)) == state->tSymbol) {
sl_value first = sl_first(state, expression);
if (state->s_def == first) {
assert(NUM2INT(sl_list_size(state, expression)) == 3);
sl_value second = sl_second(state, expression);
sl_value third = sl_third(state, expression);
return sl_def(state, second, sl_eval(state, third, environment));
} else if (state->s_quote == first) {
assert(NUM2INT(sl_list_size(state, expression)) == 2);
return sl_second(state, expression);
} else if (state->s_if == first) {
assert(NUM2INT(sl_list_size(state, expression)) == 4);
sl_value rest = sl_rest(state, expression);
sl_value result = sl_eval(state, sl_first(state, rest), environment);
if (result == state->sl_false) {
return sl_eval(state, sl_third(state, rest), environment);
} else {
return sl_eval(state, sl_second(state, rest), environment);
}
} else if (state->s_annotate == first) {
assert(NUM2INT(sl_list_size(state, expression)) == 3);
sl_value val = sl_eval(state, sl_second(state, expression), environment);
sl_value type = sl_eval(state, sl_third(state, expression), environment);
assert(sl_type(val) == type);
return val;
} else {
sl_value f = sl_eval(state, first, environment);
sl_value new_expression = sl_list_new(state, f, sl_rest(state, expression));
return sl_eval(state, new_expression, environment);
}
} else if (sl_type(sl_first(state, expression)) == state->tFunction) {
sl_value f = sl_first(state, expression);
sl_value args = sl_rest(state, expression);
/* TODO: make eval_each a map and eval */
return sl_apply(state, f, eval_each(state, args, environment));
} else {
fprintf(stderr, "Error: %s is not implemented yet\n", sl_string_cstring(state, sl_inspect(state, expression)));
abort();
}
}
sl_value
sl_def(struct sl_interpreter_state *state, sl_value name, sl_value value)
{
assert(sl_type(name) == state->tSymbol);
state->global_env = sl_alist_set(state, state->global_env, name, value);
return value;
}
sl_value
sl_identical(struct sl_interpreter_state *state, sl_value a, sl_value b)
{
return a == b ? state->sl_true : state->sl_false;
}
sl_value
sl_equal(struct sl_interpreter_state *state, sl_value a, sl_value b) {
if (a == b) {
return state->sl_true;
}
if(sl_type(a) != sl_type(b)) {
return state->sl_false;
}
sl_value type = sl_type(a);
if (type == state->tString) {
int result = strcmp(sl_string_cstring(state, a), sl_string_cstring(state, b));
return result == 0 ? state->sl_true : state->sl_false;
} else if (type == state->tInteger) {
return NUM2INT(a) == NUM2INT(b) ? state->sl_true : state->sl_false;
} else if (type == state->tList) {
if (NUM2INT(sl_list_size(state, a)) != NUM2INT(sl_list_size(state, b))) {
return state->sl_false;
}
sl_value first_a = sl_first(state, a);
sl_value first_b = sl_first(state, b);
if (sl_equal(state, first_a, first_b) == state->sl_true) {
sl_value rest_a = sl_rest(state, a);
sl_value rest_b = sl_rest(state, b);
return sl_equal(state, rest_a, rest_b);
} else {
return state->sl_false;
}
}
return state->sl_false;
}
void
sl_init_eval(struct sl_interpreter_state *state)
{
sl_define_function(state, "identical?", sl_identical, sl_list(state, 2, state->tAny, state->tAny));
sl_define_function(state, "=", sl_equal, sl_list(state, 2, state->tAny, state->tAny));
}