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
|
#include "syntax.h"
#include "ctx.h"
#include "eval.h"
lsp_builtin_entry_t lsp_syntaxes[] = {
{"lambda", lsp_syntax_lambda}, {"syntax", lsp_syntax_syntax},
{"define", lsp_syntax_define}, {"set!", lsp_syntax_set},
{"begin", lsp_syntax_begin}, {"quote", lsp_syntax_quote},
{"if", lsp_syntax_if}, {NULL, NULL}};
lsp_status_t lsp_syntax_lambda(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
if (args == e->m->nil)
return LSP_ERR_ARG_COUNT;
lsp_addr_t fn_args = lsp_mem_get_pair_first(e->m, args);
lsp_addr_t fn_body = lsp_mem_get_pair_second(e->m, args);
if (!lsp_mem_is_symbol(e->m, fn_args) && !lsp_mem_is_pair(e->m, fn_args))
return LSP_ERR_ARG_TYPE;
if (fn_body == e->m->nil)
return LSP_ERR_ARG_COUNT;
lsp_addr_t ctx_copy;
lsp_status_t status = lsp_ctx_copy(e->m, ctx, &ctx_copy);
if (status != LSP_SUCCESS)
return status;
lsp_addr_t result;
status = lsp_mem_create_function(e->m, ctx_copy, fn_args, fn_body, &result);
lsp_mem_dec_ref(e->m, ctx_copy);
if (status != LSP_SUCCESS)
return status;
status = lsp_env_set_result_value(e, result);
lsp_mem_dec_ref(e->m, result);
return status;
}
lsp_status_t lsp_syntax_syntax(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
if (args == e->m->nil)
return LSP_ERR_ARG_COUNT;
lsp_addr_t syntax_args = lsp_mem_get_pair_first(e->m, args);
lsp_addr_t syntax_body = lsp_mem_get_pair_second(e->m, args);
if (!lsp_mem_is_symbol(e->m, syntax_args) &&
!lsp_mem_is_pair(e->m, syntax_args))
return LSP_ERR_ARG_TYPE;
if (syntax_body == e->m->nil)
return LSP_ERR_ARG_COUNT;
lsp_addr_t ctx_copy;
lsp_status_t status = lsp_ctx_copy(e->m, ctx, &ctx_copy);
if (status != LSP_SUCCESS)
return status;
lsp_addr_t result;
status = lsp_mem_create_syntax(e->m, ctx_copy, syntax_args, syntax_body,
&result);
lsp_mem_dec_ref(e->m, ctx_copy);
if (status != LSP_SUCCESS)
return status;
status = lsp_env_set_result_value(e, result);
lsp_mem_dec_ref(e->m, result);
return status;
}
lsp_status_t lsp_syntax_define(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
lsp_addr_t symbol;
lsp_addr_t value;
lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &symbol, &value);
if (status != LSP_SUCCESS)
return status;
if (!lsp_mem_is_symbol(e->m, symbol))
return LSP_ERR_ARG_TYPE;
status = lsp_env_resolve(e, ctx, value, &value);
if (status != LSP_SUCCESS)
return status;
status = lsp_ctx_add(e->m, ctx, symbol, value);
lsp_mem_dec_ref(e->m, value);
if (status != LSP_SUCCESS)
return status;
return lsp_env_set_result_value(e, e->m->nil);
}
lsp_status_t lsp_syntax_set(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
lsp_addr_t symbol;
lsp_addr_t value;
lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &symbol, &value);
if (status != LSP_SUCCESS)
return status;
if (!lsp_mem_is_symbol(e->m, symbol))
return LSP_ERR_ARG_TYPE;
status = lsp_env_resolve(e, ctx, value, &value);
if (status != LSP_SUCCESS)
return status;
status = lsp_ctx_set(e->m, ctx, symbol, value);
lsp_mem_dec_ref(e->m, value);
if (status != LSP_SUCCESS)
return status;
return lsp_env_set_result_value(e, e->m->nil);
}
lsp_status_t lsp_syntax_begin(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
if (args == e->m->nil)
return LSP_ERR_ARG_COUNT;
while (true) {
lsp_addr_t value = lsp_mem_get_pair_first(e->m, args);
lsp_addr_t next_args = lsp_mem_get_pair_second(e->m, args);
if (next_args == e->m->nil)
return lsp_env_set_result_eval(e, ctx, value);
lsp_status_t status = lsp_env_resolve(e, ctx, value, &value);
if (status != LSP_SUCCESS)
return status;
lsp_mem_dec_ref(e->m, value);
args = next_args;
}
}
lsp_status_t lsp_syntax_quote(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
lsp_addr_t value;
lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value);
if (status != LSP_SUCCESS)
return status;
return lsp_env_set_result_value(e, value);
}
lsp_status_t lsp_syntax_if(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
if (args == e->m->nil)
return LSP_ERR_ARG_COUNT;
lsp_addr_t test = lsp_mem_get_pair_first(e->m, args);
args = lsp_mem_get_pair_second(e->m, args);
if (args == e->m->nil)
return LSP_ERR_ARG_COUNT;
lsp_addr_t true_value = lsp_mem_get_pair_first(e->m, args);
lsp_addr_t false_value;
args = lsp_mem_get_pair_second(e->m, args);
if (args == e->m->nil) {
false_value = e->m->nil;
} else {
false_value = lsp_mem_get_pair_first(e->m, args);
args = lsp_mem_get_pair_second(e->m, args);
}
if (args != e->m->nil)
return LSP_ERR_ARG_COUNT;
lsp_status_t status = lsp_env_resolve(e, ctx, test, &test);
if (status != LSP_SUCCESS)
return status;
lsp_bool_t is_false = (lsp_mem_is_number(e->m, test) &&
lsp_mem_get_number(e->m, test) == 0) ||
(lsp_mem_is_pair(e->m, test) && test == e->m->nil) ||
(lsp_mem_is_string(e->m, test) &&
lsp_mem_get_string_len(e->m, test) == 0) ||
(lsp_mem_is_symbol(e->m, test) &&
lsp_mem_get_symbol_len(e->m, test) == 0);
lsp_mem_dec_ref(e->m, test);
return lsp_env_set_result_eval(e, ctx,
(is_false ? false_value : true_value));
}
|
