<> <> 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], []]]; IF br.Functional[][leftToRight] AND z[l]=one --N.B.: we don't check whether the set can enumerate, because of a misplaced desire for efficiency and an unjustifiably optimistic expectation that any set that knows that its size is 1 can also enumerate-- AND (br.Primitive[$Apply, $leftToRight] OR br.Primitive[$Update, $leftToRight]) THEN RETURN [TRUE, [[EnumSetImageTestSet, left, apply], []]]; IF br.Functional[][rightToLeft] AND z[r]=one AND (br.Primitive[$Apply, $rightToLeft] OR br.Primitive[$Update, $rightToLeft]) THEN RETURN [TRUE, [[EnumSetImageTestSet, right, apply], []]]; 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: ARRAY [0 .. 5) OF Analysis _ ALL[[[Empty], []]]; bestCount: [0 .. 5] _ 0; Consider: PROC [ay: Analysis] ~ { cheaperThanSome: BOOL _ FALSE; 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: BOOL _ FALSE; FindSort: PROC [rsets: REF ANY] RETURNS [sort: SortCost _ ALL[asIs]] ~ { 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 => sort _ sort; }; }; 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]] 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 NOT halfed THEN { IF canScan OR br.Primitive[$Get3, FromRO[TotalizeRO[ro]], $FFT] THEN { a: Algorithm _ [family: EnumBRTestSets, sub: IF canScan THEN scan ELSE step]; c: Cost _ [a: [qs: [MemQual[ls], MemQual[rs], poorDefault]]]; c.sort _ 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]]}; SELECT a.sub FROM scan => mp _ br.Scan[Pass, bro]; step => mp _ StepScan[br, Pass, bro]; ENDCASE => ERROR; }; 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: BOOL _ FALSE] ~ { 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] ~ { 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] --it's just barely conceivable that sets[a.s1] can't Scan; see N.B. above--]; }; 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] = 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: 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] = 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; }}; StepScan: PROC [br: BiRel, Test: Tester, ro: RelOrder] RETURNS [MaybePair] ~ { tro: TotalRelOrder ~ TotalizeRO[ro]; cur: MaybePair _ br.GetOne[FALSE, tro]; WHILE cur.found DO IF Test[cur.it] THEN RETURN [cur]; cur _ br.Get3[cur.it, tro, [prev: FALSE, same: FALSE, next: TRUE]].next; ENDLOOP; RETURN [noMaybePair]}; TotalizeRO: PROC [ro: RelOrder] RETURNS [TotalRelOrder] ~ { IF ro.sub[ro.first]=no THEN ro.sub[ro.first] _ fwd; IF ro.sub[OtherSide[ro.first]]=no THEN ro.sub[OtherSide[ro.first]] _ ro.sub[ro.first]; RETURN [ro]}; ClipMul: PROC [a, b: EINT] RETURNS [EINT] ~ INLINE { p: DEINT ~ a.Mul[b]; RETURN [IF p.hi = zero THEN p.lo ELSE lastEINT]}; END.