#ifdef AO_LISP_MAKE_CONST
#define AO_LISP_POOL_CONST 16384
extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST];
+#define _ao_lisp_atom_quote ao_lisp_atom_poly(ao_lisp_atom_intern("quote"))
#else
#include "ao_lisp_const.h"
#endif
typedef uint16_t ao_poly;
+static inline int
+ao_lisp_is_const(ao_poly poly) {
+ return poly & AO_LISP_CONST;
+}
+
static inline void *
ao_lisp_ref(ao_poly poly) {
if (poly == AO_LISP_NIL)
builtin_cdr,
builtin_cons,
builtin_quote,
+ builtin_set,
+ builtin_setq,
builtin_print,
builtin_plus,
builtin_minus,
printf("[builtin]");
}
+static int check_argc(struct ao_lisp_cons *cons, int min, int max)
+{
+ int argc = 0;
+
+ while (cons && argc <= max) {
+ argc++;
+ cons = ao_lisp_poly_cons(cons->cdr);
+ }
+ if (argc < min || argc > max) {
+ ao_lisp_exception |= AO_LISP_INVALID;
+ return 0;
+ }
+ return 1;
+}
+
+static int check_argt(struct ao_lisp_cons *cons, int argc, int type, int nil_ok)
+{
+ ao_poly car;
+
+ /* find the desired arg */
+ while (argc--)
+ cons = ao_lisp_poly_cons(cons->cdr);
+ car = cons->car;
+ if ((!car && !nil_ok) ||
+ ao_lisp_poly_type(car) != type)
+ {
+ ao_lisp_exception |= AO_LISP_INVALID;
+ return 0;
+ }
+ return 1;
+}
+
enum math_op { math_plus, math_minus, math_times, math_divide, math_mod };
ao_poly
ao_lisp_car(struct ao_lisp_cons *cons)
{
- if (!cons) {
- ao_lisp_exception |= AO_LISP_INVALID;
- return AO_LISP_NIL;
- }
- if (!cons->car) {
- ao_lisp_exception |= AO_LISP_INVALID;
+ if (!check_argc(cons, 1, 1))
return AO_LISP_NIL;
- }
- if (ao_lisp_poly_type(cons->car) != AO_LISP_CONS) {
+ if (!check_argt(cons, 0, AO_LISP_CONS, 0)) {
ao_lisp_exception |= AO_LISP_INVALID;
return AO_LISP_NIL;
}
return cons->car;
}
+ao_poly
+ao_lisp_set(struct ao_lisp_cons *cons)
+{
+ ao_poly atom, val;
+ if (!check_argc(cons, 2, 2))
+ return AO_LISP_NIL;
+ if (!check_argt(cons, 0, AO_LISP_ATOM, 0))
+ return AO_LISP_NIL;
+
+ atom = cons->car;
+ val = ao_lisp_poly_cons(cons->cdr)->car;
+ if (ao_lisp_is_const(atom)) {
+ ao_lisp_exception |= AO_LISP_INVALID;
+ return AO_LISP_NIL;
+ }
+ ao_lisp_poly_atom(atom)->val = val;
+ return val;
+}
+
+ao_poly
+ao_lisp_setq(struct ao_lisp_cons *cons)
+{
+ struct ao_lisp_cons *expand = 0;
+ if (!check_argc(cons, 2, 2))
+ return AO_LISP_NIL;
+ expand = ao_lisp_cons_cons(_ao_lisp_atom_set,
+ ao_lisp_cons_cons(ao_lisp_cons_poly(ao_lisp_cons_cons(_ao_lisp_atom_quote,
+ ao_lisp_cons_cons(cons->car, NULL))),
+ ao_lisp_poly_cons(cons->cdr)));
+ return ao_lisp_cons_poly(expand);
+}
+
ao_poly
ao_lisp_print(struct ao_lisp_cons *cons)
{
[builtin_cdr] = ao_lisp_cdr,
[builtin_cons] = ao_lisp_cons,
[builtin_quote] = ao_lisp_quote,
+ [builtin_set] = ao_lisp_set,
+ [builtin_setq] = ao_lisp_setq,
[builtin_print] = ao_lisp_print,
[builtin_plus] = ao_lisp_plus,
[builtin_minus] = ao_lisp_minus,
case AO_LISP_MACRO:
v = ao_lisp_func(b)(ao_lisp_poly_cons(actuals->cdr));
+ DBG("macro "); DBG_POLY(ao_lisp_cons_poly(actuals));
+ DBG(" -> "); DBG_POLY(v);
+ DBG("\n");
if (ao_lisp_poly_type(v) != AO_LISP_CONS) {
ao_lisp_exception |= AO_LISP_INVALID;
return AO_LISP_NIL;
DBG ("\n");
} else {
ao_lisp_exception |= AO_LISP_INVALID;
- return AO_LISP_NIL;
}
+ if (ao_lisp_exception)
+ return AO_LISP_NIL;
done_eval:
if (--cons) {
struct ao_lisp_cons *frame;
frame = ao_lisp_poly_cons(stack->car);
actuals = ao_lisp_poly_cons(frame->car);
formals = ao_lisp_poly_cons(frame->cdr);
+ formals_tail = NULL;
/* Recompute the tail of the formals list */
- for (formal = formals; formal->cdr != AO_LISP_NIL; formal = ao_lisp_poly_cons(formal->cdr));
- formals_tail = formal;
+ if (formals) {
+ for (formal = formals; formal->cdr != AO_LISP_NIL; formal = ao_lisp_poly_cons(formal->cdr));
+ formals_tail = formal;
+ }
stack = ao_lisp_poly_cons(stack->cdr);
DBG("stack pop: stack"); DBG_CONS(stack); DBG("\n");
#include "ao_lisp.h"
#include <stdlib.h>
+#include <ctype.h>
static struct ao_lisp_builtin *
ao_lisp_make_builtin(enum ao_lisp_builtin_id func, int args) {
"cdr", AO_LISP_LEXPR, builtin_cdr,
"cons", AO_LISP_LEXPR, builtin_cons,
"quote", AO_LISP_NLAMBDA,builtin_quote,
+ "set", AO_LISP_LEXPR, builtin_set,
+ "setq", AO_LISP_MACRO, builtin_setq,
"print", AO_LISP_LEXPR, builtin_print,
"+", AO_LISP_LEXPR, builtin_plus,
"-", AO_LISP_LEXPR, builtin_minus,
{
int f, o;
ao_poly atom, val;
+ struct ao_lisp_atom *a;
for (f = 0; f < N_FUNC; f++) {
struct ao_lisp_builtin *b = ao_lisp_make_builtin(funcs[f].func, funcs[f].args);
printf("#define AO_LISP_POOL_CONST %d\n", ao_lisp_top);
printf("extern const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));\n");
printf("#define ao_builtin_atoms 0x%04x\n", ao_lisp_atom_poly(ao_lisp_atoms));
+
+ for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next)) {
+ char *n = a->name, c;
+ printf ("#define _ao_lisp_atom_");
+ while ((c = *n++)) {
+ if (isalnum(c))
+ printf("%c", c);
+ else
+ printf("%02x", c);
+ }
+ printf(" 0x%04x\n", ao_lisp_atom_poly(a));
+ }
printf("#ifdef AO_LISP_CONST_BITS\n");
printf("const uint8_t ao_lisp_const[] = {");
for (o = 0; o < ao_lisp_top; o++) {
+ uint8_t c;
if ((o & 0xf) == 0)
printf("\n\t");
else
printf(" ");
- printf("0x%02x,", ao_lisp_const[o]);
+ c = ao_lisp_const[o];
+ if (' ' < c && c <= '~' && c != '\'')
+ printf (" '%c',", c);
+ else
+ printf("0x%02x,", c);
}
printf("\n};\n");
printf("#endif /* AO_LISP_CONST_BITS */\n");
static struct ao_lisp_cons *read_cons_tail;
static struct ao_lisp_cons *read_stack;
-static ao_poly
-read_item(void)
+static int
+push_read_stack(int cons, int in_quote)
+{
+ if (cons) {
+ read_stack = ao_lisp_cons_cons(ao_lisp_cons_poly(read_cons),
+ ao_lisp_cons_cons(ao_lisp_int_poly(in_quote),
+ read_stack));
+ if (!read_stack)
+ return 0;
+ }
+ read_cons = NULL;
+ read_cons_tail = NULL;
+ return 1;
+}
+
+static int
+pop_read_stack(int cons)
+{
+ int in_quote = 0;
+ if (cons) {
+ read_cons = ao_lisp_poly_cons(read_stack->car);
+ read_stack = ao_lisp_poly_cons(read_stack->cdr);
+ in_quote = ao_lisp_poly_int(read_stack->car);
+ read_stack = ao_lisp_poly_cons(read_stack->cdr);
+ for (read_cons_tail = read_cons;
+ read_cons_tail && read_cons_tail->cdr;
+ read_cons_tail = ao_lisp_poly_cons(read_cons_tail->cdr))
+ ;
+ }
+ return in_quote;
+}
+
+ao_poly
+ao_lisp_read(void)
{
struct ao_lisp_atom *atom;
char *string;
int cons;
+ int in_quote;
ao_poly v;
if (!been_here) {
ao_lisp_root_add(&ao_lisp_cons_type, &read_cons_tail);
ao_lisp_root_add(&ao_lisp_cons_type, &read_stack);
}
+ parse_token = lex();
cons = 0;
+ in_quote = 0;
read_cons = read_cons_tail = read_stack = 0;
for (;;) {
while (parse_token == OPEN) {
- if (cons++)
- read_stack = ao_lisp_cons_cons(ao_lisp_cons_poly(read_cons), read_stack);
- read_cons = NULL;
- read_cons_tail = NULL;
+ if (!push_read_stack(cons, in_quote))
+ return AO_LISP_NIL;
+ cons++;
+ in_quote = 0;
parse_token = lex();
}
else
v = AO_LISP_NIL;
break;
+ case QUOTE:
+ if (!push_read_stack(cons, in_quote))
+ return AO_LISP_NIL;
+ cons++;
+ in_quote = 1;
+ v = _ao_lisp_atom_quote;
+ break;
case CLOSE:
- if (cons)
- v = ao_lisp_cons_poly(read_cons);
- else
+ if (!cons) {
v = AO_LISP_NIL;
- if (--cons) {
- read_cons = ao_lisp_poly_cons(read_stack->car);
- read_stack = ao_lisp_poly_cons(read_stack->cdr);
- for (read_cons_tail = read_cons;
- read_cons_tail && read_cons_tail->cdr;
- read_cons_tail = ao_lisp_poly_cons(read_cons_tail->cdr))
- ;
+ break;
}
+ v = ao_lisp_cons_poly(read_cons);
+ --cons;
+ in_quote = pop_read_stack(cons);
break;
}
- if (!cons)
- break;
+ /* loop over QUOTE ends */
+ for (;;) {
+ if (!cons)
+ return v;
+
+ struct ao_lisp_cons *read = ao_lisp_cons_cons(v, NULL);
+ if (!read)
+ return AO_LISP_NIL;
+
+ if (read_cons_tail)
+ read_cons_tail->cdr = ao_lisp_cons_poly(read);
+ else
+ read_cons = read;
+ read_cons_tail = read;
+
+ if (!in_quote || !read_cons->cdr)
+ break;
- struct ao_lisp_cons *read = ao_lisp_cons_cons(v, NULL);
- if (read_cons_tail)
- read_cons_tail->cdr = ao_lisp_cons_poly(read);
- else
- read_cons = read;
- read_cons_tail = read;
+ v = ao_lisp_cons_poly(read_cons);
+ --cons;
+ in_quote = pop_read_stack(cons);
+ }
parse_token = lex();
}
return v;
}
-
-ao_poly
-ao_lisp_read(void)
-{
- parse_token = lex();
- return read_item();
-}
in = ao_lisp_read();
if (!in)
break;
+// printf ("in: "); ao_lisp_poly_print(in); printf("\n");
out = ao_lisp_eval(in);
if (ao_lisp_exception) {
if (ao_lisp_exception & AO_LISP_OOM)