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_patom(struct ao_lisp_cons *cons)
185 ao_poly val = AO_LISP_NIL;
188 ao_lisp_poly_patom(val);
189 cons = ao_lisp_poly_cons(cons->cdr);
195 ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
197 ao_poly ret = AO_LISP_NIL;
200 ao_poly car = cons->car;
201 uint8_t rt = ao_lisp_poly_type(ret);
202 uint8_t ct = ao_lisp_poly_type(car);
204 cons = ao_lisp_poly_cons(cons->cdr);
206 if (rt == AO_LISP_NIL)
209 else if (rt == AO_LISP_INT && ct == AO_LISP_INT) {
210 int r = ao_lisp_poly_int(ret);
211 int c = ao_lisp_poly_int(car);
225 return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "divide by zero");
230 return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "mod by zero");
236 ret = ao_lisp_int_poly(r);
239 else if (rt == AO_LISP_STRING && ct == AO_LISP_STRING && op == builtin_plus)
240 ret = ao_lisp_string_poly(ao_lisp_string_cat(ao_lisp_poly_string(ret),
241 ao_lisp_poly_string(car)));
243 return ao_lisp_error(AO_LISP_INVALID, "invalid args");
249 ao_lisp_plus(struct ao_lisp_cons *cons)
251 return ao_lisp_math(cons, builtin_plus);
255 ao_lisp_minus(struct ao_lisp_cons *cons)
257 return ao_lisp_math(cons, builtin_minus);
261 ao_lisp_times(struct ao_lisp_cons *cons)
263 return ao_lisp_math(cons, builtin_times);
267 ao_lisp_divide(struct ao_lisp_cons *cons)
269 return ao_lisp_math(cons, builtin_divide);
273 ao_lisp_mod(struct ao_lisp_cons *cons)
275 return ao_lisp_math(cons, builtin_mod);
279 ao_lisp_compare(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
284 return _ao_lisp_atom_t;
287 cons = ao_lisp_poly_cons(cons->cdr);
289 ao_poly right = cons->car;
291 if (op == builtin_equal) {
295 uint8_t lt = ao_lisp_poly_type(left);
296 uint8_t rt = ao_lisp_poly_type(right);
297 if (lt == AO_LISP_INT && rt == AO_LISP_INT) {
298 int l = ao_lisp_poly_int(left);
299 int r = ao_lisp_poly_int(right);
306 case builtin_greater:
310 case builtin_less_equal:
314 case builtin_greater_equal:
321 } else if (lt == AO_LISP_STRING && rt == AO_LISP_STRING) {
322 int c = strcmp(ao_lisp_poly_string(left),
323 ao_lisp_poly_string(right));
329 case builtin_greater:
333 case builtin_less_equal:
337 case builtin_greater_equal:
347 cons = ao_lisp_poly_cons(cons->cdr);
349 return _ao_lisp_atom_t;
353 ao_lisp_equal(struct ao_lisp_cons *cons)
355 return ao_lisp_compare(cons, builtin_equal);
359 ao_lisp_less(struct ao_lisp_cons *cons)
361 return ao_lisp_compare(cons, builtin_less);
365 ao_lisp_greater(struct ao_lisp_cons *cons)
367 return ao_lisp_compare(cons, builtin_greater);
371 ao_lisp_less_equal(struct ao_lisp_cons *cons)
373 return ao_lisp_compare(cons, builtin_less_equal);
377 ao_lisp_greater_equal(struct ao_lisp_cons *cons)
379 return ao_lisp_compare(cons, builtin_greater_equal);
382 ao_lisp_func_t ao_lisp_builtins[] = {
383 [builtin_car] = ao_lisp_car,
384 [builtin_cdr] = ao_lisp_cdr,
385 [builtin_cons] = ao_lisp_cons,
386 [builtin_quote] = ao_lisp_quote,
387 [builtin_set] = ao_lisp_set,
388 [builtin_setq] = ao_lisp_setq,
389 [builtin_cond] = ao_lisp_cond,
390 [builtin_print] = ao_lisp_print,
391 [builtin_patom] = ao_lisp_patom,
392 [builtin_plus] = ao_lisp_plus,
393 [builtin_minus] = ao_lisp_minus,
394 [builtin_times] = ao_lisp_times,
395 [builtin_divide] = ao_lisp_divide,
396 [builtin_mod] = ao_lisp_mod,
397 [builtin_equal] = ao_lisp_equal,
398 [builtin_less] = ao_lisp_less,
399 [builtin_greater] = ao_lisp_greater,
400 [builtin_less_equal] = ao_lisp_less_equal,
401 [builtin_greater_equal] = ao_lisp_greater_equal