altos/lisp: Switch to scheme formal syntax for varargs
[fw/altos] / src / lisp / ao_lisp_make_const.c
index 60bb80f01e8059b01c534b7a306d933f59d3579d..6e4b411ee351c9882d1b02b9dbf10ad01ad46757 100644 (file)
@@ -31,47 +31,11 @@ ao_lisp_make_builtin(enum ao_lisp_builtin_id func, int args) {
 struct builtin_func {
        char    *name;
        int     args;
-       int     func;
+       enum ao_lisp_builtin_id func;
 };
 
-struct builtin_func funcs[] = {
-       { .name = "eval",       .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_eval },
-       { .name = "read",       .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_read },
-       { .name = "lambda",     .args = AO_LISP_FUNC_NLAMBDA,   .func = builtin_lambda },
-       { .name = "lexpr",      .args = AO_LISP_FUNC_NLAMBDA,   .func = builtin_lexpr },
-       { .name = "nlambda",    .args = AO_LISP_FUNC_NLAMBDA,   .func = builtin_nlambda },
-       { .name = "macro",      .args = AO_LISP_FUNC_NLAMBDA,   .func = builtin_macro },
-       { .name = "car",        .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_car },
-       { .name = "cdr",        .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_cdr },
-       { .name = "cons",       .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_cons },
-       { .name = "last",       .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_last },
-       { .name = "length",     .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_length },
-       { .name = "quote",      .args = AO_LISP_FUNC_NLAMBDA,   .func = builtin_quote },
-       { .name = "set",        .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_set },
-       { .name = "setq",       .args = AO_LISP_FUNC_MACRO,     .func = builtin_setq },
-       { .name = "cond",       .args = AO_LISP_FUNC_NLAMBDA,   .func = builtin_cond },
-       { .name = "progn",      .args = AO_LISP_FUNC_NLAMBDA,   .func = builtin_progn },
-       { .name = "while",      .args = AO_LISP_FUNC_NLAMBDA,   .func = builtin_while },
-       { .name = "print",      .args = AO_LISP_FUNC_F_LEXPR,   .func = builtin_print },
-       { .name = "patom",      .args = AO_LISP_FUNC_F_LEXPR,   .func = builtin_patom },
-       { .name = "+",          .args = AO_LISP_FUNC_F_LEXPR,   .func = builtin_plus },
-       { .name = "-",          .args = AO_LISP_FUNC_F_LEXPR,   .func = builtin_minus },
-       { .name = "*",          .args = AO_LISP_FUNC_F_LEXPR,   .func = builtin_times },
-       { .name = "/",          .args = AO_LISP_FUNC_F_LEXPR,   .func = builtin_divide },
-       { .name = "%",          .args = AO_LISP_FUNC_F_LEXPR,   .func = builtin_mod },
-       { .name = "=",          .args = AO_LISP_FUNC_F_LEXPR,   .func = builtin_equal },
-       { .name = "<",          .args = AO_LISP_FUNC_F_LEXPR,   .func = builtin_less },
-       { .name = ">",          .args = AO_LISP_FUNC_F_LEXPR,   .func = builtin_greater },
-       { .name = "<=",         .args = AO_LISP_FUNC_F_LEXPR,   .func = builtin_less_equal },
-       { .name = ">=",         .args = AO_LISP_FUNC_F_LEXPR,   .func = builtin_greater_equal },
-       { .name = "pack",       .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_pack },
-       { .name = "unpack",     .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_unpack },
-       { .name = "flush",      .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_flush },
-       { .name = "delay",      .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_delay },
-       { .name = "led",        .args = AO_LISP_FUNC_F_LEXPR,   .func = builtin_led },
-       { .name = "save",       .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_save },
-       { .name = "restore",    .args = AO_LISP_FUNC_F_LAMBDA,  .func = builtin_restore },
-};
+#define AO_LISP_BUILTIN_CONSTS
+#include "ao_lisp_builtin.h"
 
 #define N_FUNC (sizeof funcs / sizeof funcs[0])
 
@@ -136,6 +100,7 @@ ao_lisp_macro_push(ao_poly p)
        m->p = p;
        m->next = macro_stack;
        macro_stack = m;
+       return 0;
 }
 
 void
@@ -168,7 +133,7 @@ ao_has_macro(ao_poly p);
 ao_poly
 ao_macro_test_get(ao_poly atom)
 {
-       ao_poly *ref = ao_lisp_atom_ref(ao_lisp_frame_global, atom);
+       ao_poly *ref = ao_lisp_atom_ref(atom);
        if (ref)
                return *ref;
        return AO_LISP_NIL;
@@ -181,7 +146,7 @@ ao_is_macro(ao_poly p)
        struct ao_lisp_lambda   *lambda;
        ao_poly ret;
 
-       MACRO_DEBUG(indent(); printf ("is macro "); ao_lisp_poly_print(p); printf("\n"); ++macro_scan_depth);
+       MACRO_DEBUG(indent(); printf ("is macro "); ao_lisp_poly_write(p); printf("\n"); ++macro_scan_depth);
        switch (ao_lisp_poly_type(p)) {
        case AO_LISP_ATOM:
                if (ao_lisp_macro_push(p))
@@ -216,7 +181,7 @@ ao_is_macro(ao_poly p)
                ret = AO_LISP_NIL;
                break;
        }
-       MACRO_DEBUG(--macro_scan_depth; indent(); printf ("... "); ao_lisp_poly_print(ret); printf("\n"));
+       MACRO_DEBUG(--macro_scan_depth; indent(); printf ("... "); ao_lisp_poly_write(ret); printf("\n"));
        return ret;
 }
 
@@ -226,11 +191,12 @@ ao_has_macro(ao_poly p)
        struct ao_lisp_cons     *cons;
        struct ao_lisp_lambda   *lambda;
        ao_poly                 m;
+       ao_poly                 list;
 
        if (p == AO_LISP_NIL)
                return AO_LISP_NIL;
 
-       MACRO_DEBUG(indent(); printf("has macro "); ao_lisp_poly_print(p); printf("\n"); ++macro_scan_depth);
+       MACRO_DEBUG(indent(); printf("has macro "); ao_lisp_poly_write(p); printf("\n"); ++macro_scan_depth);
        switch (ao_lisp_poly_type(p)) {
        case AO_LISP_LAMBDA:
                lambda = ao_lisp_poly_lambda(p);
@@ -241,15 +207,16 @@ ao_has_macro(ao_poly p)
                if ((p = ao_is_macro(cons->car)))
                        break;
 
-               cons = ao_lisp_poly_cons(cons->cdr);
+               list = cons->cdr;
                p = AO_LISP_NIL;
-               while (cons) {
+               while (list != AO_LISP_NIL && ao_lisp_poly_type(list) == AO_LISP_CONS) {
+                       cons = ao_lisp_poly_cons(list);
                        m = ao_has_macro(cons->car);
                        if (m) {
                                p = m;
                                break;
                        }
-                       cons = ao_lisp_poly_cons(cons->cdr);
+                       list = cons->cdr;
                }
                break;
 
@@ -257,7 +224,7 @@ ao_has_macro(ao_poly p)
                p = AO_LISP_NIL;
                break;
        }
-       MACRO_DEBUG(--macro_scan_depth; indent(); printf("... "); ao_lisp_poly_print(p); printf("\n"));
+       MACRO_DEBUG(--macro_scan_depth; indent(); printf("... "); ao_lisp_poly_write(p); printf("\n"));
        return p;
 }
 
@@ -272,7 +239,7 @@ ao_lisp_read_eval_abort(void)
                out = ao_lisp_eval(in);
                if (ao_lisp_exception)
                        return 0;
-               ao_lisp_poly_print(out);
+               ao_lisp_poly_write(out);
                putchar ('\n');
        }
        return 1;
@@ -305,9 +272,10 @@ main(int argc, char **argv)
        ao_poly val;
        struct ao_lisp_atom     *a;
        struct ao_lisp_builtin  *b;
-       int     in_atom;
-       char    *out_name;
+       int     in_atom = 0;
+       char    *out_name = NULL;
        int     c;
+       enum ao_lisp_builtin_id prev_func;
 
        in = stdin;
        out = stdout;
@@ -323,25 +291,29 @@ main(int argc, char **argv)
                }
        }
 
+       ao_lisp_frame_init();
+
+       /* Boolean values #f and #t */
+       ao_lisp_bool_get(0);
+       ao_lisp_bool_get(1);
+
+       prev_func = _builtin_last;
        for (f = 0; f < (int) N_FUNC; f++) {
-               b = ao_lisp_make_builtin(funcs[f].func, funcs[f].args);
+               if (funcs[f].func != prev_func)
+                       b = ao_lisp_make_builtin(funcs[f].func, funcs[f].args);
                a = ao_lisp_atom_intern(funcs[f].name);
-               ao_lisp_atom_set(ao_lisp_atom_poly(a),
+               ao_lisp_atom_def(ao_lisp_atom_poly(a),
                                 ao_lisp_builtin_poly(b));
        }
 
-       /* boolean constants */
-       ao_lisp_atom_set(ao_lisp_atom_poly(ao_lisp_atom_intern("nil")),
-                        AO_LISP_NIL);
-       a = ao_lisp_atom_intern("t");
-       ao_lisp_atom_set(ao_lisp_atom_poly(a),
-                        ao_lisp_atom_poly(a));
-
        /* end of file value */
        a = ao_lisp_atom_intern("eof");
-       ao_lisp_atom_set(ao_lisp_atom_poly(a),
+       ao_lisp_atom_def(ao_lisp_atom_poly(a),
                         ao_lisp_atom_poly(a));
 
+       /* 'else' */
+       a = ao_lisp_atom_intern("else");
+
        if (argv[optind]){
                in = fopen(argv[optind], "r");
                if (!in) {
@@ -357,12 +329,13 @@ main(int argc, char **argv)
        /* Reduce to referenced values */
        ao_lisp_collect(AO_LISP_COLLECT_FULL);
 
-       for (f = 0; f < ao_lisp_frame_num(ao_lisp_frame_global); f++) {
-               val = ao_has_macro(ao_lisp_frame_global->vals[f].val);
+       for (f = 0; f < ao_lisp_frame_global->num; f++) {
+               struct ao_lisp_frame_vals       *vals = ao_lisp_poly_frame_vals(ao_lisp_frame_global->vals);
+               val = ao_has_macro(vals->vals[f].val);
                if (val != AO_LISP_NIL) {
                        printf("error: function %s contains unresolved macro: ",
-                              ao_lisp_poly_atom(ao_lisp_frame_global->vals[f].atom)->name);
-                       ao_lisp_poly_print(val);
+                              ao_lisp_poly_atom(vals->vals[f].atom)->name);
+                       ao_lisp_poly_write(val);
                        printf("\n");
                        exit(1);
                }
@@ -384,6 +357,8 @@ main(int argc, char **argv)
        fprintf(out, "#define ao_builtin_frame 0x%04x\n", ao_lisp_frame_poly(ao_lisp_frame_global));
        fprintf(out, "#define ao_lisp_const_checksum ((uint16_t) 0x%04x)\n", ao_fec_crc(ao_lisp_const, ao_lisp_top));
 
+       fprintf(out, "#define _ao_lisp_bool_false 0x%04x\n", ao_lisp_bool_poly(ao_lisp_false));
+       fprintf(out, "#define _ao_lisp_bool_true 0x%04x\n", ao_lisp_bool_poly(ao_lisp_true));
 
        for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next)) {
                char    *n = a->name, c;
@@ -397,7 +372,7 @@ main(int argc, char **argv)
                fprintf(out, "  0x%04x\n", ao_lisp_atom_poly(a));
        }
        fprintf(out, "#ifdef AO_LISP_CONST_BITS\n");
-       fprintf(out, "const uint8_t ao_lisp_const[] = {");
+       fprintf(out, "const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute((aligned(4))) = {");
        for (o = 0; o < ao_lisp_top; o++) {
                uint8_t c;
                if ((o & 0xf) == 0)