+#if MULTI_INST
+List findInstsFor(pi,o) /* Find matching instance for pred */
+Cell pi; /* (pi,o), or otherwise NIL. If a */
+Int o; { /* match is found, then tyvars from*/
+ Class c = getHead(pi); /* typeOff have been initialized to*/
+ List ins; /* allow direct use of specifics. */
+ List res = NIL;
+
+ if (!isClass(c))
+ return NIL;
+
+ for (ins=cclass(c).instances; nonNull(ins); ins=tl(ins)) {
+ Inst in = hd(ins);
+ Int beta = newKindedVars(inst(in).kinds);
+ if (matchPred(pi,o,inst(in).head,beta)) {
+ res = cons (pair (beta, in), res);
+ continue;
+ }
+ else
+ numTyvars = beta;
+ }
+ if (res == NIL) {
+ unrestrictBind();
+ }
+
+ return rev(res);
+}
+#endif
+
+/* --------------------------------------------------------------------------
+ * Improvement:
+ * ------------------------------------------------------------------------*/
+
+Void improve(line,sps,ps) /* Improve a list of predicates */
+Int line;
+List sps;
+List ps; {
+ Bool improved;
+ List ps1;
+ do {
+ improved = FALSE;
+ for (ps1=ps; nonNull(ps1); ps1=tl(ps1)) {
+ Cell pi = fst3(hd(ps1));
+ Int o = intOf(snd3(hd(ps1)));
+ Cell c = getHead(pi);
+ if ((isClass(c) && nonNull(cclass(c).xfds)) || isIP(c)) {
+ improved |= improveAgainst(line,sps,pi,o);
+ if (!isIP(c))
+ improved |= instImprove(line,c,pi,o);
+ improved |= improveAgainst(line,tl(ps1),pi,o);
+ }
+ }
+ } while (improved);
+}
+
+Void improve1(line,sps,pi,o) /* Improve a single predicate */
+Int line;
+List sps;
+Cell pi;
+Int o; {
+ Bool improved;
+ Cell c = getHead(pi);
+ do {
+ improved = FALSE;
+ if ((isClass(c) && nonNull(cclass(c).xfds)) || isIP(c)) {
+ improved |= improveAgainst(line,sps,pi,o);
+ if (!isIP(c))
+ improved |= instImprove(line,c,pi,o);
+ }
+ } while (improved);
+}
+
+Bool improveAgainst(line,ps,pi,o)
+Int line;
+List ps;
+Cell pi;
+Int o; {
+ Bool improved = FALSE;
+ Cell h = getHead(pi);
+ for (; nonNull(ps); ps=tl(ps)) {
+ Cell pr = hd(ps);
+ Cell pi1 = fst3(pr);
+ Int o1 = intOf(snd3(pr));
+ Cell h1 = getHead(pi1);
+ /* it would be nice to optimize for the common case
+ where h == h1 */
+ if (isClass(h) && isClass(h1)) {
+ improved |= pairImprove(line,h,pi,o,pi1,o1,numTyvars);
+ if (h != h1)
+ improved |= pairImprove(line,h1,pi1,o1,pi,o,numTyvars);
+ }
+#if IPARAM
+ else if (isIP(h1) && textOf(h1) == textOf(h))
+ improved |= ipImprove(line,pi,o,pi1,o1);
+#endif
+ }
+ return improved;
+}
+/* should emulate findInsts behavior of shorting out if the
+ predicate would match a more general signature... */
+
+Bool instImprove(line,c,pi,o)
+Int line;
+Class c;
+Cell pi;
+Int o; {
+ Bool improved = FALSE;
+ List ins = cclass(c).instances;
+ for (; nonNull(ins); ins=tl(ins)) {
+ Cell in = hd(ins);
+ Int alpha = newKindedVars(inst(in).kinds);
+ improved |= pairImprove(line,c,pi,o,inst(in).head,alpha,alpha);
+ }
+ return improved;
+}
+
+#if IPARAM
+Bool ipImprove(line,pi,o,pi1,o1)
+Int line;
+Cell pi;
+Int o;
+Cell pi1;
+Int o1; {
+ Type t = arg(pi);
+ Type t1 = arg(pi1);
+ if (!sameType(t,o,t1,o1)) {
+ if (!unify(t,o,t1,o1)) {
+ ERRMSG(line) "Mismatching uses of implicit parameter\n"
+ ETHEN
+ ERRTEXT "\n*** "
+ ETHEN ERRPRED(copyPred(pi1,o1));
+ ERRTEXT "\n*** "
+ ETHEN ERRPRED(copyPred(pi,o));
+ ERRTEXT "\n"
+ EEND;
+ }
+ return TRUE;
+ }
+ return FALSE;
+}
+#endif
+
+Bool pairImprove(line,c,pi1,o1,pi2,o2,above) /* Look for improvement of (pi1,o1)*/
+Int line; /* against (pi2,o2) */
+Class c;
+Cell pi1;
+Int o1;
+Cell pi2;
+Int o2;
+Int above; {
+ Bool improved = FALSE;
+ List xfds = cclass(c).xfds;
+ for (; nonNull(xfds); xfds=tl(xfds)) {
+ Cell xfd = hd(xfds);
+ Cell hs = fst(xfd);
+ Int alpha;
+ for (; nonNull(hs); hs=tl(hs)) {
+ Cell h = hd(hs);
+ Class d = getHead(h);
+ alpha = newKindedVars(cclass(d).kinds);
+ if (matchPred(pi2,o2,h,alpha))
+ break;
+ numTyvars = alpha;
+ }
+ if (nonNull(hs)) {
+ List fds = snd(xfd);
+ for (; nonNull(fds); fds=tl(fds)) {
+ List as = fst(hd(fds));
+ Bool same = TRUE;
+ for (; same && nonNull(as); as=tl(as)) {
+ Int n = offsetOf(hd(as));
+ same &= matchTypeAbove(nthArg(n,pi1),o1,
+ mkOffset(n),alpha,above);
+ }
+ if (isNull(as) && same) {
+ for (as=snd(hd(fds)); same && nonNull(as); as=tl(as)) {
+ Int n = offsetOf(hd(as));
+ Type t1 = nthArg(n,pi1);
+ Type t2 = mkOffset(n);
+ if (!matchTypeAbove(t1,o1,t2,alpha,above)) {
+ same &= unify(t1,o1,t2,alpha);
+ improved = TRUE;
+ }
+ }
+ if (!same) {
+ ERRMSG(line)
+ "Constraints are not consistent with functional dependency"
+ ETHEN
+ ERRTEXT "\n*** Constraint : "
+ ETHEN ERRPRED(copyPred(pi1,o1));
+ ERRTEXT "\n*** And constraint : "
+ ETHEN ERRPRED(copyPred(pi2,o2));
+ ERRTEXT "\n*** For class : "
+ ETHEN ERRPRED(cclass(c).head);
+ ERRTEXT "\n*** Break dependency : "
+ ETHEN ERRFD(hd(fds));
+ ERRTEXT "\n"
+ EEND;
+ }
+ }
+ }
+ numTyvars = alpha;
+ }
+ }
+ return improved;
+}
+