first evaluator draft

object.c

@@ -1,9 +1,47 @@
+#include <inttypes.h>
 #include <stdio.h>
 #include <stdlib.h>
 
-#include "inttypes.h"
 #include "wscm.h"
 
+// clang-format off
+static const char *kindnames[] = {
+  [KIND_NIL] = "nil",
+  [KIND_NUM] = "number",
+  [KIND_SYM] = "symbol",
+  [KIND_PRIM] = "primitive",
+  [KIND_CONS] = "cons",
+  [KIND_CLOS] = "closure",
+};
+// clang-format on
+
+I kind(O obj) {
+  if (obj == NIL)
+    return KIND_NIL;
+  if (IMM(obj))
+    return KIND_NUM;
+
+  switch (TYPE(obj)) {
+  case TAG_SYM:
+    return KIND_SYM;
+  case TAG_PRIM:
+    return KIND_PRIM;
+  case TAG_GC: {
+    H *h = UNBOX(obj);
+    return h->type;
+  }
+  default:
+    fprintf(stderr, "unknown pointer tag %" PRIdPTR "\n", TYPE(obj));
+    abort();
+  }
+}
+
+const char *kindname(I k) {
+  if (k >= KIND__MAX)
+    return "??";
+  return kindnames[k];
+}
+
 // cons lists
 O cons(O head, O tail) {
   I mark = rootmark();
@@ -16,24 +54,50 @@ O cons(O head, O tail) {
   h->type = OBJ_CONS;
 
   C *c = (C *)(h + 1);
-  c->head = head;
-  c->tail = tail;
+  c->car = head;
+  c->cdr = tail;
 
   rootreset(mark);
   return BOX(h);
 }
 
 C *uncons(O obj) {
-  if (obj == NIL)
-    return NULL;
-  if (IMM(obj)) {
-    fprintf(stderr, "unpair: expected pair, got integer\n");
+  I k = kind(obj);
+  if (k != KIND_CONS) {
+    fprintf(stderr, "expected cons, got %s\n", kindnames[k]);
     abort();
   }
   H *h = UNBOX(obj);
-  if (h->type != OBJ_CONS) {
-    fprintf(stderr, "unpair: expected pair, got type %" PRIdPTR "\n", h->type);
-    abort();
-  }
   return (C *)(h + 1);
 }
+
+// closures
+O mkclos(O args, O body, O env) {
+  I mark = rootmark();
+  addroot(&args);
+  addroot(&body);
+  addroot(&env);
+
+  const Z sz = sizeof(H) + sizeof(L);
+  H *h = alloc(sz);
+  h->size = sz;
+  h->type = OBJ_CLOS;
+
+  L *l = (L *)(h + 1);
+  l->args = args;
+  l->body = body;
+  l->env = env;
+
+  rootreset(mark);
+  return BOX(h);
+}
+
+L *unclos(O obj) {
+  I k = kind(obj);
+  if (k != KIND_CONS) {
+    fprintf(stderr, "expected closure, got %s\n", kindnames[k]);
+    abort();
+  }
+  H *h = UNBOX(obj);
+  return (L *)(h + 1);
+}