X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=src%2Feval.c;fp=src%2Feval.c;h=7bbcad72b6d9c7b298b747e6dcd91d3bc6837bd3;hb=8d55156675587a770c5654362bcbd3d2a98e4aa9;hp=0000000000000000000000000000000000000000;hpb=d6e1960007fcac962144382332f7a9c8c56fa3a1;p=muddle-interpreter.git

diff --git a/src/eval.c b/src/eval.c
new file mode 100644
index 0000000..7bbcad7
--- /dev/null
+++ b/src/eval.c
@@ -0,0 +1,113 @@
+/*
+Copyright (C) 2017 Keziah Wesley
+
+You can redistribute and/or modify this file under the terms of the
+GNU Affero General Public License as published by the Free Software
+Foundation, either version 3 of the License, or (at your option) any
+later version.
+
+This file is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public
+License along with this file. If not, see
+<http://www.gnu.org/licenses/>.
+*/
+
+#include "eval.h"
+
+#include "alloc.h"
+
+// globals for now
+extern object ret;
+extern frame *cf;
+extern object *cst;
+
+void
+push_frame (void (*fn) (), tuple_object args, void (*cont) ())
+{
+  // update current frame's continuation
+  cf->cont = new_subr (cont);
+
+  // allocate new frame, make current
+  frame *prev = cf;
+  cf = (frame *) cst;
+  cst += sizeof (frame) / sizeof (object);
+
+  // set new frame's frametop
+  cf->cont = new_subr (fn);
+  cf->args = args;
+  cf->prevframe =
+    new_tuple ((object *) prev, sizeof (frame) / sizeof (object));
+}
+
+void
+pop_frame ()
+{
+  cf = (frame *) cf->prevframe.body;
+  cst = (object *) cf - sizeof (frame) / sizeof (object);
+}
+
+#define RETURN(x) do { ret = (x); pop_frame(); return; } while (0)
+#define CALL_THEN(fn, args, cont) do { push_frame(fn, args, cont); return; } while (0)
+#define TAILCALL(fn) do { cf->cont = fn; return; } while (0)
+
+/*
+    uint32_t len = 0;
+    pool_object *x = POOL_OBJECT(o->head);
+    while (x) {
+        *--cst = *x;
+        x = POOL_OBJECT(o->rest);
+        len++;
+    }
+    return mcall(evaluator, len);
+*/
+
+static void
+eval_list ()
+{
+  // store result of previous call
+  cf->locals[1] = ret;
+
+  // get next input, and advance input pointer
+  pool_ptr rest_in = as_list(&cf->args.body[0])->head;
+  if (!rest_in)
+    RETURN(cf->locals[0]);
+  POOL_OBJECT(as_list(&cf->locals[1])->head)->rest =
+    as_list(&cf->locals[1])->head + (pool_ptr)sizeof(pool_object);
+
+  // eval next element
+  CALL_THEN (eval, new_tuple ((object*)POOL_OBJECT(rest_in), 1), eval_list);
+}
+
+void
+eval ()
+{
+  assert (cf->args.len == 1);
+  switch (cf->args.body[0].type)
+    {
+    case EVALTYPE_FIX32:
+    case EVALTYPE_FIX64:
+      RETURN (cf->args.body[0]);
+    case EVALTYPE_LIST:
+      // Handle `head` now; then iterate on `.rest`.
+      if (!cf->args.body[0].list.head)
+	RETURN (cf->args.body[0]);
+      // locals: { list_object list, list_object tail }
+      cst += 2;
+      // Allocate the new list contiguously and keep track of the
+      // current tail so we can build it in forward order.
+      cf->locals[0].list =
+	new_list (POOL_PTR (pool_alloc (list_length (&cf->args.body[0].list))));
+      cf->locals[1] = cf->locals[0];
+      CALL_THEN (eval, new_tuple ((object*)POOL_OBJECT (cf->args.body[0].list.head), 1), eval_list);
+      /*
+         case EVALTYPE_FORM: TAILCALL(eval_form);
+         case EVALTYPE_VECTOR: TAILCALL(eval_vector);
+       */
+    default:
+      assert (0 && "I don't know how to eval that");
+    }
+}