2 * Copyright © 2016 Keith Packard <keithp@keithp.com>
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation, either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * General Public License for more details.
18 builtin_size(void *addr)
21 return sizeof (struct ao_lisp_builtin);
25 builtin_mark(void *addr)
31 builtin_move(void *addr)
36 const struct ao_lisp_type ao_lisp_builtin_type = {
43 ao_lisp_builtin_print(ao_poly b)
49 static int check_argc(struct ao_lisp_cons *cons, int min, int max)
53 while (cons && argc <= max) {
55 cons = ao_lisp_poly_cons(cons->cdr);
57 if (argc < min || argc > max) {
58 ao_lisp_exception |= AO_LISP_INVALID;
64 static int check_argt(struct ao_lisp_cons *cons, int argc, int type, int nil_ok)
68 /* find the desired arg */
70 cons = ao_lisp_poly_cons(cons->cdr);
72 if ((!car && !nil_ok) ||
73 ao_lisp_poly_type(car) != type)
75 ao_lisp_exception |= AO_LISP_INVALID;
81 enum math_op { math_plus, math_minus, math_times, math_divide, math_mod };
84 ao_lisp_car(struct ao_lisp_cons *cons)
86 if (!check_argc(cons, 1, 1))
88 if (!check_argt(cons, 0, AO_LISP_CONS, 0)) {
89 ao_lisp_exception |= AO_LISP_INVALID;
92 return ao_lisp_poly_cons(cons->car)->car;
96 ao_lisp_cdr(struct ao_lisp_cons *cons)
99 ao_lisp_exception |= AO_LISP_INVALID;
103 ao_lisp_exception |= AO_LISP_INVALID;
106 if (ao_lisp_poly_type(cons->car) != AO_LISP_CONS) {
107 ao_lisp_exception |= AO_LISP_INVALID;
110 return ao_lisp_poly_cons(cons->car)->cdr;
114 ao_lisp_cons(struct ao_lisp_cons *cons)
118 ao_lisp_exception |= AO_LISP_INVALID;
124 ao_lisp_exception |= AO_LISP_INVALID;
127 cdr = ao_lisp_poly_cons(cdr)->car;
128 if (ao_lisp_poly_type(cdr) != AO_LISP_CONS) {
129 ao_lisp_exception |= AO_LISP_INVALID;
132 return ao_lisp_cons_poly(ao_lisp_cons_cons(car, ao_lisp_poly_cons(cdr)));
136 ao_lisp_quote(struct ao_lisp_cons *cons)
139 ao_lisp_exception |= AO_LISP_INVALID;
146 ao_lisp_set(struct ao_lisp_cons *cons)
148 if (!check_argc(cons, 2, 2))
150 if (!check_argt(cons, 0, AO_LISP_ATOM, 0))
153 return ao_lisp_atom_set(cons->car, ao_lisp_poly_cons(cons->cdr)->car);
157 ao_lisp_setq(struct ao_lisp_cons *cons)
159 struct ao_lisp_cons *expand = 0;
160 if (!check_argc(cons, 2, 2))
162 expand = ao_lisp_cons_cons(_ao_lisp_atom_set,
163 ao_lisp_cons_cons(ao_lisp_cons_poly(ao_lisp_cons_cons(_ao_lisp_atom_quote,
164 ao_lisp_cons_cons(cons->car, NULL))),
165 ao_lisp_poly_cons(cons->cdr)));
166 return ao_lisp_cons_poly(expand);
170 ao_lisp_print(struct ao_lisp_cons *cons)
172 ao_poly val = AO_LISP_NIL;
175 ao_lisp_poly_print(val);
176 cons = ao_lisp_poly_cons(cons->cdr);
184 ao_lisp_math(struct ao_lisp_cons *cons, enum math_op op)
186 ao_poly ret = AO_LISP_NIL;
189 ao_poly car = cons->car;
190 uint8_t rt = ao_lisp_poly_type(ret);
191 uint8_t ct = ao_lisp_poly_type(car);
193 cons = ao_lisp_poly_cons(cons->cdr);
195 if (rt == AO_LISP_NIL)
198 else if (rt == AO_LISP_INT && ct == AO_LISP_INT) {
199 int r = ao_lisp_poly_int(ret);
200 int c = ao_lisp_poly_int(car);
214 ao_lisp_exception |= AO_LISP_DIVIDE_BY_ZERO;
221 ao_lisp_exception |= AO_LISP_DIVIDE_BY_ZERO;
227 ret = ao_lisp_int_poly(r);
230 else if (rt == AO_LISP_STRING && ct == AO_LISP_STRING && op == math_plus)
231 ret = ao_lisp_string_poly(ao_lisp_string_cat(ao_lisp_poly_string(ret),
232 ao_lisp_poly_string(car)));
234 ao_lisp_exception |= AO_LISP_INVALID;
242 ao_lisp_plus(struct ao_lisp_cons *cons)
244 return ao_lisp_math(cons, math_plus);
248 ao_lisp_minus(struct ao_lisp_cons *cons)
250 return ao_lisp_math(cons, math_minus);
254 ao_lisp_times(struct ao_lisp_cons *cons)
256 return ao_lisp_math(cons, math_times);
260 ao_lisp_divide(struct ao_lisp_cons *cons)
262 return ao_lisp_math(cons, math_divide);
266 ao_lisp_mod(struct ao_lisp_cons *cons)
268 return ao_lisp_math(cons, math_mod);
271 ao_lisp_func_t ao_lisp_builtins[] = {
272 [builtin_car] = ao_lisp_car,
273 [builtin_cdr] = ao_lisp_cdr,
274 [builtin_cons] = ao_lisp_cons,
275 [builtin_quote] = ao_lisp_quote,
276 [builtin_set] = ao_lisp_set,
277 [builtin_setq] = ao_lisp_setq,
278 [builtin_print] = ao_lisp_print,
279 [builtin_plus] = ao_lisp_plus,
280 [builtin_minus] = ao_lisp_minus,
281 [builtin_times] = ao_lisp_times,
282 [builtin_divide] = ao_lisp_divide,
283 [builtin_mod] = ao_lisp_mod