From eaa528e4e62ba1d9765888760d387303487b2e01 Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Thu, 17 Nov 2016 16:08:15 -0800 Subject: [PATCH] altos/lisp: Make lambda, cond and while all have implicit progns This lets all of these execute more than one sexpr, returning the value of the last. Signed-off-by: Keith Packard --- src/lisp/ao_lisp_eval.c | 26 +++++++++++++++----------- src/lisp/ao_lisp_lambda.c | 22 ++++++++++++++-------- 2 files changed, 29 insertions(+), 19 deletions(-) diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c index 6f56a120..5fa9e0ad 100644 --- a/src/lisp/ao_lisp_eval.c +++ b/src/lisp/ao_lisp_eval.c @@ -310,7 +310,6 @@ ao_lisp_eval_formal(void) * value and re-evaluate it */ prev = ao_lisp_poly_stack(ao_lisp_stack->prev); - ao_lisp_stack->state = eval_sexpr; ao_lisp_stack->sexprs = prev->sexprs; DBGI(".. start macro\n"); @@ -401,10 +400,11 @@ ao_lisp_eval_exec(void) DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n"); break; case AO_LISP_LAMBDA: - ao_lisp_stack->state = eval_sexpr; DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n"); - ao_lisp_v = ao_lisp_lambda_eval(); - DBGI(".. sexpr "); DBG_POLY(ao_lisp_v); DBG("\n"); + ao_lisp_stack->state = eval_progn; + v = ao_lisp_lambda_eval(); + ao_lisp_stack->sexprs = v; + DBGI(".. sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n"); DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n"); break; } @@ -442,7 +442,6 @@ ao_lisp_eval_cond(void) ao_lisp_stack->state = eval_cond_test; if (!ao_lisp_stack_push()) return 0; - ao_lisp_stack->state = eval_sexpr; } return 1; } @@ -464,11 +463,11 @@ ao_lisp_eval_cond_test(void) DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n"); if (ao_lisp_v) { struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car); - struct ao_lisp_cons *c = ao_lisp_poly_cons(car->cdr); + ao_poly c = car->cdr; if (c) { - ao_lisp_stack->state = eval_sexpr; - ao_lisp_v = c->car; + ao_lisp_stack->state = eval_progn; + ao_lisp_stack->sexprs = c; } else ao_lisp_stack->state = eval_val; } else { @@ -502,6 +501,10 @@ ao_lisp_eval_progn(void) } 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 there are more sexprs to do, then come back here, otherwise + * return the value of the last one by just landing in eval_sexpr + */ if (ao_lisp_stack->sexprs) { ao_lisp_stack->state = eval_progn; if (!ao_lisp_stack_push()) @@ -530,7 +533,6 @@ ao_lisp_eval_while(void) ao_lisp_stack->state = eval_while_test; if (!ao_lisp_stack_push()) return 0; - ao_lisp_stack->state = eval_sexpr; } return 1; } @@ -547,11 +549,11 @@ ao_lisp_eval_while_test(void) 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; + ao_lisp_stack->state = eval_progn; + ao_lisp_stack->sexprs = ao_lisp_v; } else ao_lisp_stack->state = eval_val; @@ -567,6 +569,8 @@ 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_v == AO_LISP_NIL) + ao_lisp_abort(); 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; diff --git a/src/lisp/ao_lisp_lambda.c b/src/lisp/ao_lisp_lambda.c index 186236f6..e2053a6f 100644 --- a/src/lisp/ao_lisp_lambda.c +++ b/src/lisp/ao_lisp_lambda.c @@ -78,8 +78,9 @@ ao_lisp_lambda_alloc(struct ao_lisp_cons *code, int args) if (!lambda) return AO_LISP_NIL; - if (!ao_lisp_check_argc(_ao_lisp_atom_lambda, code, 2, 2)) - return AO_LISP_NIL; + if (!code->cdr) + return ao_lisp_error(AO_LISP_INVALID, "missing parameters to lambda"); + if (!ao_lisp_check_argt(_ao_lisp_atom_lambda, code, 0, AO_LISP_CONS, 1)) return AO_LISP_NIL; f = 0; @@ -135,7 +136,7 @@ ao_lisp_lambda_eval(void) int args_wanted; int args_provided; int f; - struct ao_lisp_cons *vals + struct ao_lisp_cons *vals; DBGI("lambda "); DBG_POLY(ao_lisp_lambda_poly(lambda)); DBG("\n"); @@ -161,6 +162,10 @@ ao_lisp_lambda_eval(void) args = ao_lisp_poly_cons(ao_lisp_arg(code, 0)); vals = ao_lisp_poly_cons(cons->cdr); + next_frame->prev = lambda->frame; + ao_lisp_frame_current = next_frame; + ao_lisp_stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current); + switch (lambda->args) { case AO_LISP_FUNC_LAMBDA: for (f = 0; f < args_wanted; f++) { @@ -171,6 +176,7 @@ ao_lisp_lambda_eval(void) vals = ao_lisp_poly_cons(vals->cdr); } ao_lisp_cons_free(cons); + cons = NULL; break; case AO_LISP_FUNC_LEXPR: case AO_LISP_FUNC_NLAMBDA: @@ -182,15 +188,15 @@ ao_lisp_lambda_eval(void) args = ao_lisp_poly_cons(args->cdr); vals = ao_lisp_poly_cons(vals->cdr); } - DBGI("bind "); DBG_POLY(args->car); DBG(" = "); DBG_POLY(); DBG("\n"); + DBGI("bind "); DBG_POLY(args->car); DBG(" = "); DBG_POLY(ao_lisp_cons_poly(vals)); DBG("\n"); next_frame->vals[f].atom = args->car; next_frame->vals[f].val = ao_lisp_cons_poly(vals); break; + default: + break; } - next_frame->prev = lambda->frame; DBGI("eval frame: "); DBG_POLY(ao_lisp_frame_poly(next_frame)); DBG("\n"); - ao_lisp_frame_current = next_frame; - ao_lisp_stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current); DBG_STACK(); - return ao_lisp_arg(code, 1); + DBGI("eval code: "); DBG_POLY(code->cdr); DBG("\n"); + return code->cdr; } -- 2.30.2