BiRelScanning.Mesa
Last tweaked by Mike Spreitzer on January 6, 1988 4:10:59 pm PST
DIRECTORY AbSets, Atom, BiRelBasics, BiRels, BiRelsPrivate, IntStuff, List, SetBasics;
BiRelScanning: CEDAR PROGRAM
IMPORTS AbSets, BiRelBasics, BiRels, IntStuff, List, SetBasics
EXPORTS BiRels, BiRelsPrivate
=
BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels, BiRelsPrivate;
nine: EINT ~ CE[9];
PlanDefaultScanRestriction: PUBLIC PROC [br: BiRel, sets: SetPair, ro: RelOrder] RETURNS [can: BOOL, plan: Analysis] ~ {
ls: Set ~ sets[left];
rs: Set ~ sets[right];
z: ARRAY What OF EINT ~ [
l: IF IsNil[ls] OR NOT ls.GoodImpl[$Size] THEN lastEINT ELSE ls.Size[],
r: IF IsNil[rs] OR NOT rs.GoodImpl[$Size] THEN lastEINT ELSE rs.Size[],
b: IF Primitive[br, $RestrictionSize] THEN br.Size[] ELSE lastEINT];
IF z[l]=zero OR z[r]=zero OR z[b]=zero THEN RETURN [TRUE, [[Empty], []]];
ro ← ro.CanonizeRelOrder[br.Functional];
{
sf: Side ~ ro.first;
ss: Side ~ OtherSide[sf];
setF: Set ~ sets[sf];
setS: Set ~ sets[ss];
spaces: SpacePair ~ br.Spaces[];
spaceF: Space ~ spaces[sf];
spaceS: Space ~ spaces[ss];
sspaceF: Space ~ IF IsNil[setF] THEN spaceF ELSE setF.SpaceOf;
sspaceS: Space ~ IF IsNil[setS] THEN spaceS ELSE setS.SpaceOf;
of: Sets.RelOrder ~ ro.sub[sf];
os: Sets.RelOrder ~ ro.sub[ss];
ofr: Sets.RelOrder ~ of.ReverseRO[];
osr: Sets.RelOrder ~ os.ReverseRO[];
MemQual: PROC [set: Set] RETURNS [ImplQuality] ~ INLINE {RETURN [
IF IsNil[set] THEN primitive ELSE set.QualityOf[$HasMember]]};
Eval: PROC [c: Cost] RETURNS [i: EINT ← nine] ~ TRUSTED {
j: EINT ← nine;
FOR w: What IN What DO
SELECT c.a.qs[w] FROM
primitive, goodDefault => NULL;
poorDefault => i ← ClipMul[i, z[w]];
cant => i ← lastEINT;
ENDCASE => ERROR;
SELECT c.b.qs[w] FROM
primitive, goodDefault => NULL;
poorDefault => j ← ClipMul[j, z[w]];
cant => j ← lastEINT;
ENDCASE => ERROR;
ENDLOOP;
i ← i.Add[j].AddI[c.sort[sf].ORD*3+c.sort[ss].ORD];
RETURN};
EasyCompare: PROC [cs: ARRAY AB OF HalfCost, sorts: ARRAY AB OF SortCost] RETURNS [cc: PartialComparison] ~ {
IF cs[a]=cs[b] AND sorts[a]=sorts[b] THEN RETURN [equal];
{greater, less: BOOLFALSE;
FOR w: What IN What DO
IF cs[a].qs[w] > cs[b].qs[w] THEN less ← TRUE ELSE
IF cs[a].qs[w] < cs[b].qs[w] THEN greater ← TRUE;
ENDLOOP;
IF greater AND NOT less THEN RETURN [greater];
IF less AND NOT greater THEN RETURN [less];
IF less AND greater THEN RETURN [notrel];
IF (cc ← Partialify[CompareIntI[sorts[a][sf].ORD, sorts[b][sf].ORD]]) # equal THEN RETURN;
cc ← Partialify[CompareIntI[sorts[a][ss].ORD, sorts[b][ss].ORD]];
RETURN}};
CompareCost: PROC [c1, c2: Cost] RETURNS [PartialComparison] ~ {
ca: PartialComparison ~ EasyCompare[[c1.a, c2.a], [c1.sort, c2.sort]];
cb: PartialComparison ~ EasyCompare[[c1.b, c2.b], [c1.sort, c2.sort]];
IF ca=cb OR cb=equal THEN RETURN [ca];
IF ca=equal THEN RETURN [cb];
RETURN [Partialify[Eval[c1].Compare[Eval[c2]]]]};
bests: ARRAY [0 .. 5) OF Analysis ← ALL[[[Empty], []]];
bestCount: [0 .. 5] ← 0;
Consider: PROC [ay: Analysis] ~ {
cheaperThanSome: BOOLFALSE;
i: [0 .. 5] ← 0;
WHILE i < bestCount DO
SELECT CompareCost[bests[i].cost, ay.cost] FROM
less => IF cheaperThanSome THEN ERROR--transitivity failed-- ELSE RETURN;
greater => {
cheaperThanSome ← TRUE;
bests[i] ← bests[bestCount-1];
bestCount ← bestCount-1};
equal, notrel => i ← i + 1;
ENDCASE => ERROR;
ENDLOOP;
bests[bestCount] ← ay;
bestCount ← bestCount + 1;
RETURN};
canScan: BOOL ~ Primitive[br, $ScanRestriction];
halfed: BOOLFALSE;
FindSort: PROC [rsets: REF ANY] RETURNS [sort: SortCost ← ALL[asIs], sub: SubFamily ← apply] ~ {
IF of#no THEN {
IF Primitive[br, $ScanRestriction, rsets, FromRO[ConsRelOrder[sf, of]]] THEN sort[sf] ← asIs
ELSE IF Primitive[br, $ScanRestriction, rsets, FromRO[ConsRelOrder[sf, ofr]]] THEN sort[sf] ← reverse
ELSE sort[sf] ← sort;
IF os=no THEN NULL
ELSE IF sort[sf]=sort THEN sort[ss] ← sort
ELSE {
sort[ss] ← sort;
FOR o1: EasySort IN [sort[sf] .. reverse] DO FOR o2: EasySort IN EasySort DO
sro: RelOrder ← ro;
IF o1=reverse THEN sro.sub[sf] ← sro.sub[sf].ReverseRO[];
IF o2=reverse THEN sro.sub[ss] ← sro.sub[ss].ReverseRO[];
IF Primitive[br, $ScanRestriction, rsets, FromRO[sro]] THEN {sort[sf] ← o1; sort[ss] ← o2; GOTO Gotit};
ENDLOOP ENDLOOP;
EXITS Gotit => sub ← full;
};
};
RETURN};
IF (NOT (IsNil[ls] OR IsNil[rs])) AND Primitive[br, $HasPair] AND ls.Can[$Scan] AND rs.Can[$Scan] THEN {
c: Cost ← [a: [qs: [poorDefault, poorDefault, primitive]]];
IF of=no THEN NULL
ELSE {
c.sort[sf] ← IF sspaceF#spaceF THEN sort
ELSE IF setF.GoodImpl[$Scan, Sets.FromRO[of]] THEN asIs
ELSE IF setF.GoodImpl[$Scan, Sets.FromRO[ofr]] THEN reverse
ELSE sort;
IF os#no THEN c.sort[ss] ←
IF c.sort[sf]=sort OR sspaceS#spaceS THEN sort
ELSE IF setS.GoodImpl[$Scan, Sets.FromRO[os]] THEN asIs
ELSE IF setS.GoodImpl[$Scan, Sets.FromRO[osr]] THEN reverse
ELSE sort;
};
Consider[[alg: [EnumSetsTestBR], cost: c]];
};
FOR s1: Side IN Side DO
s2: Side ~ OtherSide[s1];
dir: Direction ~ From[s1];
set1: Set ~ sets[s1];
set2: Set ~ sets[s2];
w1: What ~ SideWhat[s1];
w2: What ~ SideWhat[s2];
halfPair: RefSetPair ~ FromSets[ConsSets[s1, set1]];
canHalf: BOOL ~ Primitive[br, $ScanRestriction, halfPair];
IF canHalf THEN {
a: Algorithm ← [REnumBRTestSet, s1];
c: Cost ← [];
c.a.qs[w2] ← MemQual[set2];
c.a.qs[IF br.Functional[][dir] AND z[w1].Compare[z[b]]<equal THEN w1 ELSE b] ← poorDefault;
[c.sort, a.sub] ← FindSort[halfPair];
Consider[[a, c]];
halfed ← TRUE;
}
ELSE IF (NOT IsNil[set1]) AND set1.Can[$Scan] THEN {
c: Cost ← [];
a: Algorithm ← [EnumSetImageTestSet, s1];
fake: REF ANY;
c.a.qs[w1] ← poorDefault;
c.b.qs[w2] ← MemQual[set2];
c.b.qs[IF br.Functional[][dir] AND z[w1].Compare[z[b]]<equal THEN w1 ELSE b] ← poorDefault;
IF br.Functional[][dir] AND Primitive[br, $Apply, FromDir[dir]] THEN a.sub ← apply
ELSE IF Primitive[br, $Image, FromDir[dir]] THEN a.sub ← image
ELSE IF Primitive[br, $ScanRestriction, fake ← FromSets[ConsSets[s1, [Sets.GetSingletonClass[br.Spaces[][s1]], noValue]]]] THEN a.sub ← scanRestriction
ELSE GOTO Cant;
IF of=no THEN NULL
ELSE {
c.sort[sf] ←
IF s1 # sf THEN sort
ELSE IF set1.GoodImpl[$Scan, Sets.FromRO[of]] THEN asIs
ELSE IF set1.GoodImpl[$Scan, Sets.FromRO[ofr]] THEN reverse
ELSE sort;
IF os=no THEN NULL
ELSE IF c.sort[sf]=sort THEN c.sort[ss] ← sort
ELSE c.sort[ss] ← SELECT a.sub FROM
apply => asIs,
image => sort--assume the worst, since we can't query the image without making it, and that might be painful--,
scanRestriction =>
IF Primitive[br, $ScanRestriction, fake, FromRO[ConsRelOrder[ss, os]]] THEN asIs
ELSE IF Primitive[br, $ScanRestriction, fake, FromRO[ConsRelOrder[ss, osr]]] THEN reverse
ELSE sort,
ENDCASE => ERROR;
};
Consider[[a, c]];
EXITS Cant => halfed ← halfed;
};
ENDLOOP;
IF canScan AND NOT halfed THEN {
a: Algorithm ← [EnumBRTestSets];
c: Cost ← [a: [qs: [MemQual[ls], MemQual[rs], poorDefault]]];
[c.sort, a.sub] ← FindSort[FromSets[[]]];
Consider[[a, c]];
};
IF bestCount = 0 THEN RETURN [FALSE, [[Empty], []]];
RETURN [TRUE, bests[0]];
}};
DefaultScanRestriction: PUBLIC PROC [br: BiRel, sets: SetPair, Test: Tester, ro: RelOrder] RETURNS [mp: MaybePair ← noMaybePair] ~ {
plan: Analysis;
can: BOOL;
[can, plan] ← PlanDefaultScanRestriction[br, sets, ro];
IF NOT can THEN br.Cant[];
IF plan.alg.family=Empty THEN RETURN [noMaybePair];
{
a: Algorithm ~ plan.alg;
c: Cost ~ plan.cost;
s2: Side ~ OtherSide[a.s1];
dir: Direction ~ From[a.s1];
set2: Set ~ sets[s2];
ls: Set ~ sets[left];
rs: Set ~ sets[right];
sf: Side ~ ro.first;
ss: Side ~ OtherSide[sf];
setF: Set ~ sets[sf];
setS: Set ~ sets[ss];
spaces: SpacePair ~ br.Spaces[];
spaceF: Space ~ spaces[sf];
spaceS: Space ~ spaces[ss];
os: Sets.RelOrder ~ ro.sub[ss];
osr: Sets.RelOrder ~ os.ReverseRO[];
bro: RelOrder ~ [
[
left: SELECT c.sort[left] FROM asIs => ro.sub[left], reverse => ro.sub[left].ReverseRO[], sort => no, ENDCASE => ERROR,
right: SELECT c.sort[right] FROM asIs => ro.sub[right], reverse => ro.sub[right].ReverseRO[], sort => no, ENDCASE => ERROR],
ro.first];
Scan1: PROC [Consume: Tester] RETURNS [mp: MaybePair ← noMaybePair] ~ {
SELECT a.family FROM
EnumSetsTestBR => {
PerOuter: PROC [outer: Value] RETURNS [pass: BOOL] ~ {
pair: Pair ← ALL[outer];
PerInner: PROC [inner: Value] RETURNS [pass: BOOL] ~ {
pair[ss] ← inner;
RETURN [br.HasPair[pair] AND Consume[pair]]};
[[found: pass, it: mp.it[ss]]] ← setS.Scan[PerInner, bro.sub[ss]];
RETURN};
[[found: mp.found, it: mp.it[sf]]] ← setF.Scan[PerOuter, bro.sub[sf]];
};
EnumBRTestSets => {
Pass: PROC [pair: Pair] RETURNS [BOOL] ~ {
RETURN [(IsNil[ls] OR ls.HasMember[pair[left]]) AND (IsNil[rs] OR rs.HasMember[pair[right]]) AND Consume[pair]]};
mp ← br.Scan[Pass, bro];
};
REnumBRTestSet => {
Pass: PROC [pair: Pair] RETURNS [BOOL] ~ {
RETURN [(IsNil[set2] OR set2.HasMember[pair[s2]]) AND Consume[pair]]};
mp ← br.ScanHalfRestriction[sets[a.s1], Pass, a.s1, bro];
};
EnumSetImageTestSet => {
singeltonClass: SetClass ~ Sets.GetSingletonClass[br.Spaces[][s2]];
PerOuter: PROC [outer: Value] RETURNS [pass: BOOLFALSE] ~ {
pair: Pair ← ALL[outer];
SELECT a.sub FROM
apply => {mv: MaybeValue ~ br.Apply[outer, dir];
IF mv.found AND (IsNil[set2] OR set2.HasMember[mv.it]) THEN {
pair[s2] ← mv.it;
IF (pass ← Consume[pair]) THEN mp.it[s2] ← mv.it}};
image => {image: Set ~ br.Image[[singeltonClass, outer], dir];
PerInner: PROC [inner: Value] RETURNS [pass: BOOLFALSE] ~ {
IF IsNil[set2] OR set2.HasMember[inner] THEN {pair[s2] ← inner; RETURN [Consume[pair]]}};
[[found: pass, it: mp.it[s2]]] ← image.Scan[PerInner, bro.sub[s2]];
};
scanRestriction => {
PerInner: PROC [pair: Pair] RETURNS [pass: BOOL] ~ {
RETURN [(IsNil[set2] OR set2.HasMember[pair[s2]]) AND Consume[pair]]};
pass ← (mp ← br.ScanHalfRestriction[[singeltonClass, outer], PerInner, a.s1, bro]).found;
};
ENDCASE => ERROR;
RETURN};
[[found: mp.found, it: mp.it[a.s1]]] ← sets[a.s1].Scan[PerOuter, bro.sub[a.s1]];
};
ENDCASE => ERROR;
RETURN--from Scan1--};
Scan2: PROC [so: SortOp, Produce: PROC [Tester] RETURNS [MaybePair], Consume: Tester, half: BOOL, sop: SubOrderPair ← ALL[no]] RETURNS [mp: MaybePair ← noMaybePair] ~ {
last: Pair ← ALL[noValue];
SELECT so FROM
asIs => mp ← Produce[Consume];
reverse => {
revPairs: LOPNIL;
SaveForRev: PROC [pair: Pair] RETURNS [BOOL] ~ {
revPairs ← CONS[pair, revPairs];
RETURN [FALSE]};
RevHalf: PROC [pair: Pair] RETURNS [BOOL] ~ {
IF last[ss] = noValue THEN NULL
ELSE IF NOT spaceS.SEqual[last[ss], pair[ss]] THEN {IF RevPlayback[] THEN RETURN [TRUE]};
revPairs ← CONS[pair, revPairs];
RETURN [FALSE]};
RevPlayback: PROC RETURNS [BOOL] ~ {
FOR revPairs ← revPairs, revPairs.rest WHILE revPairs#NIL DO
IF Consume[revPairs.first] THEN RETURN [(mp ← [TRUE, revPairs.first]).found];
ENDLOOP;
RETURN [FALSE]};
IF NOT Produce[IF half THEN RevHalf ELSE SaveForRev].found THEN [] ← RevPlayback[];
};
sort => {
sortPairs: LORANIL;
SaveForSort: PROC [pair: Pair] RETURNS [BOOL] ~ {
sortPairs ← CONS[NEW [Pair ← pair], sortPairs];
RETURN [FALSE]};
SortHalf: PROC [pair: Pair] RETURNS [BOOL] ~ {
IF last[ss] = noValue THEN NULL
ELSE IF NOT spaceS.SEqual[last[ss], pair[ss]] THEN {IF SortAndPlayback[] THEN RETURN [TRUE]};
sortPairs ← CONS[NEW [Pair ← pair], sortPairs];
RETURN [FALSE]};
SortAndPlayback: PROC RETURNS [BOOL] ~ {
Compare: PROC [ref1, ref2: REF ANY] RETURNS [c: Comparison] ~ {
pair1: Pair ~ NARROW[ref1, REF Pair]^;
pair2: Pair ~ NARROW[ref2, REF Pair]^;
IF (c ← sop[sf].RelCompare[spaceF, pair1[sf], pair2[sf]])#equal THEN RETURN;
RETURN [sop[ss].RelCompare[spaceS, pair1[ss], pair2[ss]]]};
sortPairs ← List.Sort[sortPairs, Compare];
FOR sortPairs ← sortPairs, sortPairs.rest WHILE sortPairs#NIL DO
rp: REF Pair ~ NARROW[sortPairs.first];
IF Consume[rp^] THEN RETURN [(mp ← [TRUE, rp^]).found];
ENDLOOP;
RETURN [FALSE]};
IF NOT Produce[IF half THEN SortHalf ELSE SaveForSort].found THEN [] ← SortAndPlayback[];
};
ENDCASE => ERROR;
RETURN--from Scan2--};
Scan3: PROC [Consume: Tester] RETURNS [MaybePair] ~ {
SELECT c.sort[ss] FROM
asIs => RETURN Scan2[asIs, Scan1, Consume, FALSE];
reverse => RETURN Scan2[reverse, Scan1, Consume, TRUE];
sort => RETURN Scan2[sort, Scan1, Consume, TRUE,
IF c.sort[sf]=reverse
THEN ConsRelOrders[ss, osr]
ELSE ConsRelOrders[ss, os]];
ENDCASE => ERROR};
SELECT c.sort[sf] FROM
asIs => mp ← Scan3[Test];
reverse => mp ← Scan2[reverse, Scan3, Test, FALSE];
sort => mp ← Scan2[sort, Scan1, Test, FALSE, ro.sub];
ENDCASE => ERROR;
}};
ClipMul: PROC [a, b: EINT] RETURNS [EINT] ~ INLINE {
p: DEINT ~ a.Mul[b];
RETURN [IF p.hi = zero THEN p.lo ELSE lastEINT]};
END.