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: BOOL ← FALSE;
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: AnalysisList ← NIL;
Consider:
PROC [ay: Analysis] ~ {
cheaperThanSome: BOOL ← FALSE;
last: AnalysisList ← NIL;
FOR bs: AnalysisList ← bests, bs.rest
WHILE bs#
NIL
DO
SELECT CompareCost[bs.first.cost, ay.cost]
FROM
less => IF cheaperThanSome THEN ERROR--transitivity failed-- ELSE RETURN;
greater => {cheaperThanSome ← TRUE; IF last#NIL THEN last.rest ← bs.rest ELSE bests ← bs.rest};
equal, notrel => last ← bs;
ENDCASE => ERROR;
ENDLOOP;
bests ← CONS[ay, bests];
RETURN};
canScan: BOOL ~ Primitive[br, $ScanRestriction];
halfed: BOOL ← FALSE;
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 bests = NIL THEN RETURN [FALSE, [[Empty], []]];
RETURN [TRUE, bests.first];
}};
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] ~
TRUSTED {
SELECT a.family
FROM
EnumSetsTestBR => {
PerOuter:
PROC [outer: Value]
RETURNS [pass:
BOOL] ~
TRUSTED {
pair: Pair ← ALL[outer];
PerInner:
PROC [inner: Value]
RETURNS [pass:
BOOL] ~
TRUSTED {
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] ~
CHECKED {
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] ~
CHECKED {
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:
BOOL ←
FALSE] ~
TRUSTED {
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:
BOOL ←
FALSE] ~
TRUSTED {
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] ~
CHECKED {
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: LOP ← NIL;
SaveForRev:
PROC [pair: Pair]
RETURNS [
BOOL] ~ {
revPairs ← CONS[pair, revPairs];
RETURN [FALSE]};
RevHalf:
PROC [pair: Pair]
RETURNS [
BOOL] ~ {
IF last[ss].kind = no 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: LORA ← NIL;
SaveForSort:
PROC [pair: Pair]
RETURNS [
BOOL] ~ {
sortPairs ← CONS[NEW [Pair ← pair], sortPairs];
RETURN [FALSE]};
SortHalf:
PROC [pair: Pair]
RETURNS [
BOOL] ~ {
IF last[ss].kind = no 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;
}};