Implement EVAL for LISTs

[muddle-interpreter.git] / src / eval.c

diff --git a/src/eval.c b/src/eval.c
index 7bbcad72b6d9c7b298b747e6dcd91d3bc6837bd3..e563fdfd3acd91eab0048e537b7d7a1aba039b7f 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -1,5 +1,5 @@
 /*
-Copyright (C) 2017 Keziah Wesley
+Copyright (C) 2017-2018 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
@@ -47,10 +47,13 @@ void
 pop_frame ()
 {
   cf = (frame *) cf->prevframe.body;
-  cst = (object *) cf - sizeof (frame) / sizeof (object);
+  cst = cf->prevcst;
 }
 
 #define RETURN(x) do { ret = (x); pop_frame(); return; } while (0)
+// invoke before pushing args onto stack for child call
+// TODO: replace with PUSH_ARG interface?
+#define END_LOCALS() do { cf->prevcst = cst; } 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)
 
@@ -65,21 +68,69 @@ pop_frame ()
     return mcall(evaluator, len);
 */
 
+/*
+2 ways to call an applicable:
+- generically: `<foo bar>`
+- applicably: `<APPLY foo bar>`
+
+generic calls must perform wrapping
+ */
+
+// * applicable (SUBR / simple FUNCTION): eval whole form, call impl
+// * FSUBR: call impl
+// * complex FUNCTION: call impl
+
+// Upon initial entry, `cf->args.body[0]` is the FORM, and
+// `ret` is the result of evaluating the FORM's first position.
+// Typically, the first position will be an ATOM, which is
+// self-evaluating; its value is to be looked up according to the
+// first-position resolution rules:
+// * look for a GVAL
+// * look for a LVAL
 static void
-eval_list ()
+call ()
+{
+  switch (ret.type)
+    {
+      /*
+         case EVALTYPE_ATOM:
+         break;
+         case EVALTYPE_FIX32:
+         case EVALTYPE_FIX64:
+         break;
+       */
+    default:
+      assert (0 && "I don't know how to call that");
+    }
+}
+
+// locals: { list_object list, list_object tail }
+static void
+eval_rest ()
 {
   // store result of previous call
-  cf->locals[1] = ret;
+  pool_object *prev_res = as_pool (&ret);
+  list_object *tail = as_list (&cf->locals[1]);
+  *POOL_OBJECT (tail->head) = (pool_object)
+  {
+  .type = prev_res->type,.rest = tail->head + 1,.val = prev_res->val};
 
-  // 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);
+  // advance input and output
+  assert (cf->args.len == 1);
+  list_object *args = as_list (&cf->args.body[0]);
+  assert (args->head);
+  args->head = POOL_OBJECT (args->head)->rest;
+  if (!args->head)
+    {
+      POOL_OBJECT (tail->head)->rest = 0;
+      RETURN (cf->locals[0]);
+    }
+  tail->head++;
 
   // eval next element
-  CALL_THEN (eval, new_tuple ((object*)POOL_OBJECT(rest_in), 1), eval_list);
+  END_LOCALS ();
+  CALL_THEN (eval, new_tuple ((object *) POOL_OBJECT (args->head), 1),
+            eval_rest);
 }
 
 void
@@ -93,6 +144,7 @@ eval ()
       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 }
@@ -100,11 +152,27 @@ eval ()
       // 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))));
+       new_list (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);
+      END_LOCALS ();
+      CALL_THEN (eval,
+                new_tuple ((object *)
+                           POOL_OBJECT (cf->args.body[0].list.head), 1),
+                eval_rest);
+    case EVALTYPE_FORM:
+      // `<>` is a special case.
+      if (!cf->args.body[0].list.head)
+       {
+         cf->args.body[0].type = EVALTYPE_FALSE;
+         RETURN (cf->args.body[0]);
+       }
+      // Eval first position, then apply to args
+      END_LOCALS ();
+      CALL_THEN (eval,
+                new_tuple ((object *)
+                           POOL_OBJECT (cf->args.body[0].list.head), 1),
+                call);
       /*
-         case EVALTYPE_FORM: TAILCALL(eval_form);
          case EVALTYPE_VECTOR: TAILCALL(eval_vector);
        */
     default: