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 <keithp@keithp.com>

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index de55b3076888fed40047df96735033510ed4c6fa..d265ea7bb9db23daab33404eb4691b63d1e533bc 100644 (file)
--- 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 5bd180e2500370766c7c22981e01397e5e1b85a5..57d9ee10edd1ecca5869ba066280a35bcf684267 100644 (file)
--- 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 08a511d9cf0ec380e4fc696956b9e329eb4fdf4b..c6f50e346c9dd8bb61fcbc12eee7c6525af1ea23 100644 (file)
--- 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 8b9fe2d5fd4d6f9e6993d6ba8b79c4ef2710c8d4..cfa78d2272e73c473f2196464333cd497ec6c6ab 100644 (file)
--- 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 f3372f2a4e52ee73c39985ec9cd3584268694d4c..c5addcb0abd1baae60afe6ea76a51dd9e8da6420 100644 (file)
--- 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 <assert.h>
 
@@ -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 6f852f9d9a1f15d6c1f148f53c10334c189595de..bb4afbfb322363c7a13140abab952378128819da 100644 (file)
--- 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,