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)
50 ao_lisp_check_argc(ao_poly name, struct ao_lisp_cons *cons, int min, int max)
54 while (cons && argc <= max) {
56 cons = ao_lisp_poly_cons(cons->cdr);
58 if (argc < min || argc > max)
59 return ao_lisp_error(AO_LISP_INVALID, "%s: invalid arg count", ao_lisp_poly_atom(name)->name);
60 return _ao_lisp_atom_t;
64 ao_lisp_arg(struct ao_lisp_cons *cons, int argc)
71 cons = ao_lisp_poly_cons(cons->cdr);
77 ao_lisp_check_argt(ao_poly name, struct ao_lisp_cons *cons, int argc, int type, int nil_ok)
79 ao_poly car = ao_lisp_arg(cons, argc);
81 if ((!car && !nil_ok) || ao_lisp_poly_type(car) != type)
82 return ao_lisp_error(AO_LISP_INVALID, "%s: invalid type for arg %d", ao_lisp_poly_atom(name)->name, argc);
83 return _ao_lisp_atom_t;
87 ao_lisp_car(struct ao_lisp_cons *cons)
89 if (!ao_lisp_check_argc(_ao_lisp_atom_car, cons, 1, 1))
91 if (!ao_lisp_check_argt(_ao_lisp_atom_car, cons, 0, AO_LISP_CONS, 0))
93 return ao_lisp_poly_cons(cons->car)->car;
97 ao_lisp_cdr(struct ao_lisp_cons *cons)
99 if (!ao_lisp_check_argc(_ao_lisp_atom_cdr, cons, 1, 1))
101 if (!ao_lisp_check_argt(_ao_lisp_atom_cdr, cons, 0, AO_LISP_CONS, 0))
103 return ao_lisp_poly_cons(cons->car)->cdr;
107 ao_lisp_cons(struct ao_lisp_cons *cons)
110 if(!ao_lisp_check_argc(_ao_lisp_atom_cons, cons, 2, 2))
112 if (!ao_lisp_check_argt(_ao_lisp_atom_cons, cons, 1, AO_LISP_CONS, 1))
114 car = ao_lisp_arg(cons, 0);
115 cdr = ao_lisp_arg(cons, 1);
116 return ao_lisp_cons_poly(ao_lisp_cons_cons(car, ao_lisp_poly_cons(cdr)));
120 ao_lisp_quote(struct ao_lisp_cons *cons)
122 if (!ao_lisp_check_argc(_ao_lisp_atom_quote, cons, 1, 1))
124 return ao_lisp_arg(cons, 0);
128 ao_lisp_set(struct ao_lisp_cons *cons)
130 if (!ao_lisp_check_argc(_ao_lisp_atom_set, cons, 2, 2))
132 if (!ao_lisp_check_argt(_ao_lisp_atom_set, cons, 0, AO_LISP_ATOM, 0))
135 return ao_lisp_atom_set(ao_lisp_arg(cons, 0), ao_lisp_arg(cons, 1));
139 ao_lisp_setq(struct ao_lisp_cons *cons)
141 struct ao_lisp_cons *expand = 0;
142 if (!ao_lisp_check_argc(_ao_lisp_atom_setq, cons, 2, 2))
144 expand = ao_lisp_cons_cons(_ao_lisp_atom_set,
145 ao_lisp_cons_cons(ao_lisp_cons_poly(ao_lisp_cons_cons(_ao_lisp_atom_quote,
146 ao_lisp_cons_cons(cons->car, NULL))),
147 ao_lisp_poly_cons(cons->cdr)));
148 return ao_lisp_cons_poly(expand);
152 ao_lisp_cond(struct ao_lisp_cons *cons)
155 struct ao_lisp_cons *arg;
158 for (arg = cons, argc = 0; arg; arg = ao_lisp_poly_cons(arg->cdr), argc++) {
159 if (ao_lisp_poly_type(arg->car) != AO_LISP_CONS)
160 return ao_lisp_error(AO_LISP_INVALID, "%s: invalid type for arg %d",
161 ao_lisp_poly_atom(_ao_lisp_atom_cond)->name, argc);
163 ao_lisp_set_cond(cons);
168 ao_lisp_print(struct ao_lisp_cons *cons)
170 ao_poly val = AO_LISP_NIL;
173 ao_lisp_poly_print(val);
174 cons = ao_lisp_poly_cons(cons->cdr);
183 ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
185 ao_poly ret = AO_LISP_NIL;
188 ao_poly car = cons->car;
189 uint8_t rt = ao_lisp_poly_type(ret);
190 uint8_t ct = ao_lisp_poly_type(car);
192 cons = ao_lisp_poly_cons(cons->cdr);
194 if (rt == AO_LISP_NIL)
197 else if (rt == AO_LISP_INT && ct == AO_LISP_INT) {
198 int r = ao_lisp_poly_int(ret);
199 int c = ao_lisp_poly_int(car);
213 return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "divide by zero");
218 return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "mod by zero");
224 ret = ao_lisp_int_poly(r);
227 else if (rt == AO_LISP_STRING && ct == AO_LISP_STRING && op == builtin_plus)
228 ret = ao_lisp_string_poly(ao_lisp_string_cat(ao_lisp_poly_string(ret),
229 ao_lisp_poly_string(car)));
231 return ao_lisp_error(AO_LISP_INVALID, "invalid args");
237 ao_lisp_plus(struct ao_lisp_cons *cons)
239 return ao_lisp_math(cons, builtin_plus);
243 ao_lisp_minus(struct ao_lisp_cons *cons)
245 return ao_lisp_math(cons, builtin_minus);
249 ao_lisp_times(struct ao_lisp_cons *cons)
251 return ao_lisp_math(cons, builtin_times);
255 ao_lisp_divide(struct ao_lisp_cons *cons)
257 return ao_lisp_math(cons, builtin_divide);
261 ao_lisp_mod(struct ao_lisp_cons *cons)
263 return ao_lisp_math(cons, builtin_mod);
267 ao_lisp_compare(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
272 return _ao_lisp_atom_t;
275 cons = ao_lisp_poly_cons(cons->cdr);
277 ao_poly right = cons->car;
279 if (op == builtin_equal) {
283 uint8_t lt = ao_lisp_poly_type(left);
284 uint8_t rt = ao_lisp_poly_type(right);
285 if (lt == AO_LISP_INT && rt == AO_LISP_INT) {
286 int l = ao_lisp_poly_int(left);
287 int r = ao_lisp_poly_int(right);
294 case builtin_greater:
298 case builtin_less_equal:
302 case builtin_greater_equal:
309 } else if (lt == AO_LISP_STRING && rt == AO_LISP_STRING) {
310 int c = strcmp(ao_lisp_poly_string(left),
311 ao_lisp_poly_string(right));
317 case builtin_greater:
321 case builtin_less_equal:
325 case builtin_greater_equal:
335 cons = ao_lisp_poly_cons(cons->cdr);
337 return _ao_lisp_atom_t;
341 ao_lisp_equal(struct ao_lisp_cons *cons)
343 return ao_lisp_compare(cons, builtin_equal);
347 ao_lisp_less(struct ao_lisp_cons *cons)
349 return ao_lisp_compare(cons, builtin_less);
353 ao_lisp_greater(struct ao_lisp_cons *cons)
355 return ao_lisp_compare(cons, builtin_greater);
359 ao_lisp_less_equal(struct ao_lisp_cons *cons)
361 return ao_lisp_compare(cons, builtin_less_equal);
365 ao_lisp_greater_equal(struct ao_lisp_cons *cons)
367 return ao_lisp_compare(cons, builtin_greater_equal);
370 ao_lisp_func_t ao_lisp_builtins[] = {
371 [builtin_car] = ao_lisp_car,
372 [builtin_cdr] = ao_lisp_cdr,
373 [builtin_cons] = ao_lisp_cons,
374 [builtin_quote] = ao_lisp_quote,
375 [builtin_set] = ao_lisp_set,
376 [builtin_setq] = ao_lisp_setq,
377 [builtin_cond] = ao_lisp_cond,
378 [builtin_print] = ao_lisp_print,
379 [builtin_plus] = ao_lisp_plus,
380 [builtin_minus] = ao_lisp_minus,
381 [builtin_times] = ao_lisp_times,
382 [builtin_divide] = ao_lisp_divide,
383 [builtin_mod] = ao_lisp_mod,
384 [builtin_equal] = ao_lisp_equal,
385 [builtin_less] = ao_lisp_less,
386 [builtin_greater] = ao_lisp_greater,
387 [builtin_less_equal] = ao_lisp_less_equal,
388 [builtin_greater_equal] = ao_lisp_greater_equal