Implement global bindings

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

diff --git a/src/eval.c b/src/eval.c
index 7d28057ff9e0ad375acd039a657bc7a859a5ba07..5e17d7e48543cc1e3a2c6833d35b5b83b53140bf 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -16,14 +16,17 @@ License along with this file. If not, see
 <http://www.gnu.org/licenses/>.
 */
 
+#include "alloc.h"
 #include "eval.h"
+#include "oblist.h"
 
-#include "alloc.h"
+#include <string.h>
 
 // globals for now
 extern object ret;
 extern frame *cf;
 extern object *cst;
+extern vector_object globals;
 
 void
 push_frame (void (*fn) (), tuple_object args, void (*cont) ())
@@ -80,6 +83,8 @@ generic calls must perform wrapping
 // * FSUBR: call impl
 // * complex FUNCTION: call impl
 
+static object *gval (atom_object * var);
+
 // 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
@@ -92,13 +97,24 @@ call ()
 {
   switch (ret.type)
     {
-      /*
-         case EVALTYPE_ATOM:
-         break;
-         case EVALTYPE_FIX32:
-         case EVALTYPE_FIX64:
-         break;
-       */
+    case EVALTYPE_ATOM:
+      {
+       object *val = gval (&ret.atom);
+       if (!val)
+         {
+           // TODO: lvalue lookup
+           assert (0 && "attempted to call unbound symbol");
+         }
+       if (val->type == EVALTYPE_SUBR)
+         TAILCALL (val->subr);
+       assert (0 && "I don't know how to call that");
+       break;
+       /*
+          case EVALTYPE_FIX32:
+          case EVALTYPE_FIX64:
+          break;
+        */
+      }
     default:
       assert (0 && "I don't know how to call that");
     }
@@ -180,3 +196,40 @@ eval ()
       assert (0 && "I don't know how to eval that");
     }
 }
+
+inline static object *
+create_global_binding (uvector_object oblist, const char *pname)
+{
+  object *p = stack_push (&globals);
+  stack_push (&globals)->atom =
+    oblist_find_or_insert (root, pname, strlen (pname));
+  return p;
+}
+
+static void
+subr_root ()
+{
+  ret.uvector = root;
+  pop_frame ();
+}
+
+void
+init_standard_env ()
+{
+  create_global_binding (root, "ROOT")->subr = new_subr (subr_root);
+}
+
+object *
+gval (atom_object * var)
+{
+  object *gvals = HEAP_OBJECT (globals.val.body);
+  for (int i = 0; i < globals.val.len / 2; i++)
+    {
+      // TODO: need proper atom comparison once multiple OBLISTs active
+      if (as_atom (&gvals[i * 2])->val.body == var->val.body)
+       {
+         return &gvals[i * 2 + 1];
+       }
+    }
+  return 0;
+}