git.gag.com Git - fw/altos/blob - src/lisp/ao_lisp_eval.c

   1 /*
   2  * Copyright © 2016 Keith Packard <keithp@keithp.com>
   3  *
   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.
   8  *
   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.
  13  */
  14
  15 #include "ao_lisp.h"
  16
  17 /*
  18  * Non-recursive eval
  19  *
  20  * Plan: walk actuals, construct formals
  21  *
  22  * stack >  save  > actuals > actual_1
  23  *           v         v
  24  *         formals     .    > actual_2
  25  */
  26
  27 static struct ao_lisp_cons      *stack;
  28 static struct ao_lisp_cons      *actuals;
  29 static struct ao_lisp_cons      *formals;
  30 static struct ao_lisp_cons      *formals_tail;
  31 static uint8_t been_here;
  32
  33 ao_lisp_poly
  34 ao_lisp_eval(ao_lisp_poly v)
  35 {
  36         struct ao_lisp_cons     *formal;
  37         int                     cons = 0;
  38
  39         if (!been_here) {
  40                 been_here = 1;
  41                 ao_lisp_root_add(&ao_lisp_cons_type, &stack);
  42                 ao_lisp_root_add(&ao_lisp_cons_type, &actuals);
  43                 ao_lisp_root_add(&ao_lisp_cons_type, &formals);
  44                 ao_lisp_root_add(&ao_lisp_cons_type, &formals_tail);
  45         }
  46         stack = 0;
  47         actuals = 0;
  48         formals = 0;
  49         formals_tail = 0;
  50         for (;;) {
  51
  52                 /* Build stack frames for each list */
  53                 while (ao_lisp_poly_type(v) == AO_LISP_CONS) {
  54                         if (v == AO_LISP_NIL)
  55                                 break;
  56
  57                         /* Push existing frame on the stack */
  58                         if (cons++) {
  59                                 struct ao_lisp_cons *frame;
  60
  61                                 frame = ao_lisp_cons(ao_lisp_cons_poly(actuals), formals);
  62                                 stack = ao_lisp_cons(ao_lisp_cons_poly(frame), stack);
  63                         }
  64                         actuals = ao_lisp_poly_cons(v);
  65                         formals = NULL;
  66                         formals_tail = NULL;
  67                         v = actuals->car;
  68
  69                         printf("start: stack"); ao_lisp_cons_print(stack); printf("\n");
  70                         printf("start: actuals"); ao_lisp_cons_print(actuals); printf("\n");
  71                         printf("start: formals"); ao_lisp_cons_print(formals); printf("\n");
  72                 }
  73
  74                 /* Evaluate primitive types */
  75
  76                 switch (ao_lisp_poly_type(v)) {
  77                 case AO_LISP_INT:
  78                 case AO_LISP_STRING:
  79                         break;
  80                 case AO_LISP_ATOM:
  81                         v = ao_lisp_poly_atom(v)->val;
  82                         break;
  83                 }
  84
  85                 for (;;) {
  86                         printf("add formal: "); ao_lisp_poly_print(v); printf("\n");
  87
  88                         formal = ao_lisp_cons(v, NULL);
  89                         if (formals_tail)
  90                                 formals_tail->cdr = formal;
  91                         else
  92                                 formals = formal;
  93                         formals_tail = formal;
  94                         actuals = actuals->cdr;
  95
  96                         printf("formals: ");
  97                         ao_lisp_cons_print(formals);
  98                         printf("\n");
  99                         printf("actuals: ");
 100                         ao_lisp_cons_print(actuals);
 101                         printf("\n");
 102
 103                         /* Process all of the arguments */
 104                         if (actuals) {
 105                                 v = actuals->car;
 106                                 printf ("actual: "); ao_lisp_poly_print(v); printf("\n");
 107                                 break;
 108                         }
 109
 110                         v = formals->car;
 111
 112                         /* Evaluate the resulting list */
 113                         if (ao_lisp_poly_type(v) == AO_LISP_BUILTIN) {
 114                                 struct ao_lisp_builtin *b = ao_lisp_poly_builtin(v);
 115
 116                                 v = b->func(formals->cdr);
 117
 118                                 printf ("eval: ");
 119                                 ao_lisp_cons_print(formals);
 120                                 printf(" -> ");
 121                                 ao_lisp_poly_print(v);
 122                                 printf ("\n");
 123                         } else {
 124                                 printf ("invalid eval\n");
 125                         }
 126
 127                         if (--cons) {
 128                                 struct ao_lisp_cons     *frame;
 129
 130                                 /* Pop the previous frame off the stack */
 131                                 frame = ao_lisp_poly_cons(stack->car);
 132                                 actuals = ao_lisp_poly_cons(frame->car);
 133                                 formals = frame->cdr;
 134
 135                                 /* Recompute the tail of the formals list */
 136                                 for (formal = formals; formal->cdr != NULL; formal = formal->cdr);
 137                                 formals_tail = formal;
 138
 139                                 stack = stack->cdr;
 140                                 printf("stack pop: stack"); ao_lisp_cons_print(stack); printf("\n");
 141                                 printf("stack pop: actuals"); ao_lisp_cons_print(actuals); printf("\n");
 142                                 printf("stack pop: formals"); ao_lisp_cons_print(formals); printf("\n");
 143                         } else {
 144                                 printf("done func\n");
 145                                 break;
 146                         }
 147                 }
 148                 if (!cons)
 149                         break;
 150         }
 151         return v;
 152 }