type fixes and bindings + notes on subtyping

src/spho/subt.c

@@ -0,0 +1,239 @@
+/*
+ * 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);
+}
+