Relax the restriction of capture variables of or-patterns

Previously, the identifier with the same name in two disjunctive
patterns (aka or-patterns) must be bound to the exactly same location.
For instance,
    (x, _) || (x, _) /* ok */
    (_, y) || (_, y) /* ok */
    (x, _) || (_, x) /* not ok */

In certain Standard ML implementations, it's allowed to write a pattern like
    (x, _) || (_, x)
where x is bound to different locations as long as they have the same type.

This patch removes the restriction.

Signed-off-by: Mura Li <mural@ctli.io>

3 files changed, 57 insertions, 4 deletions

diff --git a/mi/match.c b/mi/match.c
index d6275ff..ba69d90 100644
--- a/mi/match.c
+++ b/mi/match.c
@@ -82,6 +82,7 @@ typedef struct Frontier {
 	Node **cap; 		/* the captured variables of the pattern of this match clause */
 	size_t ncap;
 	Dtree *final;		/* final state, shared by all Frontiers for a specific (indxed by i) match clause */
+	int hasorpat;		/* the frontier comes from a match arm that contains or-pattern */
 
 	struct Frontier *next;
 } Frontier;
@@ -460,7 +461,9 @@ addrec(Frontier *fs, Node *pat, Node *val, Path *path)
 	case Olor:
 		next = frontierdup(fs);
 		next->next = fs->next;
+		next->hasorpat = 1;
 		fs->next = next;
+		fs->hasorpat = 1;
 		addrec(fs, pat->expr.args[1], val, path);
 		addrec(next, pat->expr.args[0], val, path);
 		break;
@@ -903,7 +906,7 @@ clearemit(Dtree *dt)
 }
 
 static int
-capeq(Node *a, Node *b)
+capcompatible(Node *a, Node *b)
 {
 	Node *pa, *pb, *va, *vb;
 
@@ -912,7 +915,7 @@ capeq(Node *a, Node *b)
 	va = a->expr.args[1];
 	vb = b->expr.args[1];
 
-	return pa->expr.did == pb->expr.did && loadeq(va, vb);
+	return pa->expr.did == pb->expr.did && tyeq(exprtype(va), exprtype(vb));
 }
 
 Dtree *
@@ -948,9 +951,18 @@ gendtree(Node *m, Node *val, Node **lbl, size_t nlbl)
 			if (last->ncap != cur->ncap)
 				fatal(pat[cur->i], "number of wildcard variables in the or-patterns are not equal (%d != %d)", last->ncap, cur->ncap);
 			for (j = 0; j < cur->ncap; j++) {
-				if (!capeq(last->cap[j], cur->cap[j]))
+				if (!capcompatible(last->cap[j], cur->cap[j]))
 					fatal(pat[cur->i], "wildcard variables have different types in the or-patterns");
 			}
+		}
+		/* If the match arm does not have or-pattern, we can insert the assignements of the captures at the beginning of the associated block.
+		 * Otherwise, the captures can bind different locations with the same identifier in thehe or-patterns, and thus the assignments must be
+		 * carried out before jumping into the block.
+		 * For this reason, in the case of having or-pattern, we store the information of captures in the dtree MATCH node and delegate the
+		 * insertion of the captures assignments to the ir generation of dtree */
+		if (cur->hasorpat) {
+			cur->final->cap = cur->cap;
+			cur->final->ncap = cur->ncap;
 		} else {
 			addcapture(pat[cur->i]->match.block, cur->cap, cur->ncap);
 		}
@@ -994,6 +1006,7 @@ void
 genmatchcode(Dtree *dt, Node ***out, size_t *nout)
 {
 	Node *jmp, *eq, *fail;
+	Node *next;
 	int emit;
 	size_t i;
 
@@ -1018,13 +1031,26 @@ genmatchcode(Dtree *dt, Node ***out, size_t *nout)
 			fail = genlbl(dt->loc);
 			emit = 1;
 		}
+		if (dt->next[i]->accept && dt->next[i]->ncap > 0) {
+			next = genlbl(dt->next[i]->loc);
+		} else {
+			next = dt->next[i]->lbl;
+		}
 
 		eq = mkexpr(dt->loc, Oeq, dt->load, dt->pat[i], NULL);
 		eq->expr.type = mktype(dt->loc, Tybool);
-		jmp = mkexpr(dt->loc, Ocjmp, eq, dt->next[i]->lbl, fail, NULL);
+		jmp = mkexpr(dt->loc, Ocjmp, eq, next, fail, NULL);
 		jmp->expr.type = mktype(dt->loc, Tyvoid);
 		lappend(out, nout, jmp);
 
+		if (dt->next[i]->accept && dt->next[i]->ncap > 0) {
+			lappend(out, nout, next);
+			lcat(out, nout, dt->next[i]->cap, dt->next[i]->ncap);
+			jmp = mkexpr(dt->loc, Ojmp, dt->next[i]->lbl, NULL);
+			jmp->expr.type = mktype(dt->loc, Tyvoid);
+			lappend(out, nout, jmp);
+		}
+
 		genmatchcode(dt->next[i], out, nout);
 		if (emit)
 			lappend(out, nout, fail);
diff --git a/mi/mi.h b/mi/mi.h
index 5e9441c..15664f5 100644
--- a/mi/mi.h
+++ b/mi/mi.h
@@ -55,6 +55,12 @@ struct Dtree {
 	size_t nnext;
 	Dtree *any;
 
+	/* This is only used in the MATCH node (accept == 1)
+	 * It generates assignments for the captured variables
+	 * before jumping into the block of a match arm .*/
+	Node **cap;
+	size_t ncap;
+
 	size_t refcnt;
 };
 
diff --git a/test/matchor.myr b/test/matchor.myr
index 9d07668..568f52c 100644
--- a/test/matchor.myr
+++ b/test/matchor.myr
@@ -49,6 +49,9 @@ const main = {
 		`E (byte[:], int)
 		`F (int, std.option(int))
 		`G (int, std.option(int))
+		`H (int, int)
+		`I (int, int)
+		`J (int, (int, (int, int)))
 	;;
 
 	match `A 123
@@ -61,5 +64,23 @@ const main = {
 	| _: std.exit(1)
 	;;
 
+	match `H (100, 200)
+	| `H (x, _) || `I (_, x):
+		std.put("#6 x={}\n", x)
+		if x != 100
+			std.exit(1)
+		;;
+	| _: std.exit(1)
+	;;
+
+	match `J (100, (200, (300, 400)))
+	| `H (x, _) || `J (_, (_, (_, x))):
+		std.put("#7 x={}\n", x)
+		if x != 400
+			std.exit(1)
+		;;
+	| _: std.exit(1)
+	;;
+
 	std.put("all good\n")
 }