From 974717eb9dad105c9897ee24f953d98d57eaec77 Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Tue, 15 Nov 2016 09:55:22 -0800 Subject: [PATCH] altos/lisp: Evaluate macros once, then smash them into place This assumes that macros are all pure functions, which should be true for syntactic macros. Signed-off-by: Keith Packard --- src/lisp/Makefile | 5 +- src/lisp/ao_lisp.h | 17 +-- src/lisp/ao_lisp_builtin.c | 2 + src/lisp/ao_lisp_const.lisp | 24 ++-- src/lisp/ao_lisp_eval.c | 23 ++- src/lisp/ao_lisp_make_const.c | 263 ++++++++++++++++++++++++++-------- src/lisp/ao_lisp_os.h | 7 +- 7 files changed, 253 insertions(+), 88 deletions(-) diff --git a/src/lisp/Makefile b/src/lisp/Makefile index dac11f66..b06e10dd 100644 --- a/src/lisp/Makefile +++ b/src/lisp/Makefile @@ -4,7 +4,7 @@ clean: rm -f ao_lisp_const.h $(OBJS) ao_lisp_make_const ao_lisp_const.h: ao_lisp_const.lisp ao_lisp_make_const - ./ao_lisp_make_const < ao_lisp_const.lisp > $@ + ./ao_lisp_make_const -o $@ ao_lisp_const.lisp SRCS=\ ao_lisp_make_const.c\ @@ -25,10 +25,11 @@ SRCS=\ OBJS=$(SRCS:.c=.o) -CFLAGS=-DAO_LISP_MAKE_CONST -O0 -g -I. +CFLAGS=-DAO_LISP_MAKE_CONST -O0 -g -I. -Wall -Wextra HDRS=\ ao_lisp.h \ + ao_lisp_os.h \ ao_lisp_read.h ao_lisp_make_const: $(OBJS) diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index efd13cf5..2db4914f 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -173,14 +173,15 @@ ao_lisp_frame_poly(struct ao_lisp_frame *frame) { enum eval_state { eval_sexpr, /* Evaluate an sexpr */ - eval_val, - eval_formal, - eval_exec, - eval_cond, - eval_cond_test, - eval_progn, - eval_while, - eval_while_test, + eval_val, /* Value computed */ + eval_formal, /* Formal computed */ + eval_exec, /* Start a lambda evaluation */ + eval_cond, /* Start next cond clause */ + eval_cond_test, /* Check cond condition */ + eval_progn, /* Start next progn entry */ + eval_while, /* Start while condition */ + eval_while_test, /* Check while condition */ + eval_macro, /* Finished with macro generation */ }; struct ao_lisp_stack { diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c index ebc69f77..e4b7ef52 100644 --- a/src/lisp/ao_lisp_builtin.c +++ b/src/lisp/ao_lisp_builtin.c @@ -41,9 +41,11 @@ const struct ao_lisp_type ao_lisp_builtin_type = { #ifdef AO_LISP_MAKE_CONST char *ao_lisp_builtin_name(enum ao_lisp_builtin_id b) { + (void) b; return "???"; } char *ao_lisp_args_name(uint8_t args) { + (void) args; return "???"; } #else diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp index c6f50e34..9d8af588 100644 --- a/src/lisp/ao_lisp_const.lisp +++ b/src/lisp/ao_lisp_const.lisp @@ -9,10 +9,6 @@ ;(setq progn (lexpr (l) (last l))) - ; simple math operators - -(setq 1+ (lambda (x) (+ x 1))) -(setq 1- (lambda (x) (- x 1))) ; ; Define a variable without returning the value @@ -64,7 +60,7 @@ ; make the list of names in the let ; - (set 'make-names (lambda (vars) + (setq make-names (lambda (vars) (cond (vars (cons (car (car vars)) (make-names (cdr vars)))) @@ -77,7 +73,7 @@ ; pre-pended to the ; expressions to evaluate ; - (set 'make-exprs (lambda (vars exprs) + (setq make-exprs (lambda (vars exprs) (progn (cond (vars (cons (list set @@ -94,13 +90,13 @@ ) ) ) - (set 'exprs (make-exprs vars exprs)) + (setq exprs (make-exprs vars exprs)) ; ; the parameters to the lambda is a list ; of nils of the right length ; - (set 'make-nils (lambda (vars) + (setq make-nils (lambda (vars) (cond (vars (cons nil (make-nils (cdr vars)))) ) ) @@ -108,7 +104,6 @@ ; ; build the lambda. ; - (set 'last-let-value (cons (list 'lambda @@ -120,8 +115,6 @@ (make-nils vars) ) ) - ) - ) (car let-param) (cdr let-param) @@ -158,3 +151,12 @@ ) ) ) + + ; simple math operators + ; + ; Do these last to run defun + ; at least once so the let macro + ; is resolved + +(defun 1+ (x) (+ x 1)) +(defun 1- (x) (- x 1)) diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c index 5cc1b75a..3af56796 100644 --- a/src/lisp/ao_lisp_eval.c +++ b/src/lisp/ao_lisp_eval.c @@ -298,7 +298,7 @@ ao_lisp_eval_formal(void) break; case AO_LISP_FUNC_MACRO: /* Evaluate the result once more */ - ao_lisp_stack->state = eval_sexpr; + ao_lisp_stack->state = eval_macro; if (!ao_lisp_stack_push()) return 0; @@ -308,7 +308,6 @@ ao_lisp_eval_formal(void) prev = ao_lisp_poly_stack(ao_lisp_stack->prev); ao_lisp_stack->state = eval_sexpr; ao_lisp_stack->sexprs = prev->sexprs; - prev->sexprs = AO_LISP_NIL; DBGI(".. start macro\n"); DBGI(".. sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n"); @@ -555,6 +554,25 @@ ao_lisp_eval_while_test(void) return 1; } +/* + * Replace the original sexpr with the macro expansion, then + * execute that + */ +static int +ao_lisp_eval_macro(void) +{ + DBGI("macro: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n"); + + if (ao_lisp_poly_type(ao_lisp_v) == AO_LISP_CONS) { + *ao_lisp_poly_cons(ao_lisp_stack->sexprs) = *ao_lisp_poly_cons(ao_lisp_v); + ao_lisp_v = ao_lisp_stack->sexprs; + DBGI("sexprs rewritten to: "); DBG_POLY(ao_lisp_v); DBG("\n"); + } + ao_lisp_stack->sexprs = AO_LISP_NIL; + ao_lisp_stack->state = eval_sexpr; + return 1; +} + static int (*const evals[])(void) = { [eval_sexpr] = ao_lisp_eval_sexpr, [eval_val] = ao_lisp_eval_val, @@ -565,6 +583,7 @@ static int (*const evals[])(void) = { [eval_progn] = ao_lisp_eval_progn, [eval_while] = ao_lisp_eval_while, [eval_while_test] = ao_lisp_eval_while_test, + [eval_macro] = ao_lisp_eval_macro, }; /* diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c index 178b041e..ae53bd35 100644 --- a/src/lisp/ao_lisp_make_const.c +++ b/src/lisp/ao_lisp_make_const.c @@ -15,6 +15,8 @@ #include "ao_lisp.h" #include #include +#include +#include static struct ao_lisp_builtin * ao_lisp_make_builtin(enum ao_lisp_builtin_id func, int args) { @@ -33,42 +35,42 @@ struct builtin_func { }; struct builtin_func funcs[] = { - "eval", AO_LISP_FUNC_F_LAMBDA, builtin_eval, - "read", AO_LISP_FUNC_F_LAMBDA, builtin_read, - "lambda", AO_LISP_FUNC_NLAMBDA, builtin_lambda, - "lexpr", AO_LISP_FUNC_NLAMBDA, builtin_lexpr, - "nlambda", AO_LISP_FUNC_NLAMBDA, builtin_nlambda, - "macro", AO_LISP_FUNC_NLAMBDA, builtin_macro, - "car", AO_LISP_FUNC_F_LAMBDA, builtin_car, - "cdr", AO_LISP_FUNC_F_LAMBDA, builtin_cdr, - "cons", AO_LISP_FUNC_F_LAMBDA, builtin_cons, - "last", AO_LISP_FUNC_F_LAMBDA, builtin_last, - "length", AO_LISP_FUNC_F_LAMBDA, builtin_length, - "quote", AO_LISP_FUNC_NLAMBDA, builtin_quote, - "set", AO_LISP_FUNC_F_LAMBDA, builtin_set, - "setq", AO_LISP_FUNC_MACRO, builtin_setq, - "cond", AO_LISP_FUNC_NLAMBDA, builtin_cond, - "progn", AO_LISP_FUNC_NLAMBDA, builtin_progn, - "while", AO_LISP_FUNC_NLAMBDA, builtin_while, - "print", AO_LISP_FUNC_F_LEXPR, builtin_print, - "patom", AO_LISP_FUNC_F_LEXPR, builtin_patom, - "+", AO_LISP_FUNC_F_LEXPR, builtin_plus, - "-", AO_LISP_FUNC_F_LEXPR, builtin_minus, - "*", AO_LISP_FUNC_F_LEXPR, builtin_times, - "/", AO_LISP_FUNC_F_LEXPR, builtin_divide, - "%", AO_LISP_FUNC_F_LEXPR, builtin_mod, - "=", AO_LISP_FUNC_F_LEXPR, builtin_equal, - "<", AO_LISP_FUNC_F_LEXPR, builtin_less, - ">", AO_LISP_FUNC_F_LEXPR, builtin_greater, - "<=", AO_LISP_FUNC_F_LEXPR, builtin_less_equal, - ">=", AO_LISP_FUNC_F_LEXPR, builtin_greater_equal, - "pack", AO_LISP_FUNC_F_LAMBDA, builtin_pack, - "unpack", AO_LISP_FUNC_F_LAMBDA, builtin_unpack, - "flush", AO_LISP_FUNC_F_LAMBDA, builtin_flush, - "delay", AO_LISP_FUNC_F_LAMBDA, builtin_delay, - "led", AO_LISP_FUNC_F_LEXPR, builtin_led, - "save", AO_LISP_FUNC_F_LAMBDA, builtin_save, - "restore", AO_LISP_FUNC_F_LAMBDA, builtin_restore, + { .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 N_FUNC (sizeof funcs / sizeof funcs[0]) @@ -113,18 +115,127 @@ ao_fec_crc(const uint8_t *bytes, uint8_t len) return crc; } +int +ao_is_macro(ao_poly p) +{ + struct ao_lisp_builtin *builtin; + struct ao_lisp_lambda *lambda; + +// printf ("macro scanning "); ao_lisp_poly_print(p); printf("\n"); + switch (ao_lisp_poly_type(p)) { + case AO_LISP_ATOM: + return ao_is_macro(ao_lisp_atom_get(p)); + case AO_LISP_BUILTIN: + builtin = ao_lisp_poly_builtin(p); + if ((builtin->args & AO_LISP_FUNC_MASK) == AO_LISP_FUNC_MACRO) + return 1; + return 0; + case AO_LISP_LAMBDA: + lambda = ao_lisp_poly_lambda(p); + if (lambda->args == AO_LISP_FUNC_MACRO) + return 1; + return 0; + default: + return 0; + } +} + +ao_poly +ao_has_macro(ao_poly p) +{ + struct ao_lisp_cons *cons; + struct ao_lisp_lambda *lambda; + ao_poly m; + + if (p == AO_LISP_NIL) + return AO_LISP_NIL; + + switch (ao_lisp_poly_type(p)) { + case AO_LISP_LAMBDA: + lambda = ao_lisp_poly_lambda(p); + return ao_has_macro(lambda->code); + case AO_LISP_CONS: + cons = ao_lisp_poly_cons(p); + if (ao_is_macro(cons->car)) + return cons->car; + + cons = ao_lisp_poly_cons(cons->cdr); + while (cons) { + m = ao_has_macro(cons->car); + if (m) + return m; + cons = ao_lisp_poly_cons(cons->cdr); + } + return AO_LISP_NIL; + + default: + return AO_LISP_NIL; + } +} + +int +ao_lisp_read_eval_abort(void) +{ + ao_poly in, out = AO_LISP_NIL; + for(;;) { + in = ao_lisp_read(); + if (in == _ao_lisp_atom_eof) + break; + out = ao_lisp_eval(in); + if (ao_lisp_exception) + return 0; + ao_lisp_poly_print(out); + putchar ('\n'); + } + return 1; +} + +static FILE *in; +static FILE *out; + +int +ao_lisp_getc(void) +{ + return getc(in); +} + +static const struct option options[] = { + { .name = "out", .has_arg = 1, .val = 'o' }, + { 0, 0, 0, 0 } +}; + +static void usage(char *program) +{ + fprintf(stderr, "usage: %s [--out=] [input]\n", program); + exit(1); +} + int main(int argc, char **argv) { - int f, o, i; - ao_poly sexpr, val; + int f, o; + ao_poly val; struct ao_lisp_atom *a; struct ao_lisp_builtin *b; int in_atom; + char *out_name; + int c; + + in = stdin; + out = stdout; + + while ((c = getopt_long(argc, argv, "o:", options, NULL)) != -1) { + switch (c) { + case 'o': + out_name = optarg; + break; + default: + usage(argv[0]); + break; + } + } - printf("/*\n"); - printf(" * Generated file, do not edit\n"); - for (f = 0; f < N_FUNC; f++) { + for (f = 0; f < (int) N_FUNC; f++) { 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), @@ -143,47 +254,79 @@ main(int argc, char **argv) ao_lisp_atom_set(ao_lisp_atom_poly(a), ao_lisp_atom_poly(a)); - ao_lisp_read_eval_print(); + if (argv[optind]){ + in = fopen(argv[optind], "r"); + if (!in) { + perror(argv[optind]); + exit(1); + } + } + if (!ao_lisp_read_eval_abort()) { + fprintf(stderr, "eval failed\n"); + exit(1); + } /* Reduce to referenced values */ ao_lisp_collect(); - printf(" */\n"); - 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)); - printf("#define ao_builtin_frame 0x%04x\n", ao_lisp_frame_poly(ao_lisp_frame_global)); - printf("#define ao_lisp_const_checksum ((uint16_t) 0x%04x)\n", ao_fec_crc(ao_lisp_const, ao_lisp_top)); + for (f = 0; f < ao_lisp_frame_global->num; f++) { + val = ao_has_macro(ao_lisp_frame_global->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); + printf(stderr, "\n"); + exit(1); + } + } + + if (out_name) { + out = fopen(out_name, "w"); + if (!out) { + perror(out_name); + exit(1); + } + } + + fprintf(out, "/* Generated file, do not edit */\n\n"); + + fprintf(out, "#define AO_LISP_POOL_CONST %d\n", ao_lisp_top); + fprintf(out, "extern const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));\n"); + fprintf(out, "#define ao_builtin_atoms 0x%04x\n", ao_lisp_atom_poly(ao_lisp_atoms)); + 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)); + for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next)) { char *n = a->name, c; - printf ("#define _ao_lisp_atom_"); + fprintf(out, "#define _ao_lisp_atom_"); while ((c = *n++)) { if (isalnum(c)) - printf("%c", c); + fprintf(out, "%c", c); else - printf("%02x", c); + fprintf(out, "%02x", c); } - printf(" 0x%04x\n", ao_lisp_atom_poly(a)); + fprintf(out, " 0x%04x\n", ao_lisp_atom_poly(a)); } - printf("#ifdef AO_LISP_CONST_BITS\n"); - printf("const uint8_t ao_lisp_const[] = {"); + fprintf(out, "#ifdef AO_LISP_CONST_BITS\n"); + fprintf(out, "const uint8_t ao_lisp_const[] = {"); for (o = 0; o < ao_lisp_top; o++) { uint8_t c; if ((o & 0xf) == 0) - printf("\n\t"); + fprintf(out, "\n\t"); else - printf(" "); + fprintf(out, " "); c = ao_lisp_const[o]; if (!in_atom) in_atom = is_atom(o); if (in_atom) { - printf (" '%c',", c); + fprintf(out, " '%c',", c); in_atom--; } else { - printf("0x%02x,", c); + fprintf(out, "0x%02x,", c); } } - printf("\n};\n"); - printf("#endif /* AO_LISP_CONST_BITS */\n"); + fprintf(out, "\n};\n"); + fprintf(out, "#endif /* AO_LISP_CONST_BITS */\n"); + exit(0); } diff --git a/src/lisp/ao_lisp_os.h b/src/lisp/ao_lisp_os.h index b7bf7a2c..5fa3686b 100644 --- a/src/lisp/ao_lisp_os.h +++ b/src/lisp/ao_lisp_os.h @@ -22,13 +22,10 @@ #include #include -static inline int -ao_lisp_getc() { - return getchar(); -} +extern int ao_lisp_getc(void); static inline void -ao_lisp_os_flush() { +ao_lisp_os_flush(void) { fflush(stdout); } -- 2.30.2