<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) ())
// * 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
{
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");
}
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;
+}