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 stack = ao_lisp_poly_stack(stack->prev);
36 if (ao_lisp_mark_memory(stack, sizeof (struct ao_lisp_stack)))
41 static const struct ao_lisp_type ao_lisp_stack_type;
44 stack_move(void *addr)
46 struct ao_lisp_stack *stack = addr;
51 (void) ao_lisp_poly_move(&stack->sexprs, 0);
52 (void) ao_lisp_poly_move(&stack->values, 0);
53 (void) ao_lisp_poly_move(&stack->values_tail, 0);
54 (void) ao_lisp_poly_move(&stack->frame, 0);
55 prev = ao_lisp_poly_stack(stack->prev);
56 ret = ao_lisp_move(&ao_lisp_stack_type, &prev);
57 if (prev != ao_lisp_poly_stack(stack->prev))
58 stack->prev = ao_lisp_stack_poly(prev);
61 stack = ao_lisp_poly_stack(stack->prev);
65 static const struct ao_lisp_type ao_lisp_stack_type = {
71 struct ao_lisp_stack *ao_lisp_stack;
75 ao_lisp_set_cond(struct ao_lisp_cons *c)
77 ao_lisp_stack->state = eval_cond;
78 ao_lisp_stack->sexprs = ao_lisp_cons_poly(c);
83 ao_lisp_stack_reset(struct ao_lisp_stack *stack)
85 stack->state = eval_sexpr;
86 stack->sexprs = AO_LISP_NIL;
87 stack->values = AO_LISP_NIL;
88 stack->values_tail = AO_LISP_NIL;
93 ao_lisp_stack_push(void)
95 struct ao_lisp_stack *stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
98 stack->prev = ao_lisp_stack_poly(ao_lisp_stack);
99 stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
100 stack->list = AO_LISP_NIL;
101 ao_lisp_stack = stack;
102 ao_lisp_stack_reset(stack);
103 DBGI("stack push\n");
110 ao_lisp_stack_pop(void)
114 ao_lisp_stack = ao_lisp_poly_stack(ao_lisp_stack->prev);
116 ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);
118 ao_lisp_frame_current = NULL;
125 ao_lisp_stack_clear(void)
127 ao_lisp_stack = NULL;
128 ao_lisp_frame_current = NULL;
129 ao_lisp_v = AO_LISP_NIL;
133 func_type(ao_poly func)
135 if (func == AO_LISP_NIL)
136 return ao_lisp_error(AO_LISP_INVALID, "func is nil");
137 switch (ao_lisp_poly_type(func)) {
138 case AO_LISP_BUILTIN:
139 return ao_lisp_poly_builtin(func)->args;
141 return ao_lisp_poly_lambda(func)->args;
143 ao_lisp_error(AO_LISP_INVALID, "not a func");
149 * Flattened eval to avoid stack issues
153 * Evaluate an s-expression
155 * For a list, evaluate all of the elements and
156 * then execute the resulting function call.
158 * Each element of the list is evaluated in
159 * a clean stack context.
161 * The current stack state is set to 'formal' so that
162 * when the evaluation is complete, the value
163 * will get appended to the values list.
165 * For other types, compute the value directly.
169 ao_lisp_eval_sexpr(void)
171 DBGI("sexpr: "); DBG_POLY(ao_lisp_v); DBG("\n");
172 switch (ao_lisp_poly_type(ao_lisp_v)) {
174 if (ao_lisp_v == AO_LISP_NIL) {
175 if (!ao_lisp_stack->values) {
177 * empty list evaluates to empty list
179 ao_lisp_v = AO_LISP_NIL;
180 ao_lisp_stack->state = eval_val;
183 * done with arguments, go execute it
185 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->values)->car;
186 ao_lisp_stack->state = eval_exec;
189 if (!ao_lisp_stack->values)
190 ao_lisp_stack->list = ao_lisp_v;
192 * Evaluate another argument and then switch
193 * to 'formal' to add the value to the values
196 ao_lisp_stack->sexprs = ao_lisp_v;
197 ao_lisp_stack->state = eval_formal;
198 if (!ao_lisp_stack_push())
201 * push will reset the state to 'sexpr', which
202 * will evaluate the expression
204 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
208 DBGI("..frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
209 ao_lisp_v = ao_lisp_atom_get(ao_lisp_v);
213 case AO_LISP_BUILTIN:
215 ao_lisp_stack->state = eval_val;
218 DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG("\n");
223 * A value has been computed.
225 * If the value was computed from a macro,
226 * then we want to reset the current context
227 * to evaluate the macro result again.
229 * If not a macro, then pop the stack.
230 * If the stack is empty, we're done.
231 * Otherwise, the stack will contain
236 ao_lisp_eval_val(void)
238 DBGI("val: "); DBG_POLY(ao_lisp_v); DBG("\n");
240 if (ao_lisp_stack->macro) {
241 DBGI(".. end macro %d\n", ao_lisp_stack->macro);
242 DBGI(".. sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
243 DBGI(".. values "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
244 ao_lisp_frames_dump();
249 * Re-use the current stack to evaluate
250 * the value from the macro
252 ao_lisp_stack->state = eval_sexpr;
253 ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->macro_frame);
254 ao_lisp_stack->frame = ao_lisp_stack->macro_frame;
255 ao_lisp_stack->macro = 0;
256 ao_lisp_stack->macro_frame = AO_LISP_NIL;
257 ao_lisp_stack->sexprs = AO_LISP_NIL;
258 ao_lisp_stack->values = AO_LISP_NIL;
259 ao_lisp_stack->values_tail = AO_LISP_NIL;
265 * Value computed, pop the stack
266 * to figure out what to do with the value
270 DBGI("..state %d\n", ao_lisp_stack ? ao_lisp_stack->state : -1);
275 * A formal has been computed.
277 * If this is the first formal, then check to see if we've got a
278 * lamda/lexpr or macro/nlambda.
280 * For lambda/lexpr, go compute another formal. This will terminate
281 * when the sexpr state sees nil.
283 * For macro/nlambda, we're done, so move the sexprs into the values
286 * Macros have an additional step of saving a stack frame holding the
287 * macro value execution context, which then gets the result of the
292 ao_lisp_eval_formal(void)
295 struct ao_lisp_stack *prev;
297 DBGI("formal: "); DBG_POLY(ao_lisp_v); DBG("\n");
299 /* Check what kind of function we've got */
300 if (!ao_lisp_stack->values) {
301 switch (func_type(ao_lisp_v)) {
302 case AO_LISP_FUNC_LAMBDA:
303 case AO_LISP_FUNC_LEXPR:
304 DBGI(".. lambda or lexpr\n");
306 case AO_LISP_FUNC_MACRO:
307 /* Evaluate the result once more */
308 prev = ao_lisp_stack;
309 ao_lisp_stack->state = eval_sexpr;
310 if (!ao_lisp_stack_push())
313 /* After the function returns, take that
314 * value and re-evaluate it
316 ao_lisp_stack->state = eval_sexpr;
317 ao_lisp_stack->sexprs = prev->sexprs;
318 prev->sexprs = AO_LISP_NIL;
320 DBGI(".. start macro\n");
321 DBGI(".. sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
322 DBGI(".. values "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
325 /* fall through ... */
326 case AO_LISP_FUNC_NLAMBDA:
327 DBGI(".. nlambda or macro\n");
329 /* use the raw sexprs as values */
330 ao_lisp_stack->values = ao_lisp_stack->sexprs;
331 ao_lisp_stack->values_tail = AO_LISP_NIL;
332 ao_lisp_stack->state = eval_exec;
334 /* ready to execute now */
341 /* Append formal to list of values */
342 formal = ao_lisp_cons_poly(ao_lisp_cons_cons(ao_lisp_v, NULL));
346 if (ao_lisp_stack->values_tail)
347 ao_lisp_poly_cons(ao_lisp_stack->values_tail)->cdr = formal;
349 ao_lisp_stack->values = formal;
350 ao_lisp_stack->values_tail = formal;
352 DBGI(".. values "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
355 * Step to the next argument, if this is last, then
356 * 'sexpr' will end up switching to 'exec'
358 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
360 ao_lisp_stack->state = eval_sexpr;
362 DBGI(".. "); DBG_POLY(ao_lisp_v); DBG("\n");
367 * Start executing a function call
369 * Most builtins are easy, just call the function.
370 * 'cond' is magic; it sticks the list of clauses
371 * in 'sexprs' and switches to 'cond' state. That
372 * bit of magic is done in ao_lisp_set_cond.
374 * Lambdas build a new frame to hold the locals and
375 * then re-use the current stack context to evaluate
376 * the s-expression from the lambda.
380 ao_lisp_eval_exec(void)
383 DBGI("exec: "); DBG_POLY(ao_lisp_v); DBG(" values "); DBG_POLY(ao_lisp_stack->values); DBG ("\n");
384 ao_lisp_stack->sexprs = AO_LISP_NIL;
385 switch (ao_lisp_poly_type(ao_lisp_v)) {
386 case AO_LISP_BUILTIN:
387 ao_lisp_stack->state = eval_val;
388 v = ao_lisp_func(ao_lisp_poly_builtin(ao_lisp_v)) (
389 ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->values)->cdr));
390 DBG_DO(if (!ao_lisp_exception && ao_lisp_poly_builtin(ao_lisp_v)->func == builtin_set) {
391 struct ao_lisp_cons *cons = ao_lisp_poly_cons(ao_lisp_stack->values);
392 ao_poly atom = ao_lisp_arg(cons, 1);
393 ao_poly val = ao_lisp_arg(cons, 2);
394 DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n");
397 DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG ("\n");
398 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
401 ao_lisp_stack->state = eval_sexpr;
402 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
403 ao_lisp_v = ao_lisp_lambda_eval(ao_lisp_poly_lambda(ao_lisp_v),
404 ao_lisp_poly_cons(ao_lisp_stack->values));
405 DBGI(".. sexpr "); DBG_POLY(ao_lisp_v); DBG("\n");
406 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
409 ao_lisp_stack->values = AO_LISP_NIL;
410 ao_lisp_stack->values_tail = AO_LISP_NIL;
415 * Start evaluating the next cond clause
417 * If the list of clauses is empty, then
418 * the result of the cond is nil.
420 * Otherwise, set the current stack state to 'cond_test' and create a
421 * new stack context to evaluate the test s-expression. Once that's
422 * complete, we'll land in 'cond_test' to finish the clause.
425 ao_lisp_eval_cond(void)
427 DBGI("cond: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
428 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
429 DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
430 if (!ao_lisp_stack->sexprs) {
431 ao_lisp_v = AO_LISP_NIL;
432 ao_lisp_stack->state = eval_val;
434 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car;
435 if (!ao_lisp_v || ao_lisp_poly_type(ao_lisp_v) != AO_LISP_CONS) {
436 ao_lisp_error(AO_LISP_INVALID, "invalid cond clause");
439 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
440 ao_lisp_stack->state = eval_cond_test;
441 if (!ao_lisp_stack_push())
443 ao_lisp_stack->state = eval_sexpr;
449 * Finish a cond clause.
451 * Check the value from the test expression, if
452 * non-nil, then set up to evaluate the value expression.
454 * Otherwise, step to the next clause and go back to the 'cond'
458 ao_lisp_eval_cond_test(void)
460 DBGI("cond_test: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
461 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
462 DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
464 struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car);
465 struct ao_lisp_cons *c = ao_lisp_poly_cons(car->cdr);
467 ao_lisp_stack->state = eval_val;
470 if (!ao_lisp_stack_push())
474 ao_lisp_stack->sexprs = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
475 DBGI("next cond: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
476 ao_lisp_stack->state = eval_cond;
482 * Evaluate a list of sexprs, returning the value from the last one.
484 * ao_lisp_progn records the list in stack->sexprs, so we just need to
485 * walk that list. Set ao_lisp_v to the car of the list and jump to
486 * eval_sexpr. When that's done, it will land in eval_val. For all but
487 * the last, leave a stack frame with eval_progn set so that we come
488 * back here. For the last, don't add a stack frame so that we can
492 ao_lisp_eval_progn(void)
494 DBGI("progn: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
495 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
496 DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
498 if (!ao_lisp_stack->sexprs) {
499 ao_lisp_v = AO_LISP_NIL;
500 ao_lisp_stack->state = eval_val;
502 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car;
503 ao_lisp_stack->sexprs = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
504 if (ao_lisp_stack->sexprs) {
505 ao_lisp_stack->state = eval_progn;
506 if (!ao_lisp_stack_push())
509 ao_lisp_stack->state = eval_sexpr;
515 * Conditionally execute a list of sexprs while the first is true
518 ao_lisp_eval_while(void)
520 DBGI("while: "); 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");
524 if (!ao_lisp_stack->sexprs) {
525 ao_lisp_v = AO_LISP_NIL;
526 ao_lisp_stack->state = eval_val;
528 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car;
529 ao_lisp_stack->state = eval_while_test;
530 if (!ao_lisp_stack_push())
532 ao_lisp_stack->state = eval_sexpr;
538 * Check the while condition, terminate the loop if nil. Otherwise keep going
541 ao_lisp_eval_while_test(void)
543 DBGI("while_test: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
544 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
545 DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
548 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
550 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
551 ao_lisp_stack->state = eval_while;
552 if (!ao_lisp_stack_push())
556 ao_lisp_stack->state = eval_val;
560 static int (*const evals[])(void) = {
561 [eval_sexpr] = ao_lisp_eval_sexpr,
562 [eval_val] = ao_lisp_eval_val,
563 [eval_formal] = ao_lisp_eval_formal,
564 [eval_exec] = ao_lisp_eval_exec,
565 [eval_cond] = ao_lisp_eval_cond,
566 [eval_cond_test] = ao_lisp_eval_cond_test,
567 [eval_progn] = ao_lisp_eval_progn,
568 [eval_while] = ao_lisp_eval_while,
569 [eval_while_test] = ao_lisp_eval_while_test,
573 ao_lisp_eval(ao_poly _v)
575 static uint8_t been_here;
580 ao_lisp_root_add(&ao_lisp_stack_type, &ao_lisp_stack);
581 ao_lisp_root_poly_add(&ao_lisp_v);
584 if (!ao_lisp_stack_push())
587 while (ao_lisp_stack) {
588 if (!(*evals[ao_lisp_stack->state])() || ao_lisp_exception) {
589 ao_lisp_stack_clear();
593 DBG_DO(if (ao_lisp_frame_current) {DBGI("frame left as "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");});
594 ao_lisp_frame_current = NULL;