src/eval.c

   1 /*
   2 Copyright (C) 2017 Keziah Wesley
   3
   4 You can redistribute and/or modify this file under the terms of the
   5 GNU Affero General Public License as published by the Free Software
   6 Foundation, either version 3 of the License, or (at your option) any
   7 later version.
   8
   9 This file 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 Affero General Public License for more details.
  13
  14 You should have received a copy of the GNU Affero General Public
  15 License along with this file. If not, see
  16 <http://www.gnu.org/licenses/>.
  17 */
  18
  19 #include "eval.h"
  20
  21 #include "alloc.h"
  22
  23 // globals for now
  24 extern object ret;
  25 extern frame *cf;
  26 extern object *cst;
  27
  28 void
  29 push_frame (void (*fn) (), tuple_object args, void (*cont) ())
  30 {
  31   // update current frame's continuation
  32   cf->cont = new_subr (cont);
  33
  34   // allocate new frame, make current
  35   frame *prev = cf;
  36   cf = (frame *) cst;
  37   cst += sizeof (frame) / sizeof (object);
  38
  39   // set new frame's frametop
  40   cf->cont = new_subr (fn);
  41   cf->args = args;
  42   cf->prevframe =
  43     new_tuple ((object *) prev, sizeof (frame) / sizeof (object));
  44 }
  45
  46 void
  47 pop_frame ()
  48 {
  49   cf = (frame *) cf->prevframe.body;
  50   cst = (object *) cf - sizeof (frame) / sizeof (object);
  51 }
  52
  53 #define RETURN(x) do { ret = (x); pop_frame(); return; } while (0)
  54 #define CALL_THEN(fn, args, cont) do { push_frame(fn, args, cont); return; } while (0)
  55 #define TAILCALL(fn) do { cf->cont = fn; return; } while (0)
  56
  57 /*
  58     uint32_t len = 0;
  59     pool_object *x = POOL_OBJECT(o->head);
  60     while (x) {
  61         *--cst = *x;
  62         x = POOL_OBJECT(o->rest);
  63         len++;
  64     }
  65     return mcall(evaluator, len);
  66 */
  67
  68 static void
  69 eval_list ()
  70 {
  71   // store result of previous call
  72   cf->locals[1] = ret;
  73
  74   // get next input, and advance input pointer
  75   pool_ptr rest_in = as_list(&cf->args.body[0])->head;
  76   if (!rest_in)
  77     RETURN(cf->locals[0]);
  78   POOL_OBJECT(as_list(&cf->locals[1])->head)->rest =
  79     as_list(&cf->locals[1])->head + (pool_ptr)sizeof(pool_object);
  80
  81   // eval next element
  82   CALL_THEN (eval, new_tuple ((object*)POOL_OBJECT(rest_in), 1), eval_list);
  83 }
  84
  85 void
  86 eval ()
  87 {
  88   assert (cf->args.len == 1);
  89   switch (cf->args.body[0].type)
  90     {
  91     case EVALTYPE_FIX32:
  92     case EVALTYPE_FIX64:
  93       RETURN (cf->args.body[0]);
  94     case EVALTYPE_LIST:
  95       // Handle `head` now; then iterate on `.rest`.
  96       if (!cf->args.body[0].list.head)
  97         RETURN (cf->args.body[0]);
  98       // locals: { list_object list, list_object tail }
  99       cst += 2;
 100       // Allocate the new list contiguously and keep track of the
 101       // current tail so we can build it in forward order.
 102       cf->locals[0].list =
 103         new_list (POOL_PTR (pool_alloc (list_length (&cf->args.body[0].list))));
 104       cf->locals[1] = cf->locals[0];
 105       CALL_THEN (eval, new_tuple ((object*)POOL_OBJECT (cf->args.body[0].list.head), 1), eval_list);
 106       /*
 107          case EVALTYPE_FORM: TAILCALL(eval_form);
 108          case EVALTYPE_VECTOR: TAILCALL(eval_vector);
 109        */
 110     default:
 111       assert (0 && "I don't know how to eval that");
 112     }
 113 }