log-e-sappho/src/spho/subt.c

/*
 * Subtyping
 */
#include <stdlib.h>

#include "spho/bind.h"
#include "spho/bind.h"
#include "spho/spho.h"

#include "spho/subt.h"

/* bound type */
struct bound {
	struct spho_bind		*bind;
	const struct spho_tp		*tp;
};

/* sequent */
struct sqnt {
	struct spho_ctx		*ctx;

	size_t			sz;
	size_t			filled;
	struct bound		*elms;
};

/* sequent turnstile */
struct tstl {
	struct sqnt		left;
	struct sqnt		right;
};


static struct bound *bound_tp(const struct spho_tp *);


/* read scopes and create bound type */
struct bound *
bound_tp(const struct spho_tp *tp)
{
	struct spho_scope	*sc;
	struct spho_bind	*bind, *more_bind;

	struct bound	*ret;

	SPHO_PRECOND(tp != NULL);
	SPHO_PRECOND(tp->sc != NULL);
	SPHO_PRECOND(tp->sc->bind_loc != NULL);

	sc = tp->sc;
	bind = NULL;

	if ((ret = calloc(1, sizeof(*ret))) == NULL) {
		SPHO_ERR(sc->ctx, SPHO_ERR_SYS);
		return (NULL);
	}
	ret->tp = tp;

	
	if ((ret->bind = calloc(1, sizeof(*ret->bind))) == NULL) {
		SPHO_ERR(sc->ctx, SPHO_ERR_SYS);
		goto err;
	}

	/* initialize parent and duplicate scope-local bindings */
	ret->bind->parent = NULL;
	if ((ret->bind->loc = spho_prebind_dupl(sc->bind_loc)) == NULL) {
		goto err;
	}

	/* iterate up through parent scopes and gather their local bindings */
	bind = ret->bind;
	while ((sc = sc->parent) != NULL) {
		if ((more_bind = calloc(1, sizeof(*more_bind))) == NULL) {
			SPHO_ERR(sc->ctx, SPHO_ERR_SYS);
			goto err;
		}
		more_bind->parent = NULL;
		if ((more_bind->loc = spho_prebind_dupl(sc->bind_loc))
		    == NULL) {
			goto err;
		}
		bind->parent = more_bind;
		bind = bind->parent;
	}

	return (ret);

err:
	while (ret->bind != NULL) {
		bind = ret->bind;
		ret->bind = ret->bind->parent;

		spho_prebind_free(bind->loc);
		free(bind);
	}

	return (NULL);
}

static int
sqnt_init(struct spho_ctx *ctx, size_t initsz, struct sqnt *seq)
{
	if (initsz == 0)
		initsz = 0x10; /* just feels good */

	seq->ctx = ctx;

	if ((seq->elms = calloc(initsz, sizeof(*seq->elms))) == NULL) {
		SPHO_ERR(seq->ctx, SPHO_ERR_SYS);
		goto err;
	}

	seq->sz = initsz;
	seq->filled = 0;

	return (0);
err:
	if (seq->elms != NULL)
		free(seq->elms);
	seq->elms = NULL;

	return (-1);
}

static int
sqnt_makebig(struct sqnt *seq)
{
	size_t		new_sz;
	struct bound *new_elms;

	SPHO_PRECOND(seq != NULL);
	SPHO_PRECOND(seq->sz > 0);
	SPHO_PRECOND(seq->sz <= (SIZE_MAX >> 1));
	SPHO_PRECOND(seq->elms != NULL);

	new_sz = seq->sz << 1;

	if ((new_elms = realloc(seq->elms, new_sz)) == NULL) {
		SPHO_ERR(seq->ctx, SPHO_ERR_SYS);
		return (-1);
	}

	seq->sz = new_sz;
	seq->elms = new_elms;

	return (0);
}

static int
sqnt_add_bound(struct sqnt *seq, struct bound *elm)
{
	SPHO_PRECOND(seq->filled <= seq->sz);

	if (seq->filled >= seq->sz && (sqnt_makebig(seq) == -1))
		return (-1);

	seq->elms[seq->filled++] = *elm;

	SPHO_POSTCOND(seq->filled <= seq->sz);

	return (0);
}

static int
tstl_init(struct spho_ctx *ctx, size_t lsz, size_t rsz,
    struct tstl *ts)
{
	if (sqnt_init(ctx, lsz, &ts->left) == -1)
		return (-1);
	if (sqnt_init(ctx, rsz, &ts->right) == -1)
		return (-1);

	return (0);
}

static struct tstl *
tstl_alloc(struct spho_ctx *ctx)
{
	struct tstl *ts;

	if ((ts = calloc(1, sizeof(*ts))) == NULL) {
		SPHO_ERR(ctx, SPHO_ERR_SYS);
		return (NULL);
	}
	if (tstl_init(ctx, 0, 0, ts) == -1) {
		free(ts);
		return (NULL);
	}

	return (ts);
}

static int
tstl_add_left(struct tstl *ts, struct bound *tp)
{
	return (sqnt_add_bound(&ts->left, tp));
}

static int
tstl_add_right(struct tstl *ts, struct bound *tp)
{
	return (sqnt_add_bound(&ts->right, tp));
}

static int
tstl_decide(struct tstl *ts)
{
	SPHO_RIP("implement");
}

int
spho_is_subt(struct spho_ctx *ctx, const struct spho_tp *tp_left,
    const struct spho_tp *tp_right)
{
	struct tstl ts;
	struct bound *left, *right;

	if ((left = bound_tp(tp_left)) == NULL)
		return (-1);
	if ((right = bound_tp(tp_right)) == NULL)
		return (-1);

	// TODO check well-definedness of types (e.g. no undefs)

	if ((tstl_init(ctx, 0, 0, &ts)) == -1)
		return (-1);

	if (tstl_add_left(&ts, left) == -1)
		return (-1);
	if (tstl_add_right(&ts, right) == -1)
		return (-1);

	if (tstl_decide(&ts) == -1)
		return (-1);

	return (-1);
}