From c7d7cdc2318a97534c4c1f9c6fd2b51644be729d Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Thu, 10 Nov 2016 11:30:55 -0800 Subject: [PATCH] altos/lisp: add progn, while, read and eval Progn as a builtin will help with tail-recursion. while provides for loops until tail-recursion works :-) read and eval are kinda useful. Signed-off-by: Keith Packard --- src/lisp/ao_lisp.h | 11 ++++- src/lisp/ao_lisp_builtin.c | 41 +++++++++++++++++ src/lisp/ao_lisp_const.lisp | 2 +- src/lisp/ao_lisp_error.c | 1 + src/lisp/ao_lisp_eval.c | 84 ++++++++++++++++++++++++++++++++++- src/lisp/ao_lisp_make_const.c | 4 ++ 6 files changed, 140 insertions(+), 3 deletions(-) diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index de55b307..d265ea7b 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -40,6 +40,8 @@ extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST]; #define _ao_lisp_atom_lambda _atom("lambda") #define _ao_lisp_atom_led _atom("led") #define _ao_lisp_atom_delay _atom("delay") +#define _ao_lisp_atom_eval _atom("eval") +#define _ao_lisp_atom_read _atom("read") #else #include "ao_lisp_const.h" #ifndef AO_LISP_POOL @@ -158,7 +160,10 @@ enum eval_state { eval_formal, eval_exec, eval_cond, - eval_cond_test + eval_cond_test, + eval_progn, + eval_while, + eval_while_test, }; struct ao_lisp_stack { @@ -198,6 +203,8 @@ struct ao_lisp_builtin { }; enum ao_lisp_builtin_id { + builtin_eval, + builtin_read, builtin_lambda, builtin_lexpr, builtin_nlambda, @@ -210,6 +217,8 @@ enum ao_lisp_builtin_id { builtin_set, builtin_setq, builtin_cond, + builtin_progn, + builtin_while, builtin_print, builtin_patom, builtin_plus, diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c index 5bd180e2..57d9ee10 100644 --- a/src/lisp/ao_lisp_builtin.c +++ b/src/lisp/ao_lisp_builtin.c @@ -48,6 +48,8 @@ char *ao_lisp_args_name(uint8_t args) { } #else static const ao_poly builtin_names[] = { + [builtin_eval] = _ao_lisp_atom_eval, + [builtin_read] = _ao_lisp_atom_read, [builtin_lambda] = _ao_lisp_atom_lambda, [builtin_lexpr] = _ao_lisp_atom_lexpr, [builtin_nlambda] = _ao_lisp_atom_nlambda, @@ -60,6 +62,8 @@ static const ao_poly builtin_names[] = { [builtin_set] = _ao_lisp_atom_set, [builtin_setq] = _ao_lisp_atom_setq, [builtin_cond] = _ao_lisp_atom_cond, + [builtin_progn] = _ao_lisp_atom_progn, + [builtin_while] = _ao_lisp_atom_while, [builtin_print] = _ao_lisp_atom_print, [builtin_patom] = _ao_lisp_atom_patom, [builtin_plus] = _ao_lisp_atom_2b, @@ -235,6 +239,22 @@ ao_lisp_cond(struct ao_lisp_cons *cons) return AO_LISP_NIL; } +ao_poly +ao_lisp_progn(struct ao_lisp_cons *cons) +{ + ao_lisp_stack->state = eval_progn; + ao_lisp_stack->sexprs = ao_lisp_cons_poly(cons); + return AO_LISP_NIL; +} + +ao_poly +ao_lisp_while(struct ao_lisp_cons *cons) +{ + ao_lisp_stack->state = eval_while; + ao_lisp_stack->sexprs = ao_lisp_cons_poly(cons); + return AO_LISP_NIL; +} + ao_poly ao_lisp_print(struct ao_lisp_cons *cons) { @@ -476,7 +496,26 @@ ao_lisp_delay(struct ao_lisp_cons *cons) return delay; } +ao_poly +ao_lisp_do_eval(struct ao_lisp_cons *cons) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_eval, cons, 1, 1)) + return AO_LISP_NIL; + ao_lisp_stack->state = eval_sexpr; + return cons->car; +} + +ao_poly +ao_lisp_do_read(struct ao_lisp_cons *cons) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_read, cons, 0, 0)) + return AO_LISP_NIL; + return ao_lisp_read(); +} + const ao_lisp_func_t ao_lisp_builtins[] = { + [builtin_eval] = ao_lisp_do_eval, + [builtin_read] = ao_lisp_do_read, [builtin_lambda] = ao_lisp_lambda, [builtin_lexpr] = ao_lisp_lexpr, [builtin_nlambda] = ao_lisp_nlambda, @@ -489,6 +528,8 @@ const ao_lisp_func_t ao_lisp_builtins[] = { [builtin_set] = ao_lisp_set, [builtin_setq] = ao_lisp_setq, [builtin_cond] = ao_lisp_cond, + [builtin_progn] = ao_lisp_progn, + [builtin_while] = ao_lisp_while, [builtin_print] = ao_lisp_print, [builtin_patom] = ao_lisp_patom, [builtin_plus] = ao_lisp_plus, diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp index 08a511d9..c6f50e34 100644 --- a/src/lisp/ao_lisp_const.lisp +++ b/src/lisp/ao_lisp_const.lisp @@ -7,7 +7,7 @@ ; evaluate a list of sexprs -(setq progn (lexpr (l) (last l))) +;(setq progn (lexpr (l) (last l))) ; simple math operators diff --git a/src/lisp/ao_lisp_error.c b/src/lisp/ao_lisp_error.c index 8b9fe2d5..cfa78d22 100644 --- a/src/lisp/ao_lisp_error.c +++ b/src/lisp/ao_lisp_error.c @@ -73,6 +73,7 @@ static const char *state_names[] = { "exec", "cond", "cond_test", + "progn", }; void diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c index f3372f2a..c5addcb0 100644 --- a/src/lisp/ao_lisp_eval.c +++ b/src/lisp/ao_lisp_eval.c @@ -12,7 +12,7 @@ * General Public License for more details. */ -#define DBG_EVAL 0 +#define DBG_EVAL 1 #include "ao_lisp.h" #include @@ -478,6 +478,85 @@ ao_lisp_eval_cond_test(void) return 1; } +/* + * Evaluate a list of sexprs, returning the value from the last one. + * + * ao_lisp_progn records the list in stack->sexprs, so we just need to + * walk that list. Set ao_lisp_v to the car of the list and jump to + * eval_sexpr. When that's done, it will land in eval_val. For all but + * the last, leave a stack frame with eval_progn set so that we come + * back here. For the last, don't add a stack frame so that we can + * just continue on. + */ +static int +ao_lisp_eval_progn(void) +{ + DBGI("progn: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n"); + DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n"); + DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n"); + + if (!ao_lisp_stack->sexprs) { + ao_lisp_v = AO_LISP_NIL; + ao_lisp_stack->state = eval_val; + } else { + ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car; + ao_lisp_stack->sexprs = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr; + if (ao_lisp_stack->sexprs) { + ao_lisp_stack->state = eval_progn; + if (!ao_lisp_stack_push()) + return 0; + } + ao_lisp_stack->state = eval_sexpr; + } + return 1; +} + +/* + * Conditionally execute a list of sexprs while the first is true + */ +static int +ao_lisp_eval_while(void) +{ + DBGI("while: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n"); + DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n"); + DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n"); + + if (!ao_lisp_stack->sexprs) { + ao_lisp_v = AO_LISP_NIL; + ao_lisp_stack->state = eval_val; + } else { + ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car; + ao_lisp_stack->state = eval_while_test; + if (!ao_lisp_stack_push()) + return 0; + ao_lisp_stack->state = eval_sexpr; + } + return 1; +} + +/* + * Check the while condition, terminate the loop if nil. Otherwise keep going + */ +static int +ao_lisp_eval_while_test(void) +{ + DBGI("while_test: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n"); + DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n"); + DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n"); + + if (ao_lisp_v) { + ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr; + if (ao_lisp_v) + ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car; + ao_lisp_stack->state = eval_while; + if (!ao_lisp_stack_push()) + return 0; + } + else + ao_lisp_stack->state = eval_val; + return 1; +} + static int (*const evals[])(void) = { [eval_sexpr] = ao_lisp_eval_sexpr, [eval_val] = ao_lisp_eval_val, @@ -485,6 +564,9 @@ static int (*const evals[])(void) = { [eval_exec] = ao_lisp_eval_exec, [eval_cond] = ao_lisp_eval_cond, [eval_cond_test] = ao_lisp_eval_cond_test, + [eval_progn] = ao_lisp_eval_progn, + [eval_while] = ao_lisp_eval_while, + [eval_while_test] = ao_lisp_eval_while_test, }; ao_poly diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c index 6f852f9d..bb4afbfb 100644 --- a/src/lisp/ao_lisp_make_const.c +++ b/src/lisp/ao_lisp_make_const.c @@ -33,6 +33,8 @@ struct builtin_func { }; struct builtin_func funcs[] = { + "eval", AO_LISP_FUNC_LAMBDA, builtin_eval, + "read", AO_LISP_FUNC_LAMBDA, builtin_read, "lambda", AO_LISP_FUNC_NLAMBDA, builtin_lambda, "lexpr", AO_LISP_FUNC_NLAMBDA, builtin_lexpr, "nlambda", AO_LISP_FUNC_NLAMBDA, builtin_nlambda, @@ -45,6 +47,8 @@ struct builtin_func funcs[] = { "set", AO_LISP_FUNC_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_LEXPR, builtin_print, "patom", AO_LISP_FUNC_LEXPR, builtin_patom, "+", AO_LISP_FUNC_LEXPR, builtin_plus, -- 2.30.2