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 ao_lisp_builtin_print(ao_poly b)
24 static int check_argc(struct ao_lisp_cons *cons, int min, int max)
28 while (cons && argc <= max) {
30 cons = ao_lisp_poly_cons(cons->cdr);
32 if (argc < min || argc > max) {
33 ao_lisp_exception |= AO_LISP_INVALID;
39 static int check_argt(struct ao_lisp_cons *cons, int argc, int type, int nil_ok)
43 /* find the desired arg */
45 cons = ao_lisp_poly_cons(cons->cdr);
47 if ((!car && !nil_ok) ||
48 ao_lisp_poly_type(car) != type)
50 ao_lisp_exception |= AO_LISP_INVALID;
56 enum math_op { math_plus, math_minus, math_times, math_divide, math_mod };
59 ao_lisp_car(struct ao_lisp_cons *cons)
61 if (!check_argc(cons, 1, 1))
63 if (!check_argt(cons, 0, AO_LISP_CONS, 0)) {
64 ao_lisp_exception |= AO_LISP_INVALID;
67 return ao_lisp_poly_cons(cons->car)->car;
71 ao_lisp_cdr(struct ao_lisp_cons *cons)
74 ao_lisp_exception |= AO_LISP_INVALID;
78 ao_lisp_exception |= AO_LISP_INVALID;
81 if (ao_lisp_poly_type(cons->car) != AO_LISP_CONS) {
82 ao_lisp_exception |= AO_LISP_INVALID;
85 return ao_lisp_poly_cons(cons->car)->cdr;
89 ao_lisp_cons(struct ao_lisp_cons *cons)
93 ao_lisp_exception |= AO_LISP_INVALID;
99 ao_lisp_exception |= AO_LISP_INVALID;
102 cdr = ao_lisp_poly_cons(cdr)->car;
103 if (ao_lisp_poly_type(cdr) != AO_LISP_CONS) {
104 ao_lisp_exception |= AO_LISP_INVALID;
107 return ao_lisp_cons_poly(ao_lisp_cons_cons(car, ao_lisp_poly_cons(cdr)));
111 ao_lisp_quote(struct ao_lisp_cons *cons)
114 ao_lisp_exception |= AO_LISP_INVALID;
121 ao_lisp_set(struct ao_lisp_cons *cons)
124 if (!check_argc(cons, 2, 2))
126 if (!check_argt(cons, 0, AO_LISP_ATOM, 0))
130 val = ao_lisp_poly_cons(cons->cdr)->car;
131 if (ao_lisp_is_const(atom)) {
132 ao_lisp_exception |= AO_LISP_INVALID;
135 ao_lisp_poly_atom(atom)->val = val;
140 ao_lisp_setq(struct ao_lisp_cons *cons)
142 struct ao_lisp_cons *expand = 0;
143 if (!check_argc(cons, 2, 2))
145 expand = ao_lisp_cons_cons(_ao_lisp_atom_set,
146 ao_lisp_cons_cons(ao_lisp_cons_poly(ao_lisp_cons_cons(_ao_lisp_atom_quote,
147 ao_lisp_cons_cons(cons->car, NULL))),
148 ao_lisp_poly_cons(cons->cdr)));
149 return ao_lisp_cons_poly(expand);
153 ao_lisp_print(struct ao_lisp_cons *cons)
155 ao_poly val = AO_LISP_NIL;
158 ao_lisp_poly_print(val);
159 cons = ao_lisp_poly_cons(cons->cdr);
165 ao_lisp_math(struct ao_lisp_cons *cons, enum math_op op)
167 ao_poly ret = AO_LISP_NIL;
170 ao_poly car = cons->car;
171 uint8_t rt = ao_lisp_poly_type(ret);
172 uint8_t ct = ao_lisp_poly_type(car);
174 cons = ao_lisp_poly_cons(cons->cdr);
176 if (rt == AO_LISP_NIL)
179 else if (rt == AO_LISP_INT && ct == AO_LISP_INT) {
180 int r = ao_lisp_poly_int(ret);
181 int c = ao_lisp_poly_int(car);
195 ao_lisp_exception |= AO_LISP_DIVIDE_BY_ZERO;
202 ao_lisp_exception |= AO_LISP_DIVIDE_BY_ZERO;
208 ret = ao_lisp_int_poly(r);
211 else if (rt == AO_LISP_STRING && ct == AO_LISP_STRING && op == math_plus)
212 ret = ao_lisp_string_poly(ao_lisp_string_cat(ao_lisp_poly_string(ret),
213 ao_lisp_poly_string(car)));
215 ao_lisp_exception |= AO_LISP_INVALID;
223 ao_lisp_plus(struct ao_lisp_cons *cons)
225 return ao_lisp_math(cons, math_plus);
229 ao_lisp_minus(struct ao_lisp_cons *cons)
231 return ao_lisp_math(cons, math_minus);
235 ao_lisp_times(struct ao_lisp_cons *cons)
237 return ao_lisp_math(cons, math_times);
241 ao_lisp_divide(struct ao_lisp_cons *cons)
243 return ao_lisp_math(cons, math_divide);
247 ao_lisp_mod(struct ao_lisp_cons *cons)
249 return ao_lisp_math(cons, math_mod);
252 ao_lisp_func_t ao_lisp_builtins[] = {
253 [builtin_car] = ao_lisp_car,
254 [builtin_cdr] = ao_lisp_cdr,
255 [builtin_cons] = ao_lisp_cons,
256 [builtin_quote] = ao_lisp_quote,
257 [builtin_set] = ao_lisp_set,
258 [builtin_setq] = ao_lisp_setq,
259 [builtin_print] = ao_lisp_print,
260 [builtin_plus] = ao_lisp_plus,
261 [builtin_minus] = ao_lisp_minus,
262 [builtin_times] = ao_lisp_times,
263 [builtin_divide] = ao_lisp_divide,
264 [builtin_mod] = ao_lisp_mod