uts: make emu10k non-verbose
[unleashed.git] / contrib / libjeffpc / sexpr.c
blobb151281b11920292d0254f9182a71b1f1f064227
1 /*
2 * Copyright (c) 2015-2016 Josef 'Jeff' Sipek <jeffpc@josefsipek.net>
4 * Permission is hereby granted, free of charge, to any person obtaining a copy
5 * of this software and associated documentation files (the "Software"), to deal
6 * in the Software without restriction, including without limitation the rights
7 * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
8 * copies of the Software, and to permit persons to whom the Software is
9 * furnished to do so, subject to the following conditions:
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
19 * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
20 * SOFTWARE.
23 #include <stdio.h>
24 #include <stdlib.h>
25 #include <string.h>
27 #include <jeffpc/str.h>
28 #include <jeffpc/sexpr.h>
30 #include "sexpr_impl.h"
32 static char *escape_str(const char *in)
34 char *out, *tmp;
35 const char *s;
36 size_t outlen;
38 outlen = strlen(in);
40 for (s = in; *s; s++) {
41 char c = *s;
43 switch (c) {
44 case '\n':
45 case '\t':
46 case '\r':
47 case '\b':
48 case '\f':
49 case '"':
50 /* "\n", "\t", ... */
51 outlen++;
52 break;
56 out = malloc(outlen + 1);
57 if (!out)
58 return NULL;
60 for (s = in, tmp = out; *s; s++, tmp++) {
61 unsigned char c = *s;
63 switch (c) {
64 case '\n':
65 strcpy(tmp, "\\n");
66 tmp++;
67 break;
68 case '\t':
69 strcpy(tmp, "\\t");
70 tmp++;
71 break;
72 case '\r':
73 strcpy(tmp, "\\r");
74 tmp++;
75 break;
76 case '\b':
77 strcpy(tmp, "\\b");
78 tmp++;
79 break;
80 case '\f':
81 strcpy(tmp, "\\f");
82 tmp++;
83 break;
84 case '"':
85 strcpy(tmp, "\\\"");
86 tmp++;
87 break;
88 default:
89 *tmp = c;
90 break;
94 *tmp = '\0';
96 return out;
99 struct val *sexpr_parse(const char *str, size_t len)
101 struct sexpr_parser_state x;
103 x.input = str;
104 x.len = len;
105 x.pos = 0;
107 sexpr_reader_lex_init(&x.scanner);
108 sexpr_reader_set_extra(&x, x.scanner);
110 ASSERT(sexpr_reader_parse(&x) == 0);
112 sexpr_reader_lex_destroy(x.scanner);
114 return x.output;
117 static struct str *dump_cons(struct val *lv, bool raw)
119 static struct str dot = STR_STATIC_INITIALIZER(" . ");
120 static struct str space = STR_STATIC_INITIALIZER(" ");
121 struct val *head = lv->cons.head;
122 struct val *tail = lv->cons.tail;
124 if (raw)
125 return str_cat(3, sexpr_dump(head, raw),
126 &dot,
127 sexpr_dump(tail, raw));
128 else if (!head && !tail)
129 return NULL;
130 else if (head && !tail)
131 return sexpr_dump(head, raw);
132 else if (tail->type == VT_CONS)
133 return str_cat(3, sexpr_dump(head, raw),
134 &space,
135 dump_cons(tail, raw));
136 else
137 return str_cat(3, sexpr_dump(head, raw),
138 &dot,
139 sexpr_dump(tail, raw));
142 struct str *sexpr_dump(struct val *lv, bool raw)
144 static struct str dquote = STR_STATIC_INITIALIZER("\"");
145 static struct str squote = STR_STATIC_INITIALIZER("'");
146 static struct str poundt = STR_STATIC_INITIALIZER("#t");
147 static struct str poundf = STR_STATIC_INITIALIZER("#f");
148 static struct str oparen = STR_STATIC_INITIALIZER("(");
149 static struct str cparen = STR_STATIC_INITIALIZER(")");
150 static struct str empty = STR_STATIC_INITIALIZER("()");
151 char *tmpstr;
153 if (!lv)
154 return &empty;
156 switch (lv->type) {
157 case VT_SYM:
158 return str_getref(lv->str);
159 case VT_STR:
160 tmpstr = escape_str(str_cstr(lv->str));
161 /* TODO: we leak tmpstr */
163 return str_cat(3, &dquote, STR_DUP(tmpstr), &dquote);
164 case VT_BOOL:
165 return lv->b ? &poundt : &poundf;
166 case VT_INT: {
167 char tmp[32];
169 snprintf(tmp, sizeof(tmp), "%"PRIu64, lv->i);
171 return STR_DUP(tmp);
173 case VT_CONS: {
174 struct val *head = lv->cons.head;
175 struct val *tail = lv->cons.tail;
177 /* handle quoting */
178 if (!raw && head && (head->type == VT_SYM) &&
179 !strcmp(str_cstr(head->str), "quote")) {
180 /* we're dealing with a (quote) */
181 if (sexpr_is_null(tail))
182 return str_cat(2, &squote, &empty);
184 /* we're dealing with a (quote ...) */
185 return str_cat(2, &squote, dump_cons(tail, raw));
188 /* nothing to quote */
189 return str_cat(3, &oparen, dump_cons(lv, raw), &cparen);
193 return NULL;
196 void sexpr_dump_file(FILE *out, struct val *lv, bool raw)
198 struct str *tmp;
200 tmp = sexpr_dump(lv, raw);
202 fprintf(out, "%s", str_cstr(tmp));
204 str_putref(tmp);
208 * Convert a C array of vals into a sexpr list. E.g.,
210 * vals = { A, B, C }, nvals = 3
212 * turns into:
214 * '(A . (B . (C . ())))
216 * which is the same as:
218 * '(A B C)
220 struct val *sexpr_array_to_list(struct val **vals, int nvals)
222 struct val *last = NULL;
223 struct val *tmp;
225 for (nvals--; nvals >= 0; nvals--, last = tmp)
226 tmp = VAL_ALLOC_CONS(vals[nvals], last);
228 return last;
232 * Convert a sexpr list into a C array of vals. E.g.,
234 * '(A B C)
236 * turns into:
238 * array = { A, B, C }, nvals = 3
240 * We fill in the passed in array with at most alen elements. The number of
241 * filled in elements is returned to the caller.
243 int sexpr_list_to_array(struct val *list, struct val **array, int alen)
245 struct val *tmp;
246 int nvals = 0;
248 for (tmp = list; tmp && (alen > nvals); tmp = tmp->cons.tail, nvals++) {
249 if (tmp->type != VT_CONS)
250 goto err;
252 array[nvals] = val_getref(tmp->cons.head);
255 if ((alen == nvals) && tmp)
256 goto err;
258 return nvals;
260 err:
261 while (nvals)
262 val_putref(array[--nvals]);
264 return -1;
267 struct val *sexpr_car(struct val *lv)
269 struct val *ret;
271 if (!lv)
272 return NULL;
274 if (lv->type == VT_CONS)
275 ret = val_getref(lv->cons.head);
276 else
277 ret = NULL;
279 val_putref(lv);
281 return ret;
284 struct val *sexpr_cdr(struct val *lv)
286 struct val *ret;
288 if (!lv)
289 return NULL;
291 if (lv->type == VT_CONS)
292 ret = val_getref(lv->cons.tail);
293 else
294 ret = NULL;
296 val_putref(lv);
298 return ret;
301 ssize_t sexpr_length(struct val *lv)
303 ssize_t len;
305 len = 0;
307 while (!sexpr_is_null(lv)) {
308 if (lv->type != VT_CONS) {
309 /* not a list */
310 val_putref(lv);
311 return -1;
314 len++;
315 lv = sexpr_cdr(lv);
318 val_putref(lv);
320 return len;
323 struct val *sexpr_nth(struct val *lv, uint64_t n)
325 while (n-- && lv) {
326 struct val *tmp;
328 if (lv->type == VT_CONS) {
330 * If this is not the one we want, follow the tail.
331 * Otherwise, grab the head.
333 if (n)
334 tmp = val_getref(lv->cons.tail);
335 else
336 tmp = val_getref(lv->cons.head);
337 } else {
338 tmp = NULL;
341 val_putref(lv);
343 lv = tmp;
346 return lv;
350 * Given a list, lookup a certain name.
352 * The input list looks like:
353 * '((a . b) (c . d))
354 * which really is:
355 * '((a . b) . ((c . d) . ()))
357 * So, to check it, we examite the car of the list, if that's not the right
358 * key, we recurse on cdr of the list.
360 struct val *sexpr_assoc(struct val *lv, const char *name)
362 struct val *head;
363 struct val *tail;
365 /* empty list */
366 if (!lv)
367 return NULL;
369 /* not a list */
370 if (lv->type != VT_CONS)
371 return NULL;
373 head = lv->cons.head;
374 tail = lv->cons.tail;
377 * check the head of current cons cell: '(head . tail)
378 * (1) must be non-null
379 * (2) must be a cons cell, i.e., head == '(a . b)
380 * (3) (car head) must be a string or symbol
381 * (4) (car head) must be equal to the value passed in
383 if (head && (head->type == VT_CONS) &&
384 head->cons.head &&
385 ((head->cons.head->type == VT_STR) ||
386 (head->cons.head->type == VT_SYM)) &&
387 !strcmp(str_cstr(head->cons.head->str), name))
388 return val_getref(head);
390 return sexpr_assoc(tail, name);
393 bool sexpr_equal(struct val *lhs, struct val *rhs)
395 bool ret;
397 /* if they are the same object, they are equal - even if NULL */
398 if (lhs == rhs) {
399 ret = true;
400 goto out;
403 /* if one is NULL, they are unequal */
404 if (!lhs || !rhs) {
405 /* ... unless we're comparing a NULL with a '() */
406 if ((!lhs && ((rhs->type != VT_CONS) ||
407 rhs->cons.head ||
408 rhs->cons.tail)) ||
409 (!rhs && ((lhs->type != VT_CONS) ||
410 lhs->cons.head ||
411 lhs->cons.tail))) {
412 ret = false;
413 goto out;
416 ret = true;
417 goto out;
421 * At this point, we have two non-NULL values.
424 /* different type -> unequal */
425 if (lhs->type != rhs->type) {
426 ret = false;
427 goto out;
430 ret = true; /* pacify gcc */
432 switch (lhs->type) {
433 case VT_INT:
434 ret = (lhs->i == rhs->i);
435 break;
436 case VT_STR:
437 case VT_SYM:
438 ret = str_cmp(lhs->str, rhs->str) == 0;
439 break;
440 case VT_BOOL:
441 ret = (lhs->b == rhs->b);
442 break;
443 case VT_CONS:
444 ret = sexpr_equal(val_getref(lhs->cons.head),
445 val_getref(rhs->cons.head)) &&
446 sexpr_equal(val_getref(lhs->cons.tail),
447 val_getref(rhs->cons.tail));
448 break;
451 out:
452 val_putref(lhs);
453 val_putref(rhs);
454 return ret;
457 struct val *sexpr_alist_lookup_val(struct val *lv, const char *name)
459 if (!lv || !name)
460 return NULL;
462 return sexpr_cdr(sexpr_assoc(lv, name));
465 struct str *sexpr_alist_lookup_str(struct val *lv, const char *name)
467 struct str *ret;
468 struct val *v;
470 if (!lv || !name)
471 return NULL;
473 v = sexpr_cdr(sexpr_assoc(lv, name));
474 if (!v || (v->type != VT_STR))
475 ret = NULL;
476 else
477 ret = str_getref(v->str);
479 val_putref(v);
481 return ret;
484 uint64_t sexpr_alist_lookup_int(struct val *lv, const char *name, bool *found)
486 struct val *v;
487 uint64_t ret;
488 bool ok;
490 if (!lv || !name) {
491 if (found)
492 *found = false;
493 return 0;
496 v = sexpr_cdr(sexpr_assoc(lv, name));
497 ok = v && (v->type == VT_INT);
499 if (!ok)
500 ret = 0;
501 else
502 ret = v->i;
504 val_putref(v);
506 if (found)
507 *found = ok;
509 return ret;
512 struct val *sexpr_alist_lookup_list(struct val *lv, const char *name)
514 struct val *ret;
515 struct val *v;
517 if (!lv || !name)
518 return NULL;
520 v = sexpr_cdr(sexpr_assoc(lv, name));
521 if (!v || (v->type != VT_CONS))
522 ret = NULL;
523 else
524 ret = val_getref(v);
526 val_putref(v);
528 return ret;