X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_lambda.c;h=71aebed0d7b55b36435e7d0bb0b967075cae9021;hb=cf5729a0bae51172f12fc9ec4339d4e975a45fcc;hp=186236f6eb7e8f3e5373050dbac8a76b48684b61;hpb=1a00bf4ac12a6505d4b23d94e99b4b46bf679020;p=fw%2Faltos diff --git a/src/lisp/ao_lisp_lambda.c b/src/lisp/ao_lisp_lambda.c index 186236f6..71aebed0 100644 --- a/src/lisp/ao_lisp_lambda.c +++ b/src/lisp/ao_lisp_lambda.c @@ -15,7 +15,6 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. */ -#define DBG_EVAL 0 #include "ao_lisp.h" int @@ -51,7 +50,7 @@ const struct ao_lisp_type ao_lisp_lambda_type = { }; void -ao_lisp_lambda_print(ao_poly poly) +ao_lisp_lambda_write(ao_poly poly) { struct ao_lisp_lambda *lambda = ao_lisp_poly_lambda(poly); struct ao_lisp_cons *cons = ao_lisp_poly_cons(lambda->code); @@ -60,7 +59,7 @@ ao_lisp_lambda_print(ao_poly poly) printf("%s", ao_lisp_args_name(lambda->args)); while (cons) { printf(" "); - ao_lisp_poly_print(cons->car); + ao_lisp_poly_write(cons->car); cons = ao_lisp_poly_cons(cons->cdr); } printf(")"); @@ -78,8 +77,6 @@ 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 (!ao_lisp_check_argt(_ao_lisp_atom_lambda, code, 0, AO_LISP_CONS, 1)) return AO_LISP_NIL; f = 0; @@ -101,25 +98,25 @@ ao_lisp_lambda_alloc(struct ao_lisp_cons *code, int args) } ao_poly -ao_lisp_lambda(struct ao_lisp_cons *cons) +ao_lisp_do_lambda(struct ao_lisp_cons *cons) { return ao_lisp_lambda_alloc(cons, AO_LISP_FUNC_LAMBDA); } ao_poly -ao_lisp_lexpr(struct ao_lisp_cons *cons) +ao_lisp_do_lexpr(struct ao_lisp_cons *cons) { return ao_lisp_lambda_alloc(cons, AO_LISP_FUNC_LEXPR); } ao_poly -ao_lisp_nlambda(struct ao_lisp_cons *cons) +ao_lisp_do_nlambda(struct ao_lisp_cons *cons) { return ao_lisp_lambda_alloc(cons, AO_LISP_FUNC_NLAMBDA); } ao_poly -ao_lisp_macro(struct ao_lisp_cons *cons) +ao_lisp_do_macro(struct ao_lisp_cons *cons) { return ao_lisp_lambda_alloc(cons, AO_LISP_FUNC_MACRO); } @@ -135,7 +132,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,36 +158,39 @@ 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++) { DBGI("bind "); DBG_POLY(args->car); DBG(" = "); DBG_POLY(vals->car); DBG("\n"); - next_frame->vals[f].atom = args->car; - next_frame->vals[f].val = vals->car; + ao_lisp_frame_bind(next_frame, f, args->car, vals->car); args = ao_lisp_poly_cons(args->cdr); vals = ao_lisp_poly_cons(vals->cdr); } - ao_lisp_cons_free(cons); + if (!ao_lisp_stack_marked(ao_lisp_stack)) + ao_lisp_cons_free(cons); + cons = NULL; break; case AO_LISP_FUNC_LEXPR: case AO_LISP_FUNC_NLAMBDA: case AO_LISP_FUNC_MACRO: for (f = 0; f < args_wanted - 1; f++) { DBGI("bind "); DBG_POLY(args->car); DBG(" = "); DBG_POLY(vals->car); DBG("\n"); - next_frame->vals[f].atom = args->car; - next_frame->vals[f].val = vals->car; + ao_lisp_frame_bind(next_frame, f, args->car, vals->car); 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"); - next_frame->vals[f].atom = args->car; - next_frame->vals[f].val = ao_lisp_cons_poly(vals); + DBGI("bind "); DBG_POLY(args->car); DBG(" = "); DBG_POLY(ao_lisp_cons_poly(vals)); DBG("\n"); + ao_lisp_frame_bind(next_frame, f, args->car, 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; }