zamの実装っぽい何か

main.c

#include <stdlib.h>
#include <stdbool.h>
#include <stdio.h>
#include <gc.h>
#include <stdint.h>

struct value;

struct env
{
  struct value *array;
  size_t length;
  size_t max_length;
};

typedef void(Code)(void);

#define INTEGER 0
#define EPSILON 1
#define CLOSURE 2
#define RETURN 3

struct value
{
  union {
    int integer;
    struct
    {
      Code *entry;
      struct env env;
    } clos;
  } value;
  uint_fast8_t tag;
};

struct stack
{
  struct value *base;
  struct value *curr;
  size_t size;
};

struct stack *ArgStack;
struct stack *RetStack;

#define CHUNK 16
#define MARGIN (CHUNK * 2)

#define STACK_INIT()                                     \
  ArgStack = malloc(sizeof(struct stack));               \
  ArgStack->base = malloc(sizeof(struct value) * CHUNK); \
  ArgStack->curr = ArgStack->base;                       \
  ArgStack->size = CHUNK;                                \
  RetStack = malloc(sizeof(struct stack));               \
  RetStack->base = malloc(sizeof(struct value) * CHUNK); \
  RetStack->curr = RetStack->base;                       \
  RetStack->size = CHUNK;

struct env *Env;

#define ENV_INIT()                                      \
  Env = malloc(sizeof(struct env));                     \
  Env->array = GC_MALLOC(sizeof(struct value) * CHUNK); \
  Env->length = 0;                                      \
  Env->max_length = CHUNK;

void dump_value(struct value v)
{
  if (v.tag == INTEGER)
  {
    printf("%d", v.value.integer);
  }
  else if (v.tag == CLOSURE)
  {
    printf("%p", v.value.clos.entry);
  }
  else if (v.tag == RETURN)
  {
    printf("ret");
  }
  else
  {
    printf("epsilon");
  }
}

void dump_stack(struct stack s)
{
  printf("STACK [");

  for (size_t i = 0; i < s.curr - s.base; i++)
  {
    dump_value(s.base[i]);
    printf(", ");
  }

  printf("]");
}

void dump_env(struct env env)
{
  printf("ENV (%lu): ", env.length);
  for (size_t i = 0; i < env.length; i++)
  {
    printf("%d, ", env.array[i].value.integer);
  }
  printf("\n");
}

void push(struct stack *s, struct value value)
{
  // メモリが足りなくなったら+CHUNK
  if (s->curr - s->base >= s->size)
  {
    s->size += CHUNK;
    ptrdiff_t diff = s->curr - s->base;
    s->base = realloc(s->base, s->size * sizeof(struct value));
    s->curr = s->base + diff;
  }

  *s->curr = value;
  s->curr++;
}

struct value pop(struct stack *s)
{
  s->curr--;
  // メモリがMARGIN余ったら-CHUNK
  if (s->size > MARGIN && s->curr - s->base < s->size - MARGIN - 1)
  {
    s->size -= CHUNK;
    ptrdiff_t diff = s->curr - s->base;
    s->base = realloc(s->base, s->size * sizeof(struct value));
    s->curr = s->base + diff;
  }

  return *s->curr;
}

void push_env(struct env *env, struct value value)
{
  if (env->length >= env->max_length)
  {
    env->max_length += CHUNK;
    env->array = GC_REALLOC(env->array, sizeof(struct value) * env->max_length);
  }
  env->array[env->length] = value;
  env->length++;
}

void ldi(int val)
{
  struct value value = {
      .value = {.integer = val},
      .tag = INTEGER,
  };
  push(ArgStack, value);
}

void access(size_t i)
{
  push(ArgStack, Env->array[Env->length - i - 1]);
}

struct env copy_env(struct env old)
{
  struct env new_env = {.array = GC_MALLOC(old.max_length * sizeof(struct value)), .length = old.length, .max_length = old.max_length};
  for (size_t i = 0; i < old.length; i++)
  {
    new_env.array[i] = old.array[i];
  }
  return new_env;
}

struct value new_closure(Code *f, struct env env)
{
  struct value c = {
      .value = {
          .clos = {
              .entry = f,
              .env = copy_env(env),
          },
      },
      .tag = CLOSURE,
  };
  return c;
}

void closure(Code *f)
{
  struct value closure = new_closure(f, *Env);
  push(ArgStack, closure);
}

void let(void)
{
  struct value v = pop(ArgStack);
  push_env(Env, v);
}

void endlet(void)
{
  Env->length--;
}

void test(Code *c1, Code *c2)
{
  if (pop(ArgStack).value.integer)
  {
    c1();
  }
  else
  {
    c2();
  }
}

void add(void)
{
  int n1 = pop(ArgStack).value.integer;
  int n2 = pop(ArgStack).value.integer;
  struct value n3 = {
      .value = {.integer = n1 + n2},
      .tag = INTEGER,
  };
  push(ArgStack, n3);
}

void eq(void)
{
  int n1 = pop(ArgStack).value.integer;
  int n2 = pop(ArgStack).value.integer;
  struct value n3 = {
      .value = {.integer = n1 == n2},
      .tag = INTEGER,
  };
  push(ArgStack, n3);
}

void apply(void)
{
  struct value closure = pop(ArgStack);
  struct value val = pop(ArgStack);

  struct value save = new_closure((Code *)0xdeadbeef, *Env);
  save.tag = RETURN;
  push(RetStack, save);

  *Env = closure.value.clos.env;

  push_env(Env, closure);
  push_env(Env, val);

  closure.value.clos.entry();
}

void tail_apply(void)
{
  struct value closure = pop(ArgStack);
  struct value val = pop(ArgStack);
  *Env = closure.value.clos.env;

  push_env(Env, closure);
  push_env(Env, val);

  closure.value.clos.entry();
}

void push_mark(void)
{
  struct value e = {.tag = EPSILON};
  push(ArgStack, e);
}

void grab(Code *cont)
{
  struct value v = pop(ArgStack);

  if (v.tag == EPSILON)
  {
    struct value ret = pop(RetStack);
    struct value v = new_closure(cont, *Env);

    *Env = ret.value.clos.env;
    push(ArgStack, v);
  }
  else
  {
    struct value closure = new_closure(cont, *Env);
    push_env(Env, closure);
    push_env(Env, v);
    cont();
  }
}

void return_clos(void)
{
  struct value x = pop(ArgStack);
  struct value y = pop(ArgStack);

  if (y.tag == EPSILON)
  {
    *Env = pop(RetStack).value.clos.env;
    push(ArgStack, x);
  }
  else
  {
    *Env = x.value.clos.env;
    push_env(Env, x);
    push_env(Env, y);
  }
}

void c1(void)
{
  access(0);
  return_clos();
}

void c2(void)
{
  access(0);
  access(2);
  add();
  ldi(-1);
  access(2);
  add();
  access(3);
  tail_apply();
}

void f_cont(void)
{
  ldi(0);
  access(2);
  eq();
  test(c1, c2);
}

void f(void)
{
  grab(f_cont);
}

void entry(void)
{
  closure(f);
  let();
  push_mark();
  ldi(0);
  ldi(10000);
  access(0);
  apply();
  endlet();
}

int main()
{
  GC_INIT();

  STACK_INIT();

  ENV_INIT();

  entry();

  dump_value(*ArgStack->curr);
  printf("\n");
}