2 * Copyright © 2016 Keith Packard <keithp@keithp.com>
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation, either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * General Public License for more details.
20 stack_size(void *addr)
23 return sizeof (struct ao_lisp_stack);
27 stack_mark(void *addr)
29 struct ao_lisp_stack *stack = addr;
31 ao_lisp_poly_mark(stack->sexprs, 0);
32 ao_lisp_poly_mark(stack->values, 0);
33 /* no need to mark values_tail */
34 ao_lisp_poly_mark(stack->frame, 0);
35 ao_lisp_poly_mark(stack->list, 0);
36 stack = ao_lisp_poly_stack(stack->prev);
37 if (ao_lisp_mark_memory(stack, sizeof (struct ao_lisp_stack)))
42 static const struct ao_lisp_type ao_lisp_stack_type;
45 stack_move(void *addr)
47 struct ao_lisp_stack *stack = addr;
50 struct ao_lisp_stack *prev;
52 (void) ao_lisp_poly_move(&stack->sexprs, 0);
53 (void) ao_lisp_poly_move(&stack->values, 0);
54 (void) ao_lisp_poly_move(&stack->values_tail, 0);
55 (void) ao_lisp_poly_move(&stack->frame, 0);
56 (void) ao_lisp_poly_move(&stack->list, 0);
57 prev = ao_lisp_poly_stack(stack->prev);
60 ret = ao_lisp_move_memory((void **) &prev,
61 sizeof (struct ao_lisp_stack));
62 if (prev != ao_lisp_poly_stack(stack->prev))
63 stack->prev = ao_lisp_stack_poly(prev);
70 static const struct ao_lisp_type ao_lisp_stack_type = {
76 struct ao_lisp_stack *ao_lisp_stack;
80 ao_lisp_set_cond(struct ao_lisp_cons *c)
82 ao_lisp_stack->state = eval_cond;
83 ao_lisp_stack->sexprs = ao_lisp_cons_poly(c);
88 ao_lisp_stack_reset(struct ao_lisp_stack *stack)
90 stack->state = eval_sexpr;
91 stack->sexprs = AO_LISP_NIL;
92 stack->values = AO_LISP_NIL;
93 stack->values_tail = AO_LISP_NIL;
98 ao_lisp_stack_push(void)
100 struct ao_lisp_stack *stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
103 stack->prev = ao_lisp_stack_poly(ao_lisp_stack);
104 stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
105 stack->list = AO_LISP_NIL;
106 ao_lisp_stack = stack;
107 ao_lisp_stack_reset(stack);
108 DBGI("stack push\n");
115 ao_lisp_stack_pop(void)
119 ao_lisp_stack = ao_lisp_poly_stack(ao_lisp_stack->prev);
121 ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);
123 ao_lisp_frame_current = NULL;
130 ao_lisp_stack_clear(void)
132 ao_lisp_stack = NULL;
133 ao_lisp_frame_current = NULL;
134 ao_lisp_v = AO_LISP_NIL;
138 func_type(ao_poly func)
140 if (func == AO_LISP_NIL)
141 return ao_lisp_error(AO_LISP_INVALID, "func is nil");
142 switch (ao_lisp_poly_type(func)) {
143 case AO_LISP_BUILTIN:
144 return ao_lisp_poly_builtin(func)->args;
146 return ao_lisp_poly_lambda(func)->args;
148 ao_lisp_error(AO_LISP_INVALID, "not a func");
154 * Flattened eval to avoid stack issues
158 * Evaluate an s-expression
160 * For a list, evaluate all of the elements and
161 * then execute the resulting function call.
163 * Each element of the list is evaluated in
164 * a clean stack context.
166 * The current stack state is set to 'formal' so that
167 * when the evaluation is complete, the value
168 * will get appended to the values list.
170 * For other types, compute the value directly.
174 ao_lisp_eval_sexpr(void)
176 DBGI("sexpr: "); DBG_POLY(ao_lisp_v); DBG("\n");
177 switch (ao_lisp_poly_type(ao_lisp_v)) {
179 if (ao_lisp_v == AO_LISP_NIL) {
180 if (!ao_lisp_stack->values) {
182 * empty list evaluates to empty list
184 ao_lisp_v = AO_LISP_NIL;
185 ao_lisp_stack->state = eval_val;
188 * done with arguments, go execute it
190 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->values)->car;
191 ao_lisp_stack->state = eval_exec;
194 if (!ao_lisp_stack->values)
195 ao_lisp_stack->list = ao_lisp_v;
197 * Evaluate another argument and then switch
198 * to 'formal' to add the value to the values
201 ao_lisp_stack->sexprs = ao_lisp_v;
202 ao_lisp_stack->state = eval_formal;
203 if (!ao_lisp_stack_push())
206 * push will reset the state to 'sexpr', which
207 * will evaluate the expression
209 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
213 DBGI("..frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
214 ao_lisp_v = ao_lisp_atom_get(ao_lisp_v);
218 case AO_LISP_BUILTIN:
220 ao_lisp_stack->state = eval_val;
223 DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG("\n");
228 * A value has been computed.
230 * If the value was computed from a macro,
231 * then we want to reset the current context
232 * to evaluate the macro result again.
234 * If not a macro, then pop the stack.
235 * If the stack is empty, we're done.
236 * Otherwise, the stack will contain
241 ao_lisp_eval_val(void)
243 DBGI("val: "); DBG_POLY(ao_lisp_v); DBG("\n");
245 * Value computed, pop the stack
246 * to figure out what to do with the value
249 DBGI("..state %d\n", ao_lisp_stack ? ao_lisp_stack->state : -1);
254 * A formal has been computed.
256 * If this is the first formal, then check to see if we've got a
257 * lamda/lexpr or macro/nlambda.
259 * For lambda/lexpr, go compute another formal. This will terminate
260 * when the sexpr state sees nil.
262 * For macro/nlambda, we're done, so move the sexprs into the values
265 * Macros have an additional step of saving a stack frame holding the
266 * macro value execution context, which then gets the result of the
271 ao_lisp_eval_formal(void)
274 struct ao_lisp_stack *prev;
276 DBGI("formal: "); DBG_POLY(ao_lisp_v); DBG("\n");
278 /* Check what kind of function we've got */
279 if (!ao_lisp_stack->values) {
280 switch (func_type(ao_lisp_v)) {
281 case AO_LISP_FUNC_LAMBDA:
282 case AO_LISP_FUNC_LEXPR:
283 DBGI(".. lambda or lexpr\n");
285 case AO_LISP_FUNC_MACRO:
286 /* Evaluate the result once more */
287 ao_lisp_stack->state = eval_sexpr;
288 if (!ao_lisp_stack_push())
291 /* After the function returns, take that
292 * value and re-evaluate it
294 prev = ao_lisp_poly_stack(ao_lisp_stack->prev);
295 ao_lisp_stack->state = eval_sexpr;
296 ao_lisp_stack->sexprs = prev->sexprs;
297 prev->sexprs = AO_LISP_NIL;
299 DBGI(".. start macro\n");
300 DBGI(".. sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
301 DBGI(".. values "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
304 /* fall through ... */
305 case AO_LISP_FUNC_NLAMBDA:
306 DBGI(".. nlambda or macro\n");
308 /* use the raw sexprs as values */
309 ao_lisp_stack->values = ao_lisp_stack->sexprs;
310 ao_lisp_stack->values_tail = AO_LISP_NIL;
311 ao_lisp_stack->state = eval_exec;
313 /* ready to execute now */
320 /* Append formal to list of values */
321 formal = ao_lisp_cons_poly(ao_lisp_cons_cons(ao_lisp_v, NULL));
325 if (ao_lisp_stack->values_tail)
326 ao_lisp_poly_cons(ao_lisp_stack->values_tail)->cdr = formal;
328 ao_lisp_stack->values = formal;
329 ao_lisp_stack->values_tail = formal;
331 DBGI(".. values "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
334 * Step to the next argument, if this is last, then
335 * 'sexpr' will end up switching to 'exec'
337 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
339 ao_lisp_stack->state = eval_sexpr;
341 DBGI(".. "); DBG_POLY(ao_lisp_v); DBG("\n");
346 * Start executing a function call
348 * Most builtins are easy, just call the function.
349 * 'cond' is magic; it sticks the list of clauses
350 * in 'sexprs' and switches to 'cond' state. That
351 * bit of magic is done in ao_lisp_set_cond.
353 * Lambdas build a new frame to hold the locals and
354 * then re-use the current stack context to evaluate
355 * the s-expression from the lambda.
359 ao_lisp_eval_exec(void)
362 DBGI("exec: "); DBG_POLY(ao_lisp_v); DBG(" values "); DBG_POLY(ao_lisp_stack->values); DBG ("\n");
363 ao_lisp_stack->sexprs = AO_LISP_NIL;
364 switch (ao_lisp_poly_type(ao_lisp_v)) {
365 case AO_LISP_BUILTIN:
366 ao_lisp_stack->state = eval_val;
367 v = ao_lisp_func(ao_lisp_poly_builtin(ao_lisp_v)) (
368 ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->values)->cdr));
369 DBG_DO(if (!ao_lisp_exception && ao_lisp_poly_builtin(ao_lisp_v)->func == builtin_set) {
370 struct ao_lisp_cons *cons = ao_lisp_poly_cons(ao_lisp_stack->values);
371 ao_poly atom = ao_lisp_arg(cons, 1);
372 ao_poly val = ao_lisp_arg(cons, 2);
373 DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n");
376 DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG ("\n");
377 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
380 ao_lisp_stack->state = eval_sexpr;
381 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
382 ao_lisp_v = ao_lisp_lambda_eval();
383 DBGI(".. sexpr "); DBG_POLY(ao_lisp_v); DBG("\n");
384 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
387 ao_lisp_stack->values = AO_LISP_NIL;
388 ao_lisp_stack->values_tail = AO_LISP_NIL;
393 * Start evaluating the next cond clause
395 * If the list of clauses is empty, then
396 * the result of the cond is nil.
398 * Otherwise, set the current stack state to 'cond_test' and create a
399 * new stack context to evaluate the test s-expression. Once that's
400 * complete, we'll land in 'cond_test' to finish the clause.
403 ao_lisp_eval_cond(void)
405 DBGI("cond: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
406 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
407 DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
408 if (!ao_lisp_stack->sexprs) {
409 ao_lisp_v = AO_LISP_NIL;
410 ao_lisp_stack->state = eval_val;
412 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car;
413 if (!ao_lisp_v || ao_lisp_poly_type(ao_lisp_v) != AO_LISP_CONS) {
414 ao_lisp_error(AO_LISP_INVALID, "invalid cond clause");
417 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
418 ao_lisp_stack->state = eval_cond_test;
419 if (!ao_lisp_stack_push())
421 ao_lisp_stack->state = eval_sexpr;
427 * Finish a cond clause.
429 * Check the value from the test expression, if
430 * non-nil, then set up to evaluate the value expression.
432 * Otherwise, step to the next clause and go back to the 'cond'
436 ao_lisp_eval_cond_test(void)
438 DBGI("cond_test: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
439 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
440 DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
442 struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car);
443 struct ao_lisp_cons *c = ao_lisp_poly_cons(car->cdr);
446 ao_lisp_stack->state = eval_sexpr;
449 ao_lisp_stack->state = eval_val;
451 ao_lisp_stack->sexprs = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
452 DBGI("next cond: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
453 ao_lisp_stack->state = eval_cond;
459 * Evaluate a list of sexprs, returning the value from the last one.
461 * ao_lisp_progn records the list in stack->sexprs, so we just need to
462 * walk that list. Set ao_lisp_v to the car of the list and jump to
463 * eval_sexpr. When that's done, it will land in eval_val. For all but
464 * the last, leave a stack frame with eval_progn set so that we come
465 * back here. For the last, don't add a stack frame so that we can
469 ao_lisp_eval_progn(void)
471 DBGI("progn: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
472 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
473 DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
475 if (!ao_lisp_stack->sexprs) {
476 ao_lisp_v = AO_LISP_NIL;
477 ao_lisp_stack->state = eval_val;
479 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car;
480 ao_lisp_stack->sexprs = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
481 if (ao_lisp_stack->sexprs) {
482 ao_lisp_stack->state = eval_progn;
483 if (!ao_lisp_stack_push())
486 ao_lisp_stack->state = eval_sexpr;
492 * Conditionally execute a list of sexprs while the first is true
495 ao_lisp_eval_while(void)
497 DBGI("while: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
498 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
499 DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
501 if (!ao_lisp_stack->sexprs) {
502 ao_lisp_v = AO_LISP_NIL;
503 ao_lisp_stack->state = eval_val;
505 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car;
506 ao_lisp_stack->state = eval_while_test;
507 if (!ao_lisp_stack_push())
509 ao_lisp_stack->state = eval_sexpr;
515 * Check the while condition, terminate the loop if nil. Otherwise keep going
518 ao_lisp_eval_while_test(void)
520 DBGI("while_test: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
521 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
522 DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
525 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
527 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
528 ao_lisp_stack->state = eval_while;
529 if (!ao_lisp_stack_push())
533 ao_lisp_stack->state = eval_val;
537 static int (*const evals[])(void) = {
538 [eval_sexpr] = ao_lisp_eval_sexpr,
539 [eval_val] = ao_lisp_eval_val,
540 [eval_formal] = ao_lisp_eval_formal,
541 [eval_exec] = ao_lisp_eval_exec,
542 [eval_cond] = ao_lisp_eval_cond,
543 [eval_cond_test] = ao_lisp_eval_cond_test,
544 [eval_progn] = ao_lisp_eval_progn,
545 [eval_while] = ao_lisp_eval_while,
546 [eval_while_test] = ao_lisp_eval_while_test,
550 * Called at restore time to reset all execution state
554 ao_lisp_eval_clear_globals(void)
556 ao_lisp_stack = NULL;
557 ao_lisp_frame_current = NULL;
558 ao_lisp_v = AO_LISP_NIL;
562 ao_lisp_eval_restart(void)
564 return ao_lisp_stack_push();
568 ao_lisp_eval(ao_poly _v)
570 static uint8_t been_here;
575 ao_lisp_root_add(&ao_lisp_stack_type, &ao_lisp_stack);
576 ao_lisp_root_poly_add(&ao_lisp_v);
579 if (!ao_lisp_stack_push())
582 while (ao_lisp_stack) {
583 if (!(*evals[ao_lisp_stack->state])() || ao_lisp_exception) {
584 ao_lisp_stack_clear();
588 DBG_DO(if (ao_lisp_frame_current) {DBGI("frame left as "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");});
589 ao_lisp_frame_current = NULL;