ref: 19e261299a6f0105b5bfa919fc5401b0c6243ea2
parent: 2a75839b66139c8e402fe6e40992b0fd3c9b01c8
parent: 4519f3ff10c67f4f965433be4ec50e3552de276f
author: Ori Bernstein <ori@eigenstate.org>
date: Fri Jul 20 15:30:12 EDT 2012
Merge branch 'master' of git+ssh://mimir.eigenstate.org/git/ori/mc2 Conflicts: parse/infer.c
--- a/8/Makefile
+++ b/8/Makefile
@@ -1,3 +1,4 @@
+INSTBIN=8m
BIN=8m
OBJ=isel.o \
locs.o \
--- a/8/simp.c
+++ b/8/simp.c
@@ -519,10 +519,9 @@
size_t i;
size_t off;
- if (aggr->expr.type->type == Typtr)
- aggr = aggr->expr.args[0];
- ty = aggr->expr.type;
- ty = tybase(ty);
+ ty = tybase(exprtype(aggr));
+ if (ty->type == Typtr)
+ ty = tybase(ty->sub[0]);
assert(ty->type == Tystruct);
nl = ty->sdecls;
@@ -540,11 +539,12 @@
{Node *t, *u, *r;
Node **args;
+ Type *ty;
args = n->expr.args;
- if (n->expr.type->type == Typtr) {+ ty = tybase(exprtype(args[0]));
+ if (ty->type == Typtr) {t = args[0];
- t->expr.type = mktyptr(n->line, exprtype(n));
} else {t = addr(args[0], exprtype(n));
}
@@ -1167,6 +1167,7 @@
lappend(fn, nfn, f);
}
} else {+ dcl->decl.init = fold(dcl->decl.init);
if (dcl->decl.init && exprop(dcl->decl.init) == Olit)
lappend(&s.blobs, &s.nblobs, dcl);
/* uninitialized global vars get zero-initialized decls */
--- a/mk/c.mk
+++ b/mk/c.mk
@@ -52,20 +52,32 @@
install-bin: $(INSTBIN)
- mkdir -p $(INST_ROOT)/bin
- test -z "$(INSTBIN)" || install $(INSTBIN) $(INST_ROOT)/bin
+ @if [ ! -z "$(INSTBIN)" ]; then \
+ echo install $(INSTBIN) $(INST_ROOT)/bin; \
+ mkdir -p $(INST_ROOT)/bin; \
+ install $(INSTBIN) $(INST_ROOT)/bin; \
+ fi
install-lib: $(INSTLIB)
- mkdir -p $(INST_ROOT)/lib
- test -z "$(INSTLIB)" || install $(INSTLIB) $(INST_ROOT)/lib
+ @if [ ! -z "$(INSTLIB)" ]; then \
+ echo install $(INSTLIB) $(INST_ROOT)/lib; \
+ mkdir -p $(INST_ROOT)/lib; \
+ install $(INSTLIB) $(INST_ROOT)/lib; \
+ fi
install-hdr: $(INSTHDR)
- mkdir -p $(INST_ROOT)/$(HDRDIR)/include
- test -z "$(INSTHDR)" || install $(INSTHDR) $(INST_ROOT)/include
+ @if [ ! -z "$(INSTHDR)" ]; then \
+ echo install $(INSTHDR) $(INST_ROOT)/include; \
+ mkdir -p $(INST_ROOT)/include; \
+ install $(INSTHDR) $(INST_ROOT)/include; \
+ fi
install-pc: $(INSTPKG)
- mkdir -p $(INST_ROOT)/pkgconfig
- test -z "$(INSTPC)" || install $(INSTPC) $(INST_ROOT)/pkgconfig
+ @if [ ! -z "$(INSTPKG)" ]; then \
+ echo install $(INSTPKG) $(INST_ROOT)/lib/pkgconfig; \
+ mkdir -p $(INST_ROOT)/lib/pkgconfig; \
+ install $(INSTPKG) $(INST_ROOT)/lib/pkgconfig; \
+ fi
clean-backups:
find ./ -name .*.sw* -exec rm -f {} \;--- a/opt/fold.c
+++ b/opt/fold.c
@@ -50,6 +50,8 @@
vlong a, b;
size_t i;
+ if (!n)
+ return NULL;
assert(n->type == Nexpr);
r = NULL;
args = n->expr.args;
@@ -111,6 +113,12 @@
case Oneg:
if (islit(args[0], &a))
r = val(n->line, -a);
+ break;
+ case Ocast:
+ /* FIXME: we currentl assume that the bits of the
+ * val are close enough. */
+ r = args[0];
+ r->expr.type = exprtype(n);
break;
default:
break;
--- a/parse/infer.c
+++ b/parse/infer.c
@@ -14,10 +14,10 @@
typedef struct Inferstate Inferstate;
struct Inferstate {- /* what sort of constructs we're inside. incremented when we enter,
- * decremented when we leave, in order to allow nesting */
int inpat;
int ingeneric;
+ int sawret;
+ Type *ret;
/* bound by patterns turn into decls in the action block */
Node **binds;
@@ -100,6 +100,45 @@
return t;
}
+/* prevents types that directly contain themselves. */
+static int tyinfinite(Inferstate *st, Type *t, Type *sub)
+{+ size_t i;
+
+ assert(t != NULL);
+ if (t == sub) /* FIXME: is this actually right? */
+ return 1;
+ /* if we're on the first iteration, the subtype is the type
+ * itself. The assignment must come after the equality check
+ * for obvious reasons. */
+ if (!sub)
+ sub = t;
+
+ switch (sub->type) {+ case Tystruct:
+ for (i = 0; i < sub->nmemb; i++)
+ if (tyinfinite(st, t, decltype(sub->sdecls[i])))
+ return 1;
+ break;
+ case Tyunion:
+ for (i = 0; i < t->nmemb; i++) {+ if (sub->udecls[i]->etype && tyinfinite(st, t, sub->udecls[i]->etype))
+ return 1;
+ }
+ break;
+
+ case Typtr:
+ case Tyslice:
+ return 0;
+ default:
+ for (i = 0; i < sub->nsub; i++)
+ if (tyinfinite(st, t, sub->sub[i]))
+ return 1;
+ break;
+ }
+ return 0;
+}
+
static void tyresolve(Inferstate *st, Type *t)
{size_t i;
@@ -132,6 +171,8 @@
bsunion(t->cstrs, base->cstrs);
else
t->cstrs = bsdup(base->cstrs);
+ if (tyinfinite(st, t, NULL))
+ fatal(t->line, "Type %s includes itself", tystr(t));
}
/* fixd the most accurate type mapping we have */
@@ -144,7 +185,7 @@
while (1) { if (!tytab[t->tid] && t->type == Tyname) {if (!(lu = gettype(curstab(), t->name)))
- fatal(t->name->line, "Could not fixd type %s", namestr(t->name));
+ fatal(t->name->line, "Could not fixed type %s", namestr(t->name));
tytab[t->tid] = lu;
}
@@ -213,24 +254,45 @@
return tf(st, t);
}
-static char *ctxstr(Node *n)
+static char *ctxstr(Inferstate *st, Node *n)
{char *s;
+ char *t;
+ char *u;
+ char buf[512];
+
switch (n->type) {- default: s = nodestr(n->type); break;
- case Ndecl: s = declname(n); break;
- case Nname: s = namestr(n); break;
+ default:
+ s = nodestr(n->type);
+ break;
+ case Ndecl:
+ u = declname(n);
+ t = tystr(tf(st, decltype(n)));
+ snprintf(buf, 512, "%s:%s", u, t);
+ s = strdup(buf);
+ free(t);
+ break;
+ case Nname:
+ s = namestr(n);
+ break;
case Nexpr:
if (exprop(n) == Ovar)
- s = namestr(n->expr.args[0]);
+ u = namestr(n->expr.args[0]);
else
- s = opstr(exprop(n));
+ u = opstr(exprop(n));
+ if (exprtype(n))
+ t = tystr(tf(st, exprtype(n)));
+ else
+ t = strdup("unknown");+ snprintf(buf, 512, "%s:%s", u, t);
+ s = strdup(buf);
+ free(t);
break;
}
return s;
}
-static void constrain(Node *ctx, Type *a, Cstr *c)
+static void constrain(Inferstate *st, Node *ctx, Type *a, Cstr *c)
{ if (a->type == Tyvar) {if (!a->cstrs)
@@ -237,7 +299,7 @@
a->cstrs = mkbs();
setcstr(a, c);
} else if (!bshas(a->cstrs, c->cid)) {- fatal(ctx->line, "%s needs %s near %s", tystr(a), c->name, ctxstr(ctx));
+ fatal(ctx->line, "%s needs %s near %s", tystr(a), c->name, ctxstr(st, ctx));
}
}
@@ -255,7 +317,7 @@
return bsissubset(b->cstrs, a->cstrs);
}
-static void mergecstrs(Node *ctx, Type *a, Type *b)
+static void mergecstrs(Inferstate *st, Node *ctx, Type *a, Type *b)
{ if (b->type == Tyvar) {/* make sure that if a = b, both have same cstrs */
@@ -268,7 +330,7 @@
} else { if (!cstrcheck(a, b)) {dump(file, stdout);
- fatal(ctx->line, "%s missing constraints for %s near %s", tystr(b), tystr(a), ctxstr(ctx));
+ fatal(ctx->line, "%s missing constraints for %s near %s", tystr(b), tystr(a), ctxstr(st, ctx));
}
}
}
@@ -288,6 +350,8 @@
return (a->type == Tyvar && a->nsub > 0) || a->type == Tyarray || a->type == Tyslice;
}
+/* prevents types that contain themselves in the unification;
+ * eg @a U (@a -> foo) */
static int occurs(Type *a, Type *b)
{size_t i;
@@ -318,7 +382,7 @@
}
r = NULL;
- mergecstrs(ctx, a, b);
+ mergecstrs(st, ctx, a, b);
if (a->type == Tyvar) {tytab[a->tid] = b;
r = b;
@@ -325,19 +389,19 @@
}
if (a->type == Tyvar && b->type != Tyvar)
if (occurs(a, b))
- fatal(ctx->line, "Infinite type %s in %s near %s", tystr(a), tystr(b), ctxstr(ctx));
+ fatal(ctx->line, "Infinite type %s in %s near %s", tystr(a), tystr(b), ctxstr(st, ctx));
if (a->type == b->type || idxhacked(&a, &b)) { for (i = 0; i < b->nsub; i++) {/* types must have same arity */
if (i >= a->nsub)
- fatal(ctx->line, "%s has wrong subtypes for %s near %s", tystr(a), tystr(b), ctxstr(ctx));
+ fatal(ctx->line, "%s has wrong subtypes for %s near %s", tystr(a), tystr(b), ctxstr(st, ctx));
unify(st, ctx, a->sub[i], b->sub[i]);
}
r = b;
} else if (a->type != Tyvar) {- fatal(ctx->line, "%s incompatible with %s near %s", tystr(a), tystr(b), ctxstr(ctx));
+ fatal(ctx->line, "%s incompatible with %s near %s", tystr(a), tystr(b), ctxstr(st, ctx));
}
return r;
}
@@ -351,12 +415,13 @@
if (ft->type == Tyvar) {/* the first arg is the function itself, so it shouldn't be counted */
ft = mktyfunc(n->line, &n->expr.args[1], n->expr.nargs - 1, mktyvar(n->line));
+ unify(st, n, ft, type(st, n->expr.args[0]));
}
for (i = 1; i < n->expr.nargs; i++) {if (ft->sub[i]->type == Tyvalist)
break;
inferexpr(st, n->expr.args[i], NULL, NULL);
- unify(st, n, ft->sub[i], type(st, n->expr.args[i]));
+ unify(st, n->expr.args[0], ft->sub[i], type(st, n->expr.args[i]));
}
settype(st, n, ft->sub[0]);
}
@@ -484,7 +549,7 @@
case Oidx: /* @a[@b::tcint] -> @a */
t = mktyidxhack(n->line, mktyvar(n->line));
unify(st, n, type(st, args[0]), t);
- constrain(n, type(st, args[1]), cstrtab[Tcint]);
+ constrain(st, n, type(st, args[1]), cstrtab[Tcint]);
settype(st, n, tf(st, t->sub[0]));
break;
case Oslice: /* @a[@b::tcint,@b::tcint] -> @a[,] */
@@ -499,7 +564,7 @@
lappend(&st->postcheck, &st->npostcheck, n);
break;
case Osize: /* sizeof @a -> size */
- settype(st, n, mkty(n->line, Tyuint));
+ settype(st, n, tylike(mktyvar(n->line), Tyuint));
break;
case Ocall: /* (@a, @b, @c, ... -> @r)(@a,@b,@c, ... -> @r) -> @r */
unifycall(st, n);
@@ -529,7 +594,7 @@
return;
s = getdcl(curstab(), args[0]);
if (!s)
- fatal(n->line, "Undeclared var %s", ctxstr(args[0]));
+ fatal(n->line, "Undeclared var %s", ctxstr(st, args[0]));
if (s->decl.isgeneric)
t = freshen(st, s->decl.type);
@@ -546,11 +611,11 @@
case Ocons:
uc = getucon(curstab(), args[0]);
if (!uc)
- fatal(n->line, "No union constructor %s", ctxstr(args[0]));
+ fatal(n->line, "No union constructor %s", ctxstr(st, args[0]));
if (!uc->etype && n->expr.nargs > 1)
- fatal(n->line, "nullary union constructor %s passed arg ", ctxstr(args[0]));
+ fatal(n->line, "nullary union constructor %s passed arg ", ctxstr(st, args[0]));
else if (uc->etype && n->expr.nargs != 2)
- fatal(n->line, "union constructor %s needs arg ", ctxstr(args[0]));
+ fatal(n->line, "union constructor %s needs arg ", ctxstr(st, args[0]));
else if (uc->etype)
unify(st, n, uc->etype, type(st, args[1]));
settype(st, n, uc->utype);
@@ -610,7 +675,7 @@
unify(st, n, type(st, n), type(st, n->decl.init));
} else {if (n->decl.isconst && !n->decl.isextern)
- fatal(n->line, "non-extern \"%s\" has no initializer", ctxstr(n));
+ fatal(n->line, "non-extern \"%s\" has no initializer", ctxstr(st, n));
}
}
@@ -704,7 +769,7 @@
inferdecl(st, n);
unbind(st, n);
if (type(st, n)->type == Typaram && !st->ingeneric)
- fatal(n->line, "Generic type %s in non-generic near %s\n", tystr(type(st, n)), ctxstr(n));
+ fatal(n->line, "Generic type %s in non-generic near %s\n", tystr(type(st, n)), ctxstr(st, n));
if (n->decl.isgeneric)
st->ingeneric--;
break;
@@ -722,7 +787,7 @@
infernode(st, n->ifstmt.cond, NULL, sawret);
infernode(st, n->ifstmt.iftrue, ret, sawret);
infernode(st, n->ifstmt.iffalse, ret, sawret);
- constrain(n, type(st, n->ifstmt.cond), cstrtab[Tctest]);
+ constrain(st, n, type(st, n->ifstmt.cond), cstrtab[Tctest]);
break;
case Nloopstmt:
infernode(st, n->loopstmt.init, ret, sawret);
@@ -729,7 +794,7 @@
infernode(st, n->loopstmt.cond, NULL, sawret);
infernode(st, n->loopstmt.step, ret, sawret);
infernode(st, n->loopstmt.body, ret, sawret);
- constrain(n, type(st, n->loopstmt.cond), cstrtab[Tctest]);
+ constrain(st, n, type(st, n->loopstmt.cond), cstrtab[Tctest]);
break;
case Nmatchstmt:
infernode(st, n->matchstmt.val, NULL, sawret);
@@ -770,6 +835,7 @@
static void checkcast(Inferstate *st, Node *n)
{+ /* FIXME: actually verify the casts */
}
/* returns the final type for t, after all unifications
@@ -791,7 +857,8 @@
return tyint;
if (hascstr(t, cstrtab[Tcfloat]) && cstrcheck(t, tyflt))
return tyint;
- } else {+ } else if (!t->fixed) {+ t->fixed = 1;
if (t->type == Tyarray) {typesub(st, t->asize);
} else if (t->type == Tystruct) {@@ -807,7 +874,7 @@
t->sub[i] = tyfix(st, ctx, t->sub[i]);
}
if (t->type == Tyvar) {- fatal(t->line, "underconstrained type %s near %s", tyfmt(buf, 1024, t), ctxstr(ctx));
+ fatal(t->line, "underconstrained type %s near %s", tyfmt(buf, 1024, t), ctxstr(st, ctx));
}
return t;
@@ -833,18 +900,17 @@
memb = st->postcheck[i]->expr.args[1];
found = 0;
- t = tf(st, type(st, aggr));
+ t = tybase(tf(st, type(st, aggr)));
if (t->type == Tyslice || t->type == Tyarray) { if (!strcmp(namestr(memb), "len")) {- constrain(n, type(st, n), cstrtab[Tcnum]);
- constrain(n, type(st, n), cstrtab[Tcint]);
- constrain(n, type(st, n), cstrtab[Tctest]);
+ constrain(st, n, type(st, n), cstrtab[Tcnum]);
+ constrain(st, n, type(st, n), cstrtab[Tcint]);
+ constrain(st, n, type(st, n), cstrtab[Tctest]);
found = 1;
}
} else {- t = tybase(t);
if (t->type == Typtr)
- t = tf(st, t->sub[0]);
+ t = tybase(tf(st, t->sub[0]));
nl = t->sdecls;
for (j = 0; j < t->nmemb; j++) { if (!strcmp(namestr(memb), declname(nl[j]))) {@@ -856,7 +922,7 @@
}
if (!found)
fatal(aggr->line, "Type %s has no member \"%s\" near %s",
- tystr(type(st, aggr)), ctxstr(memb), ctxstr(aggr));
+ tystr(type(st, aggr)), ctxstr(st, memb), ctxstr(st, aggr));
}
}
@@ -877,7 +943,7 @@
k = htkeys(s->dcl, &n);
for (i = 0; i < n; i++) {d = getdcl(s, k[i]);
- d->decl.type = tyfix(st, d->decl.name, d->decl.type);
+ d->decl.type = tyfix(st, d, d->decl.type);
}
free(k);
}
@@ -984,10 +1050,10 @@
if (!tg)
puttype(globls, nl, tl);
else
- fatal(nl->line, "Exported type %s double-declared on line %d", namestr(nl), tg->line);
+ fatal(nl->line, "Exported type %s already declared on line %d", namestr(nl), tg->line);
} else {tg = gettype(globls, nl);
- if (tg)
+ if (tg)
updatetype(exports, nl, tf(st, tg));
else
fatal(nl->line, "Exported type %s not declared", namestr(nl));
@@ -1002,7 +1068,7 @@
/* if an export has an initializer, it shouldn't be declared in the
* body */
if (nl->decl.init && ng)
- fatal(nl->line, "Export %s double-defined on line %d", ctxstr(nl), ng->line);
+ fatal(nl->line, "Export %s double-defined on line %d", ctxstr(st, nl), ng->line);
if (!ng)
putdcl(globls, nl);
else
--- a/parse/parse.h
+++ b/parse/parse.h
@@ -92,16 +92,19 @@
Ty type;
int tid;
int line;
- int resolved; /* Have we resolved the subtypes? Idempotent, but slow to repeat. */
+
+ int resolved; /* Have we resolved the subtypes? Prevents infinite recursion. */
+ int fixed; /* Have we fixed the subtypes? Prevents infinite recursion. */
+
Bitset *cstrs; /* the type constraints matched on this type */
- Node **cstrlist; /* The names of the constraints on the type. Used to resolve/fill the bitset */
+ Node **cstrlist; /* The names of the constraints on the type. Used to fill the bitset */
size_t ncstrlist; /* The length of the constraint list above */
+
+ Type **sub; /* sub-types; shared by all composite types */
size_t nsub; /* For compound types */
size_t nmemb; /* for aggregate types (struct, union) */
- Type **sub; /* sub-types; shared by all composite types */
union {- Node *aname; /* Tyalias: alias name */
- Node *name; /* Tyname: unresolved name */
+ Node *name; /* Tyname: unresolved name. Tyalias: alias name */
Node *asize; /* array size */
char *pname; /* Typaram: name of type parameter */
Node **sdecls; /* Tystruct: decls in struct */
--- a/parse/pickle.c
+++ b/parse/pickle.c
@@ -189,6 +189,10 @@
case Tyvar:
die("Attempting to pickle %s. This will not work.\n", tystr(ty));break;
+ case Tyalias:
+ pickle(ty->name, fd);
+ wrtype(fd, ty->sub[0]);
+ break;
default:
for (i = 0; i < ty->nsub; i++)
wrtype(fd, ty->sub[i]);
@@ -233,6 +237,10 @@
ty->asize = unpickle(fd);
break;
case Tyslice:
+ ty->sub[0] = rdtype(fd);
+ break;
+ case Tyalias:
+ ty->name = unpickle(fd);
ty->sub[0] = rdtype(fd);
break;
default:
--- a/parse/type.c
+++ b/parse/type.c
@@ -320,7 +320,7 @@
p = buf;
end = p + len;
- p += snprintf(p, end - p, "struct ");
+ p += snprintf(p, end - p, "union ");
for (i = 0; i < t->nmemb; i++) {name = namestr(t->udecls[i]->name);
ty = tystr(t->udecls[i]->etype);
@@ -419,7 +419,7 @@
p += namefmt(p, end - p, t->name);
break;
case Tyalias:
- p += snprintf(p, end - p, "%s", namestr(t->aname));
+ p += snprintf(p, end - p, "%s", namestr(t->name));
break;
case Tystruct: p += fmtstruct(p, end - p, t); break;
case Tyunion: p += fmtunion(p, end - p, t); break;
--- a/test/tests
+++ b/test/tests
@@ -53,10 +53,12 @@
B arraylit-ni E 2
B structlit E 42
B tuple E 42
+B tyrec E 42
F declmismatch
F infermismatch
F flow
F occur
+F tyoccur
F union-extraarg
F union-missingarg
F match-badtypes
--- /dev/null
+++ b/test/tyoccur.myr
@@ -1,0 +1,5 @@
+type t = struct
+ memb : t
+;;
+
+var v : t
--- /dev/null
+++ b/test/tyrec.myr
@@ -1,0 +1,9 @@
+/* we just want to see if this file compiles */
+type foo = struct
+ v : foo*
+;;
+
+const main = {+ var v : foo
+ -> 42
+}
--- a/util/Makefile
+++ b/util/Makefile
@@ -1,3 +1,4 @@
+INSTBIN=muse
BIN=muse
OBJ=muse.o