-
Notifications
You must be signed in to change notification settings - Fork 0
/
sunlark_loadstmts_remove.c
280 lines (261 loc) · 11.3 KB
/
sunlark_loadstmts_remove.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
#include <assert.h>
#include <ctype.h>
#include <errno.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <math.h>
#include "log.h"
#include "utarray.h"
#include "s7.h"
#include "sunlark_loadstmts_remove.h"
/* **************************************************************** */
/* already :load */
s7_pointer sunlark_loadstmts_remove(s7_scheme *s7, struct node_s *pkg_node,
s7_pointer get_path, s7_pointer selector)
{
#ifdef DEBUG_TRACE
log_debug(">> sunlark_loadstmts_remove: path %s, selector %s",
s7_object_to_c_string(s7, get_path),
s7_object_to_c_string(s7, selector));
#endif
assert(pkg_node->tid == TK_Package);
int path_len = s7_list_length(s7, get_path);
struct node_s *result;
if (get_path == s7_nil(s7)) {
/* case: (set! (pkg :load :0) :null) - delete one loadstmt */
int idx = sunlark_kwindex_to_int(s7, selector);
if (errno == 0) {
result = sealark_pkg_remove_loadstmt_at_int(pkg_node,
idx);
if (result)
return sunlark_new_node(s7, result);
else
return handle_errno(s7, errno, selector);
}
if (s7_is_string(selector)) {
result
= sealark_pkg_remove_loadstmt_at_key(
pkg_node,
s7_string(selector));
if (result)
return sunlark_new_node(s7, result);
else
return handle_errno(s7, errno, selector);
}
if (selector == KW(loadstmts)) {
/* if (update_val == KW(null)) { */
result = sealark_pkg_remove_all_loadstmts(pkg_node);
return sunlark_new_node(s7, result);
/* } else { */
/* log_error("Only action for selector :loads is :null"); */
/* return handle_errno(s7, EINVALID_ACTION, update_val); */
/* } */
}
log_error("UNHANDLED selector: %s",
s7_object_to_c_string(s7, selector));
return NULL;
/* other singleton selectors on pkg: :loadstmts, etc. */
}
/* special cases */
if (path_len == 1) {
int idx = sunlark_kwindex_to_int(s7, s7_car(get_path));
if (errno == 0) {
struct node_s *loadstmt
= sealark_pkg_loadstmt_for_int(pkg_node, idx);
if (loadstmt) {
if (selector == KW(args)) {
sealark_loadstmt_rm_args(loadstmt);
}
}
return NULL;
}
/* if (s7_car(get_path) == KW(load)) { */
if (selector == s7_make_keyword(s7, "*")) {
/* (set! (pkg :load :*) :null): rm all args and bindings */
/* if (update_val == KW(null)) { */
result = sealark_pkg_remove_all_loadstmts(pkg_node);
return sunlark_new_node(s7, result);
/* } else { */
/* log_error("Only action in this context for selector :load is :null"); */
/* return handle_errno(s7, EINVALID_ACTION, update_val); */
/* } */
} else {
errno = 0;
int idx = sunlark_kwindex_to_int(s7, selector);
if (errno == 0) {
result = sealark_pkg_remove_loadstmt_at_int(pkg_node,
idx);
if (result)
return sunlark_new_node(s7, result);
else
return handle_errno(s7, errno, selector);
} else {
/* selector not a kw int, must be a string */
if (s7_is_string(selector)) {
result
= sealark_pkg_remove_loadstmt_at_key(
pkg_node,
s7_string(selector));
if (result)
return sunlark_new_node(s7, result);
else
return handle_errno(s7, errno, selector);
} else {
log_error("In this context :load must be followed by an int (or kw int) or string key");
return handle_errno(s7, EINVALID_ARG,
selector);
}
}
log_error("special case: path == :load");
return NULL;
}
/* } */
log_error("special case len(get_path) == 1 ...");
}
if (path_len == 2) {
s7_pointer op1 = s7_car(get_path);
s7_pointer op2 = s7_cadr(get_path);
int idx = sunlark_kwindex_to_int(s7, op1); // s7_car(get_path));
if (errno == 0) { // int or kwint
struct node_s *loadstmt
= sealark_pkg_loadstmt_for_int(pkg_node, idx);
if (loadstmt) {
if (op2 == KW(arg)) {
errno = 0;
idx = sunlark_kwindex_to_int(s7, selector);
if (errno == 0) {
sealark_loadstmt_rm_arg_at_int(loadstmt, idx);
if (errno == 0)
return s7_unspecified(s7);
else
return NULL;
} else {
if (s7_is_string(selector)) {
const char *key = s7_string(selector);
/* log_debug("loadstmt rm arg at %s", key); */
errno = 0;
sealark_loadstmt_rm_arg_at_str(loadstmt, key);
if (errno == 0)
return s7_unspecified(s7);
else
return NULL;
return NULL;
}
log_error("Bad arg: %s", s7_object_to_c_string(s7, selector));
}
}
if (s7_is_string(op2)) {
log_error("loadstmt rm arg at %s", s7_object_to_c_string(s7, op2));
return NULL;
}
/* log_error("Bad arg: %s", s7_object_to_c_string(s7, selector)); */
/* return NULL; */
/* } */
if (op2 == KW(args)) {
sealark_loadstmt_rm_args(loadstmt);
}
if (op2 == KW(binding) || op2 == KW(@)) {
/* (:i :@) + selector */
/* selector must be int, kwint, or sym (binding key) */
idx = sunlark_kwindex_to_int(s7, selector);
if (errno == 0) { // int or kwint
/* log_debug("removing attr at %d", idx); */
errno == 0;
sealark_loadstmt_rm_attr_at_int(loadstmt, idx);
if (errno == 0)
return s7_unspecified(s7);
else
return NULL;
} else {
/* log_debug("indexing by %s", s7_object_to_c_string(s7, selector)); */
if (s7_is_symbol(selector)) {
errno == 0;
sealark_loadstmt_rm_attr_at_sym(loadstmt,
s7_symbol_name(selector));
if (errno == 0)
return s7_unspecified(s7);
else
return NULL;
} else {
log_error("Help!");
}
}
}
}
return NULL;
}
errno = 0; // reset after sunlark_kwindex_to_int
/* op1 not int nor kwint */
if (s7_is_string(op1)) { // index for loadstmt in pkg
struct node_s *loadstmt
= sealark_pkg_loadstmt_for_key(pkg_node, s7_string(op1));
//FIXME: following is same as for int/kwint deref
if (loadstmt) {
if (op2 == KW(arg)) {
errno = 0;
idx = sunlark_kwindex_to_int(s7, selector);
if (errno == 0) {
sealark_loadstmt_rm_arg_at_int(loadstmt, idx);
if (errno == 0)
return s7_unspecified(s7);
else
return NULL;
} else {
if (s7_is_string(selector)) {
const char *key = s7_string(selector);
/* log_debug("loadstmt rm arg at %s", key); */
errno = 0;
sealark_loadstmt_rm_arg_at_str(loadstmt, key);
if (errno == 0)
return s7_unspecified(s7);
else
return NULL;
}
log_error("Bad arg: %s", s7_object_to_c_string(s7, selector));
}
}
if (s7_is_string(op2)) {
log_debug("loadstmt rm arg at %s", s7_object_to_c_string(s7, op2));
return NULL;
}
if (op2 == KW(args)) {
sealark_loadstmt_rm_args(loadstmt);
}
if (op2 == KW(binding) || op2 == KW(@)) {
/* (:load "tgt" :@ ...) */
/* selector: int, kwint, or symbol */
idx = sunlark_kwindex_to_int(s7, selector);
if (errno == 0) { // int or kwint
sealark_loadstmt_rm_attr_at_int(loadstmt, idx);
if (errno == 0)
return s7_unspecified(s7);
else
return NULL;
} else {
if (s7_is_symbol(selector)) {
errno = 0;
sealark_loadstmt_rm_attr_at_sym(loadstmt,
s7_symbol_name(selector));
if (errno == 0)
return s7_unspecified(s7);
else
return NULL;
} else {
log_error("Invalid arg: expected int, kwint, or symbol; got %s", s7_object_to_c_string(s7, selector));
errno = EINVALID_LOAD_ARG;
return NULL;
}
}
}
log_error("Invalid arg: expected :arg, :@, :attr, or :binding; got %s", s7_object_to_c_string(s7, selector));
errno = EINVALID_LOAD_ARG;
return NULL;
}
}
/* op1 not int, kwint, nor string */
errno = EINVALID_LOAD_ARG;
log_error("op following :load must be int, kwint, or string");
return NULL;
}
}