TPoss
tpossIntersect(TPoss S, TPoss T)
{
TFormList LS, LT, l = 0;
if (S == NULL || T == NULL)
return NULL;
/* If T is free of duplicates, then the result will also be. */
for (LT = T->possl; LT; LT = cdr(LT)) {
car(LT) = tfFollowOnly(car(LT));
for (LS = S->possl; LS; LS = cdr(LS)) {
car(LS) = tfFollowOnly(car(LS));
if (tfSatisfies(car(LS), car(LT))) {
l = listCons(TForm)(car(LT), l);
break;
}
if (tfSatisfies(car(LT), car(LS))) {
if (!listMember(TForm)(l, car(LS), tfEqual))
l = listCons(TForm)(car(LS), l);
}
}
}
l = listNReverse(TForm)(l);
return tpossFrTheList(l);
}
TForm
symeType(Syme syme)
{
Syme ext;
TForm tf;
/* Use the type of the extension if present. */
ext = symeExtensionFirst(syme);
if (ext) return symeType(ext);
/* Trigger symes from other libraries. */
symeTrigger(syme);
/* Fill types on lazy symbol meanings. */
if (symeIsLazy(syme))
return symeFillType(syme);
/* Follow forward types if present. */
tf = syme->type;
/* BDS: tfIsForward(tf) dereferences tf. Consequently, it will seg
fault if tf is null. If everything works properly, we should
never reach this point without tf pointing to something valid. */
assert(tf != NULL);
if (tfIsForward(tf))
tf = symeSetType(syme, tfFollowOnly(tf));
return tf;
}
local void
tpossCons(TPoss tp, TForm t)
{
assert(tp);
t = tfFollowOnly(t);
tp->possl = listCons(TForm)(t, tp->possl);
tp->possc += 1;
}
TPoss
tpossAdd1(TPoss tp, TForm t)
{
t = tfFollowOnly(t);
if (! tpossHas(tp, t))
tpossCons(tp, t);
return tp;
}
TPoss
tpossSatisfiesType(TPoss S, TForm T)
{
TFormList LS, l = 0;
if (S == NULL)
return NULL;
T = tfFollowOnly(T);
if (tfIsUnknown(T) || tpossIsPending(S, T))
return tpossRefer(S);
for (LS = S->possl; LS; LS = cdr(LS))
if (tfSatisfies(car(LS), T))
l = listCons(TForm)(car(LS), l);
l = listNReverse(TForm)(l);
return tpossFrTheList(l);
}
TPoss
tpossIntersect(TPoss tp1, TPoss tp2)
{
TFormList l = 0;
TFormList l1;
if (tp1 == NULL || tp2 == NULL)
return NULL;
l1 = tp1->possl;
for (; l1; l1 = cdr(l1)) {
car(l1) = tfFollowOnly(car(l1));
if (tpossHas(tp2, car(l1)))
l = listCons(TForm)(car(l1), l);
}
l = listNReverse(TForm)(l);
return tpossFrTheList(l);
}
TPoss
tpossSatisfies(TPoss S, TPoss T)
{
TFormList LS, LT, l = 0;
if (S == NULL || T == NULL)
return NULL;
/* If T is free of duplicates, then the result will also be. */
for (LT = T->possl; LT; LT = cdr(LT)) {
car(LT) = tfFollowOnly(car(LT));
for (LS = S->possl; LS; LS = cdr(LS)) {
TForm s = car(LS), t = car(LT);
if (tfSatBit(tfSatBupMask(), s, t))
l = listCons(TForm)(tpossJoin(s, t), l);
}
}
l = listNReverse(TForm)(l);
return tpossFrTheList(l);
}
/*
* tl is one element of the cross product get(v,k)...get(v,n-1)
*/
local void
tposs0Multi(TPoss tp,Length k,TFormList tl,Length n,Pointer v,TPossGetter get)
{
if (k == 0)
tpossCons(tp, tfMultiFrList(tl));
else {
TPoss tpk = get(v, k-1);
TPossIterator tpi;
tl = listCons(TForm)(NULL, tl);
for (tpossITER(tpi,tpk); tpossMORE(tpi); tpossSTEP(tpi)) {
TForm t = tpossELT(tpi);
t = tfFollowOnly(t);
setcar(tl, t);
tposs0Multi(tp, k-1, tl, n, v, get);
}
listFreeCons(TForm)(tl);
tpossFree(tpk);
}
}
TPoss
tpossUnion(TPoss tp1, TPoss tp2)
{
TFormList l1;
TFormList l;
if (tp1 == NULL)
return tp2;
else if (tp2 == NULL)
return tp1;
l1 = tp1->possl;
l = listReverse(TForm)(tp2->possl); /* Reversed copy */
for (; l1; l1 = cdr(l1)) {
car(l1) = tfFollowOnly(car(l1));
if (!tpossHas(tp2, car(l1)))
l = listCons(TForm)(car(l1), l);
}
l = listNReverse(TForm)(l);
return tpossFrTheList(l);
}
TForm
tpossUnique(TPoss tp)
{
car(tp->possl) = tfFollowOnly(car(tp->possl));
return car(tp->possl);
}