#include <inttypes.h>
#include <stdio.h>
#include <stdlib.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();
  addroot(&head);
  addroot(&tail);

  const Z sz = sizeof(H) + sizeof(C);
  H *h = alloc(sz);
  h->size = sz;
  h->type = OBJ_CONS;

  C *c = (C *)(h + 1);
  c->car = head;
  c->cdr = tail;

  rootreset(mark);
  return BOX(h);
}

C *uncons(O obj) {
  I k = kind(obj);
  if (k != KIND_CONS) {
    fprintf(stderr, "expected cons, got %s\n", kindnames[k]);
    abort();
  }
  H *h = UNBOX(obj);
  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);
}