/src/augeas/src/builtin.c
Line | Count | Source (jump to first uncovered line) |
1 | | /* |
2 | | * builtin.c: builtin primitives |
3 | | * |
4 | | * Copyright (C) 2007-2016 David Lutterkort |
5 | | * |
6 | | * This library is free software; you can redistribute it and/or |
7 | | * modify it under the terms of the GNU Lesser General Public |
8 | | * License as published by the Free Software Foundation; either |
9 | | * version 2.1 of the License, or (at your option) any later version. |
10 | | * |
11 | | * This library is distributed in the hope that it will be useful, |
12 | | * but WITHOUT ANY WARRANTY; without even the implied warranty of |
13 | | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
14 | | * Lesser General Public License for more details. |
15 | | * |
16 | | * You should have received a copy of the GNU Lesser General Public |
17 | | * License along with this library; if not, write to the Free Software |
18 | | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
19 | | * |
20 | | * Author: David Lutterkort <dlutter@redhat.com> |
21 | | */ |
22 | | |
23 | | #include <config.h> |
24 | | #include <stdio.h> |
25 | | #include <stdarg.h> |
26 | | #include <errno.h> |
27 | | #include <stdlib.h> |
28 | | |
29 | | #include "syntax.h" |
30 | | #include "memory.h" |
31 | | #include "transform.h" |
32 | | #include "errcode.h" |
33 | | |
34 | | #define UNIMPL_BODY(name) \ |
35 | | { \ |
36 | | FIXME(#name " called"); \ |
37 | | abort(); \ |
38 | | } |
39 | | |
40 | | /* |
41 | | * Lenses |
42 | | */ |
43 | | |
44 | | /* V_REGEXP -> V_STRING -> V_LENS */ |
45 | 0 | static struct value *lns_del(struct info *info, struct value **argv) { |
46 | 0 | struct value *rxp = argv[0]; |
47 | 0 | struct value *dflt = argv[1]; |
48 | |
|
49 | 0 | assert(rxp->tag == V_REGEXP); |
50 | 0 | assert(dflt->tag == V_STRING); |
51 | 0 | return lns_make_prim(L_DEL, ref(info), |
52 | 0 | ref(rxp->regexp), ref(dflt->string)); |
53 | 0 | } |
54 | | |
55 | | /* V_REGEXP -> V_LENS */ |
56 | 0 | static struct value *lns_store(struct info *info, struct value **argv) { |
57 | 0 | struct value *rxp = argv[0]; |
58 | |
|
59 | 0 | assert(rxp->tag == V_REGEXP); |
60 | 0 | return lns_make_prim(L_STORE, ref(info), ref(rxp->regexp), NULL); |
61 | 0 | } |
62 | | |
63 | | /* V_STRING -> V_LENS */ |
64 | 0 | static struct value *lns_value(struct info *info, struct value **argv) { |
65 | 0 | struct value *str = argv[0]; |
66 | |
|
67 | 0 | assert(str->tag == V_STRING); |
68 | 0 | return lns_make_prim(L_VALUE, ref(info), NULL, ref(str->string)); |
69 | 0 | } |
70 | | |
71 | | /* V_REGEXP -> V_LENS */ |
72 | 0 | static struct value *lns_key(struct info *info, struct value **argv) { |
73 | 0 | struct value *rxp = argv[0]; |
74 | |
|
75 | 0 | assert(rxp->tag == V_REGEXP); |
76 | 0 | return lns_make_prim(L_KEY, ref(info), ref(rxp->regexp), NULL); |
77 | 0 | } |
78 | | |
79 | | /* V_STRING -> V_LENS */ |
80 | 0 | static struct value *lns_label(struct info *info, struct value **argv) { |
81 | 0 | struct value *str = argv[0]; |
82 | |
|
83 | 0 | assert(str->tag == V_STRING); |
84 | 0 | return lns_make_prim(L_LABEL, ref(info), NULL, ref(str->string)); |
85 | 0 | } |
86 | | |
87 | | /* V_STRING -> V_LENS */ |
88 | 0 | static struct value *lns_seq(struct info *info, struct value **argv) { |
89 | 0 | struct value *str = argv[0]; |
90 | |
|
91 | 0 | assert(str->tag == V_STRING); |
92 | 0 | return lns_make_prim(L_SEQ, ref(info), NULL, ref(str->string)); |
93 | 0 | } |
94 | | |
95 | | /* V_STRING -> V_LENS */ |
96 | 0 | static struct value *lns_counter(struct info *info, struct value **argv) { |
97 | 0 | struct value *str = argv[0]; |
98 | |
|
99 | 0 | assert(str->tag == V_STRING); |
100 | 0 | return lns_make_prim(L_COUNTER, ref(info), NULL, ref(str->string)); |
101 | 0 | } |
102 | | |
103 | | /* V_LENS -> V_LENS -> V_LENS -> V_LENS */ |
104 | 0 | static struct value *lns_square(struct info *info, struct value **argv) { |
105 | 0 | struct value *l1 = argv[0]; |
106 | 0 | struct value *l2 = argv[1]; |
107 | 0 | struct value *l3 = argv[2]; |
108 | |
|
109 | 0 | assert(l1->tag == V_LENS); |
110 | 0 | assert(l2->tag == V_LENS); |
111 | 0 | assert(l3->tag == V_LENS); |
112 | 0 | int check = typecheck_p(info); |
113 | |
|
114 | 0 | return lns_make_square(ref(info), ref(l1->lens), ref(l2->lens), ref(l3->lens), check); |
115 | 0 | } |
116 | | |
117 | | static void exn_lns_error_detail(struct value *exn, const char *label, |
118 | 0 | struct lens *lens) { |
119 | 0 | if (lens == NULL) |
120 | 0 | return; |
121 | | |
122 | 0 | char *s = format_info(lens->info); |
123 | 0 | exn_printf_line(exn, "%s: %s", label, s); |
124 | 0 | free(s); |
125 | 0 | } |
126 | | |
127 | | static struct value *make_exn_lns_error(struct info *info, |
128 | | struct lns_error *err, |
129 | 0 | const char *text) { |
130 | 0 | struct value *v; |
131 | |
|
132 | 0 | if (HAS_ERR(info)) |
133 | 0 | return info->error->exn; |
134 | | |
135 | 0 | v = make_exn_value(ref(info), "%s", err->message); |
136 | 0 | exn_lns_error_detail(v, "Lens", err->lens); |
137 | 0 | exn_lns_error_detail(v, " Last match", err->last); |
138 | 0 | exn_lns_error_detail(v, " Not matching", err->next); |
139 | 0 | if (err->pos >= 0) { |
140 | 0 | char *pos = format_pos(text, err->pos); |
141 | 0 | size_t line, ofs; |
142 | 0 | calc_line_ofs(text, err->pos, &line, &ofs); |
143 | 0 | exn_printf_line(v, |
144 | 0 | "Error encountered at %d:%d (%d characters into string)", |
145 | 0 | (int) line, (int) ofs, err->pos); |
146 | 0 | if (pos != NULL) |
147 | 0 | exn_printf_line(v, "%s", pos); |
148 | 0 | free(pos); |
149 | 0 | } else { |
150 | 0 | exn_printf_line(v, "Error encountered at path %s", err->path); |
151 | 0 | } |
152 | |
|
153 | 0 | return v; |
154 | 0 | } |
155 | | |
156 | 0 | static void exn_print_tree(struct value *exn, struct tree *tree) { |
157 | 0 | struct memstream ms; |
158 | |
|
159 | 0 | init_memstream(&ms); |
160 | 0 | dump_tree(ms.stream, tree); |
161 | 0 | close_memstream(&ms); |
162 | 0 | exn_printf_line(exn, "%s", ms.buf); |
163 | 0 | FREE(ms.buf); |
164 | 0 | } |
165 | | |
166 | 0 | static struct value *make_pathx_exn(struct info *info, struct pathx *p) { |
167 | 0 | struct value *v; |
168 | 0 | char *msg; |
169 | 0 | const char *txt, *px_err; |
170 | 0 | int pos; |
171 | |
|
172 | 0 | px_err = pathx_error(p, &txt, &pos); |
173 | 0 | v = make_exn_value(ref(info), "syntax error in path expression: %s", |
174 | 0 | px_err); |
175 | |
|
176 | 0 | if (ALLOC_N(msg, strlen(txt) + 4) >= 0) { |
177 | 0 | strncpy(msg, txt, pos); |
178 | 0 | strcat(msg, "|=|"); |
179 | 0 | strcat(msg, txt + pos); |
180 | 0 | exn_add_lines(v, 1, msg); |
181 | 0 | } |
182 | 0 | return v; |
183 | 0 | } |
184 | | |
185 | | static struct value *pathx_parse_glue(struct info *info, struct value *tree, |
186 | 0 | struct value *path, struct pathx **p) { |
187 | 0 | assert(path->tag == V_STRING); |
188 | 0 | assert(tree->tag == V_TREE); |
189 | | |
190 | 0 | if (pathx_parse(tree->origin, info->error, path->string->str, true, |
191 | 0 | NULL, NULL, p) != PATHX_NOERROR) { |
192 | 0 | return make_pathx_exn(info, *p); |
193 | 0 | } else { |
194 | 0 | return NULL; |
195 | 0 | } |
196 | 0 | } |
197 | | |
198 | | /* V_LENS -> V_STRING -> V_TREE */ |
199 | 0 | static struct value *lens_get(struct info *info, struct value **argv) { |
200 | 0 | struct value *l = argv[0]; |
201 | 0 | struct value *str = argv[1]; |
202 | |
|
203 | 0 | assert(l->tag == V_LENS); |
204 | 0 | assert(str->tag == V_STRING); |
205 | 0 | struct lns_error *err; |
206 | 0 | struct value *v; |
207 | 0 | const char *text = str->string->str; |
208 | |
|
209 | 0 | struct tree *tree = lns_get(info, l->lens, text, 0, &err); |
210 | 0 | if (err == NULL && ! HAS_ERR(info)) { |
211 | 0 | v = make_value(V_TREE, ref(info)); |
212 | 0 | v->origin = make_tree_origin(tree); |
213 | 0 | } else { |
214 | 0 | struct tree *t = make_tree_origin(tree); |
215 | 0 | if (t == NULL) |
216 | 0 | free_tree(tree); |
217 | 0 | tree = t; |
218 | |
|
219 | 0 | v = make_exn_lns_error(info, err, text); |
220 | 0 | if (tree != NULL) { |
221 | 0 | exn_printf_line(v, "Tree generated so far:"); |
222 | 0 | exn_print_tree(v, tree); |
223 | 0 | free_tree(tree); |
224 | 0 | } |
225 | 0 | free_lns_error(err); |
226 | 0 | } |
227 | 0 | return v; |
228 | 0 | } |
229 | | |
230 | | |
231 | | /* V_LENS -> V_TREE -> V_STRING -> V_STRING */ |
232 | 0 | static struct value *lens_put(struct info *info, struct value **argv) { |
233 | 0 | struct value *l = argv[0]; |
234 | 0 | struct value *tree = argv[1]; |
235 | 0 | struct value *str = argv[2]; |
236 | |
|
237 | 0 | assert(l->tag == V_LENS); |
238 | 0 | assert(tree->tag == V_TREE); |
239 | 0 | assert(str->tag == V_STRING); |
240 | | |
241 | 0 | struct memstream ms; |
242 | 0 | struct value *v; |
243 | 0 | struct lns_error *err; |
244 | |
|
245 | 0 | init_memstream(&ms); |
246 | 0 | lns_put(info, ms.stream, l->lens, tree->origin->children, |
247 | 0 | str->string->str, 0, &err); |
248 | 0 | close_memstream(&ms); |
249 | |
|
250 | 0 | if (err == NULL && ! HAS_ERR(info)) { |
251 | 0 | v = make_value(V_STRING, ref(info)); |
252 | 0 | v->string = make_string(ms.buf); |
253 | 0 | } else { |
254 | 0 | v = make_exn_lns_error(info, err, str->string->str); |
255 | 0 | free_lns_error(err); |
256 | 0 | FREE(ms.buf); |
257 | 0 | } |
258 | 0 | return v; |
259 | 0 | } |
260 | | |
261 | | /* V_STRING -> V_STRING -> V_TREE -> V_TREE */ |
262 | 0 | static struct value *tree_set_glue(struct info *info, struct value **argv) { |
263 | | // FIXME: This only works if TREE is not referenced more than once; |
264 | | // otherwise we'll have some pretty weird semantics, and would really |
265 | | // need to copy TREE first |
266 | 0 | struct value *path = argv[0]; |
267 | 0 | struct value *val = argv[1]; |
268 | 0 | struct value *tree = argv[2]; |
269 | |
|
270 | 0 | assert(path->tag == V_STRING); |
271 | 0 | assert(val->tag == V_STRING); |
272 | 0 | assert(tree->tag == V_TREE); |
273 | | |
274 | 0 | struct tree *fake = NULL; |
275 | 0 | struct pathx *p = NULL; |
276 | 0 | struct value *result = NULL; |
277 | |
|
278 | 0 | if (tree->origin->children == NULL) { |
279 | 0 | tree->origin->children = make_tree(NULL, NULL, tree->origin, NULL); |
280 | 0 | fake = tree->origin->children; |
281 | 0 | } |
282 | |
|
283 | 0 | result = pathx_parse_glue(info, tree, path, &p); |
284 | 0 | if (result != NULL) |
285 | 0 | goto done; |
286 | | |
287 | 0 | if (tree_set(p, val->string->str) == NULL) { |
288 | 0 | result = make_exn_value(ref(info), |
289 | 0 | "Tree set of %s to '%s' failed", |
290 | 0 | path->string->str, val->string->str); |
291 | 0 | goto done; |
292 | 0 | } |
293 | 0 | if (fake != NULL) { |
294 | 0 | list_remove(fake, tree->origin->children); |
295 | 0 | free_tree(fake); |
296 | 0 | } |
297 | 0 | result = ref(tree); |
298 | |
|
299 | 0 | done: |
300 | 0 | free_pathx(p); |
301 | 0 | return result; |
302 | 0 | } |
303 | | |
304 | | /* V_STRING -> V_TREE -> V_TREE */ |
305 | 0 | static struct value *tree_clear_glue(struct info *info, struct value **argv) { |
306 | | // FIXME: This only works if TREE is not referenced more than once; |
307 | | // otherwise we'll have some pretty weird semantics, and would really |
308 | | // need to copy TREE first |
309 | 0 | struct value *path = argv[0]; |
310 | 0 | struct value *tree = argv[1]; |
311 | |
|
312 | 0 | assert(path->tag == V_STRING); |
313 | 0 | assert(tree->tag == V_TREE); |
314 | | |
315 | 0 | struct tree *fake = NULL; |
316 | 0 | struct pathx *p = NULL; |
317 | 0 | struct value *result = NULL; |
318 | |
|
319 | 0 | if (tree->origin->children == NULL) { |
320 | 0 | tree->origin->children = make_tree(NULL, NULL, tree->origin, NULL); |
321 | 0 | fake = tree->origin->children; |
322 | 0 | } |
323 | |
|
324 | 0 | result = pathx_parse_glue(info, tree, path, &p); |
325 | 0 | if (result != NULL) |
326 | 0 | goto done; |
327 | | |
328 | 0 | if (tree_set(p, NULL) == NULL) { |
329 | 0 | result = make_exn_value(ref(info), |
330 | 0 | "Tree set of %s to NULL failed", |
331 | 0 | path->string->str); |
332 | 0 | goto done; |
333 | 0 | } |
334 | 0 | if (fake != NULL) { |
335 | 0 | list_remove(fake, tree->origin->children); |
336 | 0 | free_tree(fake); |
337 | 0 | } |
338 | 0 | result = ref(tree); |
339 | |
|
340 | 0 | done: |
341 | 0 | free_pathx(p); |
342 | 0 | return result; |
343 | 0 | } |
344 | | |
345 | | static struct value *tree_insert_glue(struct info *info, struct value *label, |
346 | | struct value *path, struct value *tree, |
347 | 0 | int before) { |
348 | | // FIXME: This only works if TREE is not referenced more than once; |
349 | | // otherwise we'll have some pretty weird semantics, and would really |
350 | | // need to copy TREE first |
351 | 0 | assert(label->tag == V_STRING); |
352 | 0 | assert(path->tag == V_STRING); |
353 | 0 | assert(tree->tag == V_TREE); |
354 | | |
355 | 0 | int r; |
356 | 0 | struct pathx *p = NULL; |
357 | 0 | struct value *result = NULL; |
358 | |
|
359 | 0 | result = pathx_parse_glue(info, tree, path, &p); |
360 | 0 | if (result != NULL) |
361 | 0 | goto done; |
362 | | |
363 | 0 | r = tree_insert(p, label->string->str, before); |
364 | 0 | if (r != 0) { |
365 | 0 | result = make_exn_value(ref(info), |
366 | 0 | "Tree insert of %s at %s failed", |
367 | 0 | label->string->str, path->string->str); |
368 | 0 | goto done; |
369 | 0 | } |
370 | | |
371 | 0 | result = ref(tree); |
372 | 0 | done: |
373 | 0 | free_pathx(p); |
374 | 0 | return result; |
375 | 0 | } |
376 | | |
377 | | /* Insert after */ |
378 | | /* V_STRING -> V_STRING -> V_TREE -> V_TREE */ |
379 | 0 | static struct value *tree_insa_glue(struct info *info, struct value **argv) { |
380 | 0 | struct value *label = argv[0]; |
381 | 0 | struct value *path = argv[1]; |
382 | 0 | struct value *tree = argv[2]; |
383 | |
|
384 | 0 | return tree_insert_glue(info, label, path, tree, 0); |
385 | 0 | } |
386 | | |
387 | | /* Insert before */ |
388 | | /* V_STRING -> V_STRING -> V_TREE -> V_TREE */ |
389 | 0 | static struct value *tree_insb_glue(struct info *info, struct value **argv) { |
390 | 0 | struct value *label = argv[0]; |
391 | 0 | struct value *path = argv[1]; |
392 | 0 | struct value *tree = argv[2]; |
393 | |
|
394 | 0 | return tree_insert_glue(info, label, path, tree, 1); |
395 | 0 | } |
396 | | |
397 | | /* V_STRING -> V_TREE -> V_TREE */ |
398 | 0 | static struct value *tree_rm_glue(struct info *info, struct value **argv) { |
399 | | // FIXME: This only works if TREE is not referenced more than once; |
400 | | // otherwise we'll have some pretty weird semantics, and would really |
401 | | // need to copy TREE first |
402 | 0 | struct value *path = argv[0]; |
403 | 0 | struct value *tree = argv[1]; |
404 | |
|
405 | 0 | assert(path->tag == V_STRING); |
406 | 0 | assert(tree->tag == V_TREE); |
407 | | |
408 | 0 | struct pathx *p = NULL; |
409 | 0 | struct value *result = NULL; |
410 | |
|
411 | 0 | result = pathx_parse_glue(info, tree, path, &p); |
412 | 0 | if (result != NULL) |
413 | 0 | goto done; |
414 | | |
415 | 0 | if (tree_rm(p) == -1) { |
416 | 0 | result = make_exn_value(ref(info), "Tree rm of %s failed", |
417 | 0 | path->string->str); |
418 | 0 | goto done; |
419 | 0 | } |
420 | 0 | result = ref(tree); |
421 | 0 | done: |
422 | 0 | free_pathx(p); |
423 | 0 | return result; |
424 | 0 | } |
425 | | |
426 | | /* V_STRING -> V_STRING */ |
427 | 0 | static struct value *gensym(struct info *info, struct value **argv) { |
428 | 0 | struct value *prefix = argv[0]; |
429 | |
|
430 | 0 | assert(prefix->tag == V_STRING); |
431 | 0 | static unsigned int count = 0; |
432 | 0 | struct value *v; |
433 | 0 | char *s; |
434 | 0 | int r; |
435 | |
|
436 | 0 | r = asprintf(&s, "%s%u", prefix->string->str, count); |
437 | 0 | if (r == -1) |
438 | 0 | return NULL; |
439 | 0 | v = make_value(V_STRING, ref(info)); |
440 | 0 | v->string = make_string(s); |
441 | 0 | return v; |
442 | 0 | } |
443 | | |
444 | | /* V_STRING -> V_FILTER */ |
445 | 0 | static struct value *xform_incl(struct info *info, struct value **argv) { |
446 | 0 | struct value *s = argv[0]; |
447 | |
|
448 | 0 | assert(s->tag == V_STRING); |
449 | 0 | struct value *v = make_value(V_FILTER, ref(info)); |
450 | 0 | v->filter = make_filter(ref(s->string), 1); |
451 | 0 | return v; |
452 | 0 | } |
453 | | |
454 | | /* V_STRING -> V_FILTER */ |
455 | 0 | static struct value *xform_excl(struct info *info, struct value **argv) { |
456 | 0 | struct value *s = argv[0]; |
457 | |
|
458 | 0 | assert(s->tag == V_STRING); |
459 | 0 | struct value *v = make_value(V_FILTER, ref(info)); |
460 | 0 | v->filter = make_filter(ref(s->string), 0); |
461 | 0 | return v; |
462 | 0 | } |
463 | | |
464 | | /* V_LENS -> V_FILTER -> V_TRANSFORM */ |
465 | 0 | static struct value *xform_transform(struct info *info, struct value **argv) { |
466 | 0 | struct value *l = argv[0]; |
467 | 0 | struct value *f = argv[1]; |
468 | |
|
469 | 0 | assert(l->tag == V_LENS); |
470 | 0 | assert(f->tag == V_FILTER); |
471 | 0 | if (l->lens->value || l->lens->key) { |
472 | 0 | return make_exn_value(ref(info), "Can not build a transform " |
473 | 0 | "from a lens that leaves a %s behind", |
474 | 0 | l->lens->key ? "key" : "value"); |
475 | 0 | } |
476 | 0 | struct value *v = make_value(V_TRANSFORM, ref(info)); |
477 | 0 | v->transform = make_transform(ref(l->lens), ref(f->filter)); |
478 | 0 | return v; |
479 | 0 | } |
480 | | |
481 | 0 | static struct value *sys_getenv(struct info *info, struct value **argv) { |
482 | 0 | assert(argv[0]->tag == V_STRING); |
483 | 0 | struct value *v = make_value(V_STRING, ref(info)); |
484 | 0 | v->string = dup_string(getenv(argv[0]->string->str)); |
485 | 0 | return v; |
486 | 0 | } |
487 | | |
488 | 0 | static struct value *sys_read_file(struct info *info, struct value **argv) { |
489 | 0 | struct value *n = argv[0]; |
490 | |
|
491 | 0 | assert(n->tag == V_STRING); |
492 | 0 | char *str = NULL; |
493 | |
|
494 | 0 | str = xread_file(n->string->str); |
495 | 0 | if (str == NULL) { |
496 | 0 | char error_buf[1024]; |
497 | 0 | const char *errmsg; |
498 | 0 | errmsg = xstrerror(errno, error_buf, sizeof(error_buf)); |
499 | 0 | struct value *exn = make_exn_value(ref(info), |
500 | 0 | "reading file %s failed:", n->string->str); |
501 | 0 | exn_printf_line(exn, "%s", errmsg); |
502 | 0 | return exn; |
503 | 0 | } |
504 | 0 | struct value *v = make_value(V_STRING, ref(info)); |
505 | 0 | v->string = make_string(str); |
506 | 0 | return v; |
507 | 0 | } |
508 | | |
509 | | /* V_LENS -> V_LENS */ |
510 | | static struct value *lns_check_rec_glue(struct info *info, |
511 | 0 | struct value **argv) { |
512 | 0 | struct value *l = argv[0]; |
513 | 0 | struct value *r = argv[1]; |
514 | |
|
515 | 0 | assert(l->tag == V_LENS); |
516 | 0 | assert(r->tag == V_LENS); |
517 | 0 | int check = typecheck_p(info); |
518 | |
|
519 | 0 | return lns_check_rec(info, l->lens, r->lens, check); |
520 | 0 | } |
521 | | |
522 | | /* |
523 | | * Print functions |
524 | | */ |
525 | | |
526 | | /* V_STRING -> V_UNIT */ |
527 | 0 | static struct value *pr_string(struct info *info, struct value **argv) { |
528 | 0 | printf("%s", argv[0]->string->str); |
529 | 0 | return make_unit(ref(info)); |
530 | 0 | } |
531 | | |
532 | | /* V_REGEXP -> V_UNIT */ |
533 | 0 | static struct value *pr_regexp(struct info *info, struct value **argv) { |
534 | 0 | print_regexp(stdout, argv[0]->regexp); |
535 | 0 | return make_unit(ref(info)); |
536 | 0 | } |
537 | | |
538 | | /* V_STRING -> V_UNIT */ |
539 | 0 | static struct value *pr_endline(struct info *info, struct value **argv) { |
540 | 0 | printf("%s\n", argv[0]->string->str); |
541 | 0 | return make_unit(ref(info)); |
542 | 0 | } |
543 | | |
544 | | /* V_TREE -> V_TREE */ |
545 | | static struct value *pr_tree(ATTRIBUTE_UNUSED struct info *info, |
546 | 0 | struct value **argv) { |
547 | 0 | print_tree_braces(stdout, 0, argv[0]->origin); |
548 | 0 | return ref(argv[0]); |
549 | 0 | } |
550 | | |
551 | | /* |
552 | | * Lens inspection |
553 | | */ |
554 | | |
555 | 0 | static struct value *lns_value_of_type(struct info *info, struct regexp *rx) { |
556 | 0 | struct value *result = make_value(V_REGEXP, ref(info)); |
557 | 0 | if (rx) |
558 | 0 | result->regexp = ref(rx); |
559 | 0 | else |
560 | 0 | result->regexp = regexp_make_empty(ref(info)); |
561 | 0 | return result; |
562 | 0 | } |
563 | | |
564 | | /* V_LENS -> V_REGEXP */ |
565 | 0 | static struct value *lns_ctype(struct info *info, struct value **argv) { |
566 | 0 | return lns_value_of_type(info, argv[0]->lens->ctype); |
567 | 0 | } |
568 | | |
569 | | /* V_LENS -> V_REGEXP */ |
570 | 0 | static struct value *lns_atype(struct info *info, struct value **argv) { |
571 | 0 | return lns_value_of_type(info, argv[0]->lens->atype); |
572 | 0 | } |
573 | | |
574 | | /* V_LENS -> V_REGEXP */ |
575 | 0 | static struct value *lns_vtype(struct info *info, struct value **argv) { |
576 | 0 | return lns_value_of_type(info, argv[0]->lens->vtype); |
577 | 0 | } |
578 | | |
579 | | /* V_LENS -> V_REGEXP */ |
580 | 0 | static struct value *lns_ktype(struct info *info, struct value **argv) { |
581 | 0 | return lns_value_of_type(info, argv[0]->lens->ktype); |
582 | 0 | } |
583 | | |
584 | | /* V_LENS -> V_STRING */ |
585 | 0 | static struct value *lns_fmt_atype(struct info *info, struct value **argv) { |
586 | 0 | struct value *l = argv[0]; |
587 | |
|
588 | 0 | struct value *result = NULL; |
589 | 0 | char *s = NULL; |
590 | 0 | int r; |
591 | |
|
592 | 0 | r = lns_format_atype(l->lens, &s); |
593 | 0 | if (r < 0) |
594 | 0 | return info->error->exn; |
595 | 0 | result = make_value(V_STRING, ref(info)); |
596 | 0 | result->string = make_string(s); |
597 | 0 | return result; |
598 | 0 | } |
599 | | |
600 | | /* V_REGEXP -> V_STRING -> V_STRING */ |
601 | 0 | static struct value *rx_match(struct info *info, struct value **argv) { |
602 | 0 | struct value *rx = argv[0]; |
603 | 0 | struct value *s = argv[1]; |
604 | |
|
605 | 0 | struct value *result = NULL; |
606 | 0 | const char *str = s->string->str; |
607 | 0 | struct re_registers regs; |
608 | 0 | int r; |
609 | |
|
610 | 0 | MEMZERO(®s, 1); |
611 | 0 | r = regexp_match(rx->regexp, str, strlen(str), 0, ®s); |
612 | 0 | if (r < -1) { |
613 | 0 | result = |
614 | 0 | make_exn_value(ref(info), "regexp match failed (internal error)"); |
615 | 0 | } else { |
616 | 0 | char *match = NULL; |
617 | 0 | if (r == -1) { |
618 | | /* No match */ |
619 | 0 | match = strdup(""); |
620 | 0 | } else { |
621 | 0 | match = strndup(str + regs.start[0], regs.end[0] - regs.start[0]); |
622 | 0 | } |
623 | 0 | if (match == NULL) { |
624 | 0 | result = info->error->exn; |
625 | 0 | } else { |
626 | 0 | result = make_value(V_STRING, ref(info)); |
627 | 0 | result->string = make_string(match); |
628 | 0 | } |
629 | 0 | } |
630 | 0 | return result; |
631 | 0 | } |
632 | | |
633 | 1.63k | struct module *builtin_init(struct error *error) { |
634 | 1.63k | struct module *modl = module_create("Builtin"); |
635 | 1.63k | int r; |
636 | | |
637 | 1.63k | #define DEFINE_NATIVE(modl, name, nargs, impl, types ...) \ |
638 | 52.4k | r = define_native(error, modl, name, nargs, impl, ##types); \ |
639 | 52.4k | if (r < 0) goto error; |
640 | | |
641 | 1.63k | DEFINE_NATIVE(modl, "gensym", 1, gensym, T_STRING, T_STRING); |
642 | | |
643 | | /* Primitive lenses */ |
644 | 1.63k | DEFINE_NATIVE(modl, "del", 2, lns_del, T_REGEXP, T_STRING, T_LENS); |
645 | 1.63k | DEFINE_NATIVE(modl, "store", 1, lns_store, T_REGEXP, T_LENS); |
646 | 1.63k | DEFINE_NATIVE(modl, "value", 1, lns_value, T_STRING, T_LENS); |
647 | 1.63k | DEFINE_NATIVE(modl, "key", 1, lns_key, T_REGEXP, T_LENS); |
648 | 1.63k | DEFINE_NATIVE(modl, "label", 1, lns_label, T_STRING, T_LENS); |
649 | 1.63k | DEFINE_NATIVE(modl, "seq", 1, lns_seq, T_STRING, T_LENS); |
650 | 1.63k | DEFINE_NATIVE(modl, "counter", 1, lns_counter, T_STRING, T_LENS); |
651 | 1.63k | DEFINE_NATIVE(modl, "square", 3, lns_square, T_LENS, T_LENS, T_LENS, T_LENS); |
652 | | /* Applying lenses (mostly for tests) */ |
653 | 1.63k | DEFINE_NATIVE(modl, "get", 2, lens_get, T_LENS, T_STRING, T_TREE); |
654 | 1.63k | DEFINE_NATIVE(modl, "put", 3, lens_put, T_LENS, T_TREE, T_STRING, |
655 | 1.63k | T_STRING); |
656 | | /* Tree manipulation used by the PUT tests */ |
657 | 1.63k | DEFINE_NATIVE(modl, "set", 3, tree_set_glue, T_STRING, T_STRING, T_TREE, |
658 | 1.63k | T_TREE); |
659 | 1.63k | DEFINE_NATIVE(modl, "clear", 2, tree_clear_glue, T_STRING, T_TREE, |
660 | 1.63k | T_TREE); |
661 | 1.63k | DEFINE_NATIVE(modl, "rm", 2, tree_rm_glue, T_STRING, T_TREE, T_TREE); |
662 | 1.63k | DEFINE_NATIVE(modl, "insa", 3, tree_insa_glue, T_STRING, T_STRING, T_TREE, |
663 | 1.63k | T_TREE); |
664 | 1.63k | DEFINE_NATIVE(modl, "insb", 3, tree_insb_glue, T_STRING, T_STRING, T_TREE, |
665 | 1.63k | T_TREE); |
666 | | /* Transforms and filters */ |
667 | 1.63k | DEFINE_NATIVE(modl, "incl", 1, xform_incl, T_STRING, T_FILTER); |
668 | 1.63k | DEFINE_NATIVE(modl, "excl", 1, xform_excl, T_STRING, T_FILTER); |
669 | 1.63k | DEFINE_NATIVE(modl, "transform", 2, xform_transform, T_LENS, T_FILTER, |
670 | 1.63k | T_TRANSFORM); |
671 | 1.63k | DEFINE_NATIVE(modl, LNS_CHECK_REC_NAME, |
672 | 1.63k | 2, lns_check_rec_glue, T_LENS, T_LENS, T_LENS); |
673 | | /* Printing */ |
674 | 1.63k | DEFINE_NATIVE(modl, "print_string", 1, pr_string, T_STRING, T_UNIT); |
675 | 1.63k | DEFINE_NATIVE(modl, "print_regexp", 1, pr_regexp, T_REGEXP, T_UNIT); |
676 | 1.63k | DEFINE_NATIVE(modl, "print_endline", 1, pr_endline, T_STRING, T_UNIT); |
677 | 1.63k | DEFINE_NATIVE(modl, "print_tree", 1, pr_tree, T_TREE, T_TREE); |
678 | | |
679 | | /* Lens inspection */ |
680 | 1.63k | DEFINE_NATIVE(modl, "lens_ctype", 1, lns_ctype, T_LENS, T_REGEXP); |
681 | 1.63k | DEFINE_NATIVE(modl, "lens_atype", 1, lns_atype, T_LENS, T_REGEXP); |
682 | 1.63k | DEFINE_NATIVE(modl, "lens_vtype", 1, lns_vtype, T_LENS, T_REGEXP); |
683 | 1.63k | DEFINE_NATIVE(modl, "lens_ktype", 1, lns_ktype, T_LENS, T_REGEXP); |
684 | 1.63k | DEFINE_NATIVE(modl, "lens_format_atype", 1, lns_fmt_atype, |
685 | 1.63k | T_LENS, T_STRING); |
686 | | |
687 | | /* Regexp matching */ |
688 | 1.63k | DEFINE_NATIVE(modl, "regexp_match", 2, rx_match, T_REGEXP, T_STRING, |
689 | 1.63k | T_STRING); |
690 | | |
691 | | /* System functions */ |
692 | 1.63k | struct module *sys = module_create("Sys"); |
693 | 1.63k | modl->next = sys; |
694 | 1.63k | DEFINE_NATIVE(sys, "getenv", 1, sys_getenv, T_STRING, T_STRING); |
695 | 1.63k | DEFINE_NATIVE(sys, "read_file", 1, sys_read_file, T_STRING, T_STRING); |
696 | 1.63k | return modl; |
697 | 0 | error: |
698 | 0 | unref(modl, module); |
699 | 0 | return NULL; |
700 | 0 | } |
701 | | |
702 | | /* |
703 | | * Local variables: |
704 | | * indent-tabs-mode: nil |
705 | | * c-indent-level: 4 |
706 | | * c-basic-offset: 4 |
707 | | * tab-width: 4 |
708 | | * End: |
709 | | */ |