X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_eval.c;h=3af567964deab8a4f87d13a26d13425e3508e901;hp=f945bc163a35cbef1925ca6aa1c124e1376af971;hb=974717eb9dad105c9897ee24f953d98d57eaec77;hpb=dba374516ed396633659dec571b6a44b03da8ad1 diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c index f945bc16..3af56796 100644 --- a/src/lisp/ao_lisp_eval.c +++ b/src/lisp/ao_lisp_eval.c @@ -16,6 +16,8 @@ #include "ao_lisp.h" #include +const struct ao_lisp_type ao_lisp_stack_type; + static int stack_size(void *addr) { @@ -34,13 +36,11 @@ stack_mark(void *addr) ao_lisp_poly_mark(stack->frame, 0); ao_lisp_poly_mark(stack->list, 0); stack = ao_lisp_poly_stack(stack->prev); - if (ao_lisp_mark_memory(stack, sizeof (struct ao_lisp_stack))) + if (ao_lisp_mark_memory(&ao_lisp_stack_type, stack)) break; } } -static const struct ao_lisp_type ao_lisp_stack_type; - static void stack_move(void *addr) { @@ -57,8 +57,7 @@ stack_move(void *addr) prev = ao_lisp_poly_stack(stack->prev); if (!prev) break; - ret = ao_lisp_move_memory((void **) &prev, - sizeof (struct ao_lisp_stack)); + ret = ao_lisp_move_memory(&ao_lisp_stack_type, (void **) &prev); if (prev != ao_lisp_poly_stack(stack->prev)) stack->prev = ao_lisp_stack_poly(prev); if (ret) @@ -67,15 +66,18 @@ stack_move(void *addr) } } -static const struct ao_lisp_type ao_lisp_stack_type = { +const struct ao_lisp_type ao_lisp_stack_type = { .size = stack_size, .mark = stack_mark, - .move = stack_move + .move = stack_move, + .name = "stack" }; struct ao_lisp_stack *ao_lisp_stack; ao_poly ao_lisp_v; +struct ao_lisp_stack *ao_lisp_stack_free_list; + ao_poly ao_lisp_set_cond(struct ao_lisp_cons *c) { @@ -97,9 +99,15 @@ ao_lisp_stack_reset(struct ao_lisp_stack *stack) static int ao_lisp_stack_push(void) { - struct ao_lisp_stack *stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack)); - if (!stack) - return 0; + struct ao_lisp_stack *stack; + if (ao_lisp_stack_free_list) { + stack = ao_lisp_stack_free_list; + ao_lisp_stack_free_list = ao_lisp_poly_stack(stack->prev); + } else { + stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack)); + if (!stack) + return 0; + } stack->prev = ao_lisp_stack_poly(ao_lisp_stack); stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current); stack->list = AO_LISP_NIL; @@ -114,9 +122,15 @@ ao_lisp_stack_push(void) static void ao_lisp_stack_pop(void) { + ao_poly prev; + if (!ao_lisp_stack) return; - ao_lisp_stack = ao_lisp_poly_stack(ao_lisp_stack->prev); + prev = ao_lisp_stack->prev; + ao_lisp_stack->prev = ao_lisp_stack_poly(ao_lisp_stack_free_list); + ao_lisp_stack_free_list = ao_lisp_stack; + + ao_lisp_stack = ao_lisp_poly_stack(prev); if (ao_lisp_stack) ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame); else @@ -141,7 +155,7 @@ func_type(ao_poly func) return ao_lisp_error(AO_LISP_INVALID, "func is nil"); switch (ao_lisp_poly_type(func)) { case AO_LISP_BUILTIN: - return ao_lisp_poly_builtin(func)->args; + return ao_lisp_poly_builtin(func)->args & AO_LISP_FUNC_MASK; case AO_LISP_LAMBDA: return ao_lisp_poly_lambda(func)->args; default: @@ -284,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; @@ -294,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"); @@ -359,12 +372,15 @@ static int ao_lisp_eval_exec(void) { ao_poly v; + struct ao_lisp_builtin *builtin; + DBGI("exec: "); DBG_POLY(ao_lisp_v); DBG(" values "); DBG_POLY(ao_lisp_stack->values); DBG ("\n"); ao_lisp_stack->sexprs = AO_LISP_NIL; switch (ao_lisp_poly_type(ao_lisp_v)) { case AO_LISP_BUILTIN: ao_lisp_stack->state = eval_val; - v = ao_lisp_func(ao_lisp_poly_builtin(ao_lisp_v)) ( + builtin = ao_lisp_poly_builtin(ao_lisp_v); + v = ao_lisp_func(builtin) ( ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->values)->cdr)); DBG_DO(if (!ao_lisp_exception && ao_lisp_poly_builtin(ao_lisp_v)->func == builtin_set) { struct ao_lisp_cons *cons = ao_lisp_poly_cons(ao_lisp_stack->values); @@ -372,6 +388,10 @@ ao_lisp_eval_exec(void) ao_poly val = ao_lisp_arg(cons, 2); DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n"); }); + builtin = ao_lisp_poly_builtin(ao_lisp_v); + if (builtin->args & AO_LISP_FUNC_FREE_ARGS) + ao_lisp_cons_free(ao_lisp_poly_cons(ao_lisp_stack->values)); + ao_lisp_v = v; DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG ("\n"); DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n"); @@ -534,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, @@ -544,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, }; /* @@ -567,14 +607,7 @@ ao_lisp_eval_restart(void) ao_poly ao_lisp_eval(ao_poly _v) { - static uint8_t been_here; - ao_lisp_v = _v; - if (!been_here) { - been_here = 1; - ao_lisp_root_add(&ao_lisp_stack_type, &ao_lisp_stack); - ao_lisp_root_poly_add(&ao_lisp_v); - } if (!ao_lisp_stack_push()) return AO_LISP_NIL;