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->macro_frame, 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;
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->macro_frame, 0);
57 prev = ao_lisp_poly_stack(stack->prev);
58 ret = ao_lisp_move(&ao_lisp_stack_type, &prev);
59 if (prev != ao_lisp_poly_stack(stack->prev))
60 stack->prev = ao_lisp_stack_poly(prev);
63 stack = ao_lisp_poly_stack(stack->prev);
67 static const struct ao_lisp_type ao_lisp_stack_type = {
73 struct ao_lisp_stack *ao_lisp_stack;
77 ao_lisp_set_cond(struct ao_lisp_cons *c)
79 ao_lisp_stack->state = eval_cond;
80 ao_lisp_stack->sexprs = ao_lisp_cons_poly(c);
85 ao_lisp_stack_reset(struct ao_lisp_stack *stack)
87 stack->state = eval_sexpr;
89 stack->sexprs = AO_LISP_NIL;
90 stack->values = AO_LISP_NIL;
91 stack->values_tail = AO_LISP_NIL;
95 ao_lisp_frames_dump(void)
97 struct ao_lisp_stack *s;
98 DBGI(".. current frame: "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
99 for (s = ao_lisp_stack; s; s = ao_lisp_poly_stack(s->prev)) {
100 DBGI(".. stack frame: "); DBG_POLY(s->frame); DBG("\n");
101 DBGI(".. macro frame: "); DBG_POLY(s->frame); DBG("\n");
106 ao_lisp_stack_push(void)
108 DBGI("stack push\n");
110 struct ao_lisp_stack *stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
113 stack->prev = ao_lisp_stack_poly(ao_lisp_stack);
114 stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
115 stack->list = AO_LISP_NIL;
116 ao_lisp_stack = stack;
117 ao_lisp_stack_reset(stack);
118 ao_lisp_frames_dump();
123 ao_lisp_stack_pop(void)
127 ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);
128 ao_lisp_stack = ao_lisp_poly_stack(ao_lisp_stack->prev);
131 ao_lisp_frames_dump();
135 ao_lisp_stack_clear(void)
137 ao_lisp_stack = NULL;
138 ao_lisp_frame_current = NULL;
139 ao_lisp_v = AO_LISP_NIL;
143 func_type(ao_poly func)
145 if (func == AO_LISP_NIL)
146 return ao_lisp_error(AO_LISP_INVALID, "func is nil");
147 switch (ao_lisp_poly_type(func)) {
148 case AO_LISP_BUILTIN:
149 return ao_lisp_poly_builtin(func)->args;
151 return ao_lisp_poly_lambda(func)->args;
153 ao_lisp_error(AO_LISP_INVALID, "not a func");
159 * Flattened eval to avoid stack issues
163 * Evaluate an s-expression
165 * For a list, evaluate all of the elements and
166 * then execute the resulting function call.
168 * Each element of the list is evaluated in
169 * a clean stack context.
171 * The current stack state is set to 'formal' so that
172 * when the evaluation is complete, the value
173 * will get appended to the values list.
175 * For other types, compute the value directly.
179 ao_lisp_eval_sexpr(void)
181 DBGI("sexpr: "); DBG_POLY(ao_lisp_v); DBG("\n");
182 switch (ao_lisp_poly_type(ao_lisp_v)) {
184 if (ao_lisp_v == AO_LISP_NIL) {
185 if (!ao_lisp_stack->values) {
187 * empty list evaluates to empty list
189 ao_lisp_v = AO_LISP_NIL;
190 ao_lisp_stack->state = eval_val;
193 * done with arguments, go execute it
195 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->values)->car;
196 ao_lisp_stack->state = eval_exec;
199 if (!ao_lisp_stack->values)
200 ao_lisp_stack->list = ao_lisp_v;
202 * Evaluate another argument and then switch
203 * to 'formal' to add the value to the values
206 ao_lisp_stack->sexprs = ao_lisp_v;
207 ao_lisp_stack->state = eval_formal;
208 if (!ao_lisp_stack_push())
211 * push will reset the state to 'sexpr', which
212 * will evaluate the expression
214 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
218 DBGI("..frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
219 ao_lisp_v = ao_lisp_atom_get(ao_lisp_v);
223 case AO_LISP_BUILTIN:
225 ao_lisp_stack->state = eval_val;
228 DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG("\n");
233 * A value has been computed.
235 * If the value was computed from a macro,
236 * then we want to reset the current context
237 * to evaluate the macro result again.
239 * If not a macro, then pop the stack.
240 * If the stack is empty, we're done.
241 * Otherwise, the stack will contain
246 ao_lisp_eval_val(void)
248 DBGI("val: "); DBG_POLY(ao_lisp_v); DBG("\n");
249 if (ao_lisp_stack->macro) {
250 DBGI("..macro %d\n", ao_lisp_stack->macro);
251 DBGI("..current frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
252 DBGI("..saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
253 DBGI("..macro frame "); DBG_POLY(ao_lisp_stack->macro_frame); DBG("\n");
254 DBGI("..sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
255 DBGI("..values "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
257 * Re-use the current stack to evaluate
258 * the value from the macro
260 ao_lisp_stack->state = eval_sexpr;
261 // assert(ao_lisp_stack->frame == ao_lisp_stack->macro_frame);
262 ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->macro_frame);
263 ao_lisp_stack->frame = ao_lisp_stack->macro_frame;
264 ao_lisp_stack->macro = 0;
265 ao_lisp_stack->macro_frame = AO_LISP_NIL;
266 ao_lisp_stack->sexprs = AO_LISP_NIL;
267 ao_lisp_stack->values = AO_LISP_NIL;
268 ao_lisp_stack->values_tail = AO_LISP_NIL;
271 * Value computed, pop the stack
272 * to figure out what to do with the value
276 DBGI("..state %d\n", ao_lisp_stack ? ao_lisp_stack->state : -1);
281 * A formal has been computed.
283 * If this is the first formal, then
284 * check to see if we've got a lamda/lexpr or
287 * For lambda/lexpr, go compute another formal.
288 * This will terminate when the sexpr state
291 * For macro/nlambda, we're done, so move the
292 * sexprs into the values and go execute it.
296 ao_lisp_eval_formal(void)
300 DBGI("formal: "); DBG_POLY(ao_lisp_v); DBG("\n");
302 /* Check what kind of function we've got */
303 if (!ao_lisp_stack->values) {
304 switch (func_type(ao_lisp_v)) {
305 case AO_LISP_FUNC_LAMBDA:
306 case AO_LISP_FUNC_LEXPR:
307 DBGI(".. lambda or lexpr\n");
309 case AO_LISP_FUNC_MACRO:
310 ao_lisp_stack->macro = 1;
311 DBGI(".. macro %d\n", ao_lisp_stack->macro);
312 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
313 DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
314 ao_lisp_stack->macro_frame = ao_lisp_stack->frame;
315 /* fall through ... */
316 case AO_LISP_FUNC_NLAMBDA:
317 DBGI(".. nlambda or macro\n");
318 ao_lisp_stack->values = ao_lisp_stack->sexprs;
319 ao_lisp_stack->values_tail = AO_LISP_NIL;
320 ao_lisp_stack->state = eval_exec;
327 /* Append formal to list of values */
328 formal = ao_lisp_cons_poly(ao_lisp_cons_cons(ao_lisp_v, NULL));
332 if (ao_lisp_stack->values_tail)
333 ao_lisp_poly_cons(ao_lisp_stack->values_tail)->cdr = formal;
335 ao_lisp_stack->values = formal;
336 ao_lisp_stack->values_tail = formal;
338 DBGI(".. values "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
341 * Step to the next argument, if this is last, then
342 * 'sexpr' will end up switching to 'exec'
344 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
346 ao_lisp_stack->state = eval_sexpr;
348 DBGI(".. "); DBG_POLY(ao_lisp_v); DBG("\n");
353 * Start executing a function call
355 * Most builtins are easy, just call the function.
356 * 'cond' is magic; it sticks the list of clauses
357 * in 'sexprs' and switches to 'cond' state. That
358 * bit of magic is done in ao_lisp_set_cond.
360 * Lambdas build a new frame to hold the locals and
361 * then re-use the current stack context to evaluate
362 * the s-expression from the lambda.
366 ao_lisp_eval_exec(void)
369 DBGI("exec: "); DBG_POLY(ao_lisp_v); DBG(" values "); DBG_POLY(ao_lisp_stack->values); DBG ("\n");
370 ao_lisp_stack->sexprs = AO_LISP_NIL;
371 switch (ao_lisp_poly_type(ao_lisp_v)) {
372 case AO_LISP_BUILTIN:
373 ao_lisp_stack->state = eval_val;
374 v = ao_lisp_func(ao_lisp_poly_builtin(ao_lisp_v)) (
375 ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->values)->cdr));
376 DBG_DO(if (!ao_lisp_exception && ao_lisp_poly_builtin(ao_lisp_v)->func == builtin_set) {
377 struct ao_lisp_cons *cons = ao_lisp_poly_cons(ao_lisp_stack->values);
378 ao_poly atom = ao_lisp_arg(cons, 1);
379 ao_poly val = ao_lisp_arg(cons, 2);
380 DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n");
383 DBGI(".. result "); 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->state = eval_sexpr;
388 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
389 ao_lisp_v = ao_lisp_lambda_eval(ao_lisp_poly_lambda(ao_lisp_v),
390 ao_lisp_poly_cons(ao_lisp_stack->values));
391 DBGI(".. sexpr "); DBG_POLY(ao_lisp_v); DBG("\n");
392 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
395 ao_lisp_stack->values = AO_LISP_NIL;
396 ao_lisp_stack->values_tail = AO_LISP_NIL;
401 ao_lisp_eval_lambda_done(void)
403 DBGI("lambda_done: "); DBG_POLY(ao_lisp_v); DBG("\n");
409 * Start evaluating the next cond clause
411 * If the list of clauses is empty, then
412 * the result of the cond is nil.
414 * Otherwise, set the current stack state to 'cond_test' and create a
415 * new stack context to evaluate the test s-expression. Once that's
416 * complete, we'll land in 'cond_test' to finish the clause.
419 ao_lisp_eval_cond(void)
421 DBGI("cond: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
422 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
423 DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
424 if (!ao_lisp_stack->sexprs) {
425 ao_lisp_v = AO_LISP_NIL;
426 ao_lisp_stack->state = eval_val;
428 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car;
429 if (!ao_lisp_v || ao_lisp_poly_type(ao_lisp_v) != AO_LISP_CONS) {
430 ao_lisp_error(AO_LISP_INVALID, "invalid cond clause");
433 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
434 ao_lisp_stack->state = eval_cond_test;
435 if (!ao_lisp_stack_push())
437 ao_lisp_stack->state = eval_sexpr;
443 * Finish a cond clause.
445 * Check the value from the test expression, if
446 * non-nil, then set up to evaluate the value expression.
448 * Otherwise, step to the next clause and go back to the 'cond'
452 ao_lisp_eval_cond_test(void)
454 DBGI("cond_test: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
455 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
456 DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
458 struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car);
459 struct ao_lisp_cons *c = ao_lisp_poly_cons(car->cdr);
461 ao_lisp_stack->state = eval_val;
464 if (!ao_lisp_stack_push())
468 ao_lisp_stack->sexprs = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
469 DBGI("next cond: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
470 ao_lisp_stack->state = eval_cond;
475 static int (*const evals[])(void) = {
476 [eval_sexpr] = ao_lisp_eval_sexpr,
477 [eval_val] = ao_lisp_eval_val,
478 [eval_formal] = ao_lisp_eval_formal,
479 [eval_exec] = ao_lisp_eval_exec,
480 [eval_cond] = ao_lisp_eval_cond,
481 [eval_cond_test] = ao_lisp_eval_cond_test,
485 ao_lisp_eval(ao_poly _v)
487 static uint8_t been_here;
492 ao_lisp_root_add(&ao_lisp_stack_type, &ao_lisp_stack);
493 ao_lisp_root_poly_add(&ao_lisp_v);
496 if (!ao_lisp_stack_push())
499 while (ao_lisp_stack) {
501 if (!(*evals[ao_lisp_stack->state])() || ao_lisp_exception) {
502 ao_lisp_stack_clear();
506 DBG_DO(if (ao_lisp_frame_current) {DBGI("frame left as "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");});
507 ao_lisp_frame_current = NULL;