pkg: obsolete package/svr4
[unleashed.git] / contrib / libjeffpc / sexpr_eval.c
blob67a500370dcde31e3de147008fe928241f9a88b2
1 /*
2 * Copyright (c) 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 <jeffpc/sexpr.h>
25 struct builtin_fxn {
26 const char *name;
27 struct val *(*f)(struct val *args,
28 struct val *(*lookup)(struct str *name, void *private),
29 void *private);
32 #define __REDUCE(fname, alloc, t, valmember, ident, op) \
33 static struct val *fname(struct val *args, \
34 struct val *(*lookup)(struct str *, void *), \
35 void *private) \
36 { \
37 struct val *ret; \
39 ret = alloc(ident); \
41 while (args) { \
42 struct val *el = sexpr_car(val_getref(args)); \
43 struct val *next = sexpr_cdr(args); \
45 while (el && (el->type == VT_CONS || el->type == VT_SYM)) \
46 el = sexpr_eval(el, lookup, private); \
48 ASSERT(el); \
49 ASSERT3U(el->type, ==, t); \
51 ret->valmember = ret->valmember op el->valmember; \
53 val_putref(el); \
54 args = next; \
55 } \
57 return ret; \
60 #define BOOL_REDUCE(fname, ident, op) \
61 __REDUCE(fname, VAL_ALLOC_BOOL, VT_BOOL, b, ident, op)
63 BOOL_REDUCE(fxn_or, false, ||)
64 BOOL_REDUCE(fxn_and, true, &&)
66 #define INT_REDUCE(fname, ident, op) \
67 __REDUCE(fname, VAL_ALLOC_INT, VT_INT, i, ident, op)
69 INT_REDUCE(fxn_add, 0, +)
70 INT_REDUCE(fxn_mult, 1, *)
72 static struct val *fxn_quote(struct val *args,
73 struct val *(*lookup)(struct str *name, void *private),
74 void *private)
76 return sexpr_car(args);
79 static struct val *fxn_equal(struct val *args,
80 struct val *(*lookup)(struct str *name, void *private),
81 void *private)
83 struct val *a, *b;
85 VERIFY3U(sexpr_length(val_getref(args)), == ,2);
87 a = sexpr_eval(sexpr_nth(val_getref(args), 1), lookup, private);
88 b = sexpr_eval(sexpr_nth(args, 2), lookup, private);
90 return VAL_ALLOC_BOOL(sexpr_equal(a, b));
93 static struct builtin_fxn builtins[] = {
94 { "and", fxn_and, },
95 { "or", fxn_or, },
96 { "&&", fxn_and, },
97 { "||", fxn_or, },
98 { "+", fxn_add, },
99 { "*", fxn_mult, },
100 { "quote", fxn_quote, },
101 { "=", fxn_equal, },
102 { "==", fxn_equal, },
103 { NULL, },
106 static struct val *eval_cons(struct val *expr,
107 struct val *(*lookup)(struct str *, void *),
108 void *private)
110 struct val *args;
111 struct val *op;
112 size_t i;
114 op = sexpr_car(val_getref(expr));
115 args = sexpr_cdr(val_getref(expr));
117 ASSERT(op);
118 ASSERT3U(op->type, ==, VT_SYM);
120 for (i = 0; builtins[i].name; i++)
121 if (!strcmp(builtins[i].name, str_cstr(op->str)))
122 return builtins[i].f(args, lookup, private);
124 panic("unknown builtin function '%s'", str_cstr(op->str));
127 struct val *sexpr_eval(struct val *expr,
128 struct val *(*lookup)(struct str *, void *),
129 void *private)
131 if (!expr)
132 return NULL;
134 switch (expr->type) {
135 case VT_INT:
136 case VT_STR:
137 case VT_BOOL:
138 return expr;
139 case VT_SYM: {
140 struct str *name;
142 if (!lookup)
143 panic("VT_SYM requires non-NULL lookup "
144 "function passed to sexpr_eval");
146 name = str_getref(expr->str);
147 val_putref(expr);
149 return sexpr_eval(lookup(name, private), lookup, private);
151 case VT_CONS:
152 return eval_cons(expr, lookup, private);
155 panic("impossible!");