DIRECTORY AbSets, Atom, BiRelBasics, BiRels, IntStuff, List, SetBasics;

BiRelDefaults: CEDAR PROGRAM
IMPORTS AbSets, BiRelBasics, BiRels, IntStuff, SetBasics
EXPORTS BiRels
=

BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels;

DefaultHasPair: PUBLIC PROC [br: BiRel, pair: Pair] RETURNS [BOOL] ~ {
spaces: SpacePair ~ br.Spaces[];
RETURN [br.ScanRestriction[[Sets.CreateSingleton[pair[left], spaces[left]], Sets.CreateSingleton[pair[right], spaces[right]]], AcceptAny].found]};

DefaultApply: PUBLIC PROC [br: BiRel, v: Value, dir: Direction] RETURNS [mv: MaybeValue _ noMaybe] ~ {
src: Side ~ Source[dir];
dst: Side ~ Dest[dir];
n: LNAT _ 0;
Test: PROC [pair: Pair] RETURNS [BOOL] ~ {
IF (n _ n + 1) > 1 THEN br.Complain[mappingNotSingleton, LIST[v]];
mv _ [TRUE, pair[dst]];
RETURN [FALSE]};
[] _ br.ScanRestriction[ConsSets[src, Sets.CreateSingleton[v, br.Spaces[][src]]], Test];
RETURN};

ImageSize: PUBLIC PROC [br: BiRel, set: Set, dir: Direction _ leftToRight, limit: EINT _ lastEINT] RETURNS [EINT] ~ {
easy: BOOL ~ set.GoodImpl[$Size] AND set.Size[two].Compare[two]<equal;
IF easy THEN RETURN br.RestrictionSize[ConsSets[Source[dir], set], limit];
{image: Set ~ br.Image[set, dir];
RETURN set.DefaultSize[limit]}};

DefaultGetOne: PUBLIC PROC [br: BiRel, remove: BOOL, ro: RelOrder] RETURNS [mp: MaybePair _ noMaybePair] ~ {
IF remove AND br.MutabilityOf[]#variable THEN br.Complain[notVariable];
IF Primitive[br, $ScanRestriction, refNilSets, FromRO[ro]]
THEN mp _ br.Scan[AcceptAny, ro]
ELSE {
spaces: SpacePair ~ br.Spaces[];
SeekBest: PROC [pair: Pair] RETURNS [BOOL] ~ {
IF mp.found
THEN {IF ro.RelPCompare[spaces, pair, mp.it]=less THEN mp.it _ pair}
ELSE mp _ [TRUE, pair];
RETURN [FALSE]};
[] _ br.Scan[SeekBest];
ro _ ro};
IF mp.found AND remove THEN [] _ br.RemPair[mp.it];
RETURN};

DefaultGet3: PUBLIC PROC [br: BiRel, pair: Pair, ro: RelOrder, want: TripleBool] RETURNS [TripleMaybePair] ~ {
ro _ ro.CanonizeRelOrder[br.Functional];
{fq, bq, nq: ImplQuality _ br.QualityOf[$Scan, FromRO[ro]];
rro: RelOrder;
IF ro.sub # ALL[no] THEN {
bq _ br.QualityOf[$Scan, FromRO[rro _ ro.ReverseRO[]]];
nq _ br.QualityOf[$Scan]};
{max: ImplQuality ~ QMax[nq, QMax[fq, bq]];
spaces: SpacePair ~ br.Spaces[];
prev, same, next: MaybePair _ noMaybePair;
IF fq=max OR bq=max THEN {
bwd: BOOL ~ bq=max AND fq<max;
take: BOOL _ FALSE;
Test: PROC [this: Pair] RETURNS [pass: BOOL _ FALSE] ~ {
IF PEqual[spaces, this, pair] THEN same _ [take _ TRUE, pair]
ELSE IF take THEN pass _ TRUE
ELSE prev _ [TRUE, this];
};
next _ br.Scan[Test, IF bwd THEN rro ELSE ro];
IF bwd THEN RETURN [[next, same, prev]];
RETURN [[prev, same, next]]}
ELSE {
foundSame: BOOL _ FALSE;
Test: PROC [this: Pair] RETURNS [pass: BOOL _ FALSE] ~ {
SELECT ro.RelPCompare[spaces, this, pair] FROM
less => IF (NOT prev.found) OR ro.RelPCompare[spaces, this, prev.it]=greater THEN prev _ [TRUE, this];
equal => foundSame _ TRUE;
greater => IF (NOT next.found) OR ro.RelPCompare[spaces, this, next.it]=less THEN next _ [TRUE, this];
notrel => NULL;
ENDCASE => ERROR;
RETURN};
IF br.Scan[Test].found THEN ERROR;
RETURN [[prev, IF foundSame THEN [TRUE, pair] ELSE noMaybePair, next]]};
}}};

DefaultIndex: PUBLIC PROC [br, goal: IntRel, bounds: IntInterval, bwd: BOOL] RETURNS [MaybeValue] ~ {
ENABLE Cant => Cant[br];
right: Space ~ br.Spaces[][right];
brBounds: IntInterval ~ IF br.GoodImpl[$GetIntDom] THEN br.GetIntDom[] ELSE [];
goalBounds: IntInterval ~ goal.GetIntDom[];
goalLen: EINT ~ goalBounds.Length;
first: Set ~ IF goalBounds.Empty THEN nilSet ELSE goal.Mapping[IV[goalBounds.min]];
scanBounds: IntInterval ~ Intersect[
bounds.ClipShiftInterval[IE[goalBounds.min]],
brBounds.ClipShiftInterval[one.Sub[goalLen]]];
Try: PROC [i: INT] RETURNS [BOOL] ~ {
IF first.Equal[br.Mapping[IV[i]]] THEN {
d: EINT ~ ISub[i, goalBounds.min];
FOR j: INT IN (goalBounds.min .. goalBounds.max] DO
fm: Set ~ br.Mapping[IV[d.AddI[j].EI]];
gm: Set ~ goal.Mapping[IV[j]];
IF NOT fm.Equal[gm] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE]};
RETURN [FALSE]};
IF goal.Empty THEN RETURN [[TRUE, IV[IF bwd THEN bounds.max ELSE bounds.min]]];
IF bwd
THEN FOR i: INT DECREASING IN [scanBounds.min .. scanBounds.max] DO
IF Try[i] THEN RETURN [[TRUE, IV[i - goalBounds.min] ]];
ENDLOOP
ELSE FOR i: INT IN [scanBounds.min .. scanBounds.max] DO
IF Try[i] THEN RETURN [[TRUE, IV[i - goalBounds.min] ]];
ENDLOOP;
RETURN [noMaybe]};

DefaultRestrictionSize: PUBLIC PROC [br: BiRel, sets: SetPair, limit: EINT] RETURNS [size: EINT _ zero] ~ {
Pass: PROC [pair: Pair] RETURNS [pass: BOOL] ~ {
TRUSTED {size _ size.Succ[]};
pass _ limit.Compare[size] <= equal;
RETURN};
[] _ br.ScanRestriction[sets, Pass];
RETURN};

DefaultGetBounds: PUBLIC PROC [br: BiRel, want: EndBools, ro: RelOrder] RETURNS [MaybePairInterval] ~ {
IF want = ALL[FALSE] THEN RETURN [[FALSE, ALL[noPair]]];
ro _ ro.CanonizeRelOrder[br.Functional[]];
{rro: RelOrder ~ ro.ReverseRO[];
IF
((NOT want[min]) OR Primitive[br, $ScanRestriction, fromNils, FromRO[ro]]) AND
((NOT want[max]) OR Primitive[br, $ScanRestriction, fromNils, FromRO[rro]])
THEN {
bnds: PairInterval;
FOR e: End IN End DO
IF want[e] THEN {
mp: MaybePair _ br.APair[IF e=min THEN ro ELSE rro];
IF NOT mp.found THEN GOTO Empty;
bnds[e] _ mp.it};
ENDLOOP;
RETURN [[TRUE, bnds]]}
ELSE {
spaces: SpacePair ~ br.Spaces[];
bnds: PairInterval _ ALL[ALL[noValue]];
first: BOOL _ TRUE;
Test: PROC [pair: Pair] RETURNS [BOOL] ~ {
IF first THEN {first _ FALSE; bnds _ [pair, pair]} ELSE {
IF want[min] THEN bnds[min] _ ro.RMin[spaces, bnds[min], pair];
IF want[max] THEN bnds[max] _ ro.RMax[spaces, bnds[max], pair]};
RETURN [FALSE]};
IF br.Scan[Test].found THEN ERROR;
IF first THEN GOTO Empty;
RETURN [[TRUE, bnds]]};
EXITS Empty => RETURN [[FALSE, ALL[noPair]]];
}};

fromNils: REF ANY ~ FromSets[[]];

DefaultCopy: PUBLIC PROC [br: BiRel] RETURNS [VarBiRel] ~ {br.Cant[]};

DefaultValueOf: PUBLIC PROC [br: BiRel] RETURNS [ConstBiRel]
~ {IF br.MutabilityOf#constant THEN RETURN br.Copy.Freeze[] ELSE RETURN br.AsConst[]};

DefaultFreeze: PUBLIC PROC [br: BiRel] RETURNS [ConstBiRel] ~ {
IF br.MutabilityOf#variable THEN br.Complain[notVariable] ELSE br.Cant[]; ERROR};

DefaultThaw: PUBLIC PROC [br: BiRel] ~ {
IF br.MutabilityOf#variable THEN br.Complain[notVariable] ELSE br.Cant[]};

DefaultSetOn: PUBLIC PROC [br: BiRel, side: Side] RETURNS [UWSet] ~ {
RETURN br.Image[CreateFullSet[br.Spaces[][OtherSide[side]]], To[side]].Insulate};

DefaultCurSetOn: PUBLIC PROC [br: BiRel, side: Side] RETURNS [ConstSet] ~ {
IF br.MutabilityOf=constant THEN RETURN br.SetOn[side].AsConst ELSE br.Cant};

DefaultAddPair: PUBLIC PROC [br: BiRel, pair: Pair, if: IfHadPair] RETURNS [had: HadPair] ~ {
spaces: SpacePair ~ br.Spaces[];
IF Primitive[br, $AddSet, FakeRefSingleton[spaces]] THEN RETURN [UnSetHads[br.AddSet[CreateSingleton[pair, spaces], if] ]];
br.Cant[]};

DefaultAddSet: PUBLIC PROC [br, other: BiRel, if: IfHadPair] RETURNS [some: HadSetPair _ ALL[ALL[FALSE]]] ~ {
AddThisPair: PROC [pair: Pair] RETURNS [BOOL] ~ {
had: HadPair ~ br.AddPair[pair, if];
some[leftToRight][had[leftToRight]] _ TRUE;
some[rightToLeft][had[rightToLeft]] _ TRUE;
RETURN [FALSE]};
IF NOT Primitive[br, $AddPair] THEN br.Cant[];
IF other.Scan[AddThisPair].found THEN ERROR;
RETURN};

DefaultSwap: PUBLIC PROC [br: BiRel, a, b: Value, side: Side] ~ {
spaces: SpacePair ~ br.Spaces[];
IF spaces[side].SEqual[a, b] THEN RETURN;
{dir: Direction ~ From[side];
other: Side ~ OtherSide[side];
am: Set ~ br.Mapping[a, dir].CreateHashCopy[];
patt: Pair _ ALL[a];
Movit: PROC [v: Value] RETURNS [BOOL] ~ {
patt[other] _ v;
[] _ br.AddPair[patt];
RETURN [FALSE]};
[] _ br.Delete[a, side];
IF br.ScanMapping[b, Movit, dir].found THEN ERROR;
[] _ br.Delete[b, side];
patt _ ALL[b];
IF am.Scan[Movit].found THEN ERROR;
RETURN}};

DefaultRemPair: PUBLIC PROC [br: BiRel, pair: Pair] RETURNS [had: HadPair] ~ {
spaces: SpacePair ~ br.Spaces[];
IF Primitive[br, $RemSet, FakeRefSingleton[spaces]] THEN RETURN [UnSetHads[br.class.RemSet[br, CreateSingleton[pair, spaces]]]];
br.Cant[]};

DefaultRemSet: PUBLIC PROC [br, other: BiRel] RETURNS [some: HadSetPair] ~ {
RemThisPair: PROC [pair: Pair] RETURNS [BOOL] ~ {
had: HadPair ~ br.RemPair[pair];
some[leftToRight][had[leftToRight]] _ TRUE;
some[rightToLeft][had[rightToLeft]] _ TRUE;
RETURN [FALSE]};
IF NOT Primitive[br, $RemPair] THEN br.Cant[];
IF other.Scan[RemThisPair].found THEN ERROR;
RETURN};

DefaultDelete: PUBLIC PROC [br: BiRel, val: Value, side: Side] RETURNS [hadSome: BOOL _ FALSE] ~ {
srcSpace: Space ~ br.Spaces[][side];
IF Primitive[br, $DeleteSet, Sets.FakeRefSingleton[srcSpace], FromSide[side]]
THEN RETURN [br.class.DeleteSet[br, Sets.CreateSingleton[val, srcSpace], side].had.some];
{other: Side ~ OtherSide[side];
dir: Direction ~ From[side];
pair: Pair _ ALL[val];
KillPair: PROC [v2: Value] RETURNS [BOOL] ~ {
pair[other] _ v2;
[] _ br.RemPair[pair];
hadSome _ TRUE;
RETURN [FALSE]};
IF br.ScanMapping[val, KillPair, dir].found THEN ERROR;
RETURN}};

DefaultDeleteSet: PUBLIC PROC [br: BiRel, set: Set, side: Side] RETURNS [had: SomeAll _ []] ~ {
other: Side ~ OtherSide[side];
dir: Direction ~ From[side];
easy: BOOL ~ Primitive[br, $Delete, FromSide[side]];
EasyKill: PROC [val: Value] RETURNS [BOOL] ~ {
IF br.Delete[val, side] THEN had.some _ TRUE ELSE had.all _ FALSE;
RETURN [FALSE]};
HardKill: PROC [val: Value] RETURNS [BOOL] ~ {
pair: Pair _ ALL[val];
HardKillPair: PROC [v2: Value] RETURNS [BOOL] ~ {
pair[other] _ v2;
[] _ br.RemPair[pair];
some _ TRUE;
RETURN [FALSE]};
some: BOOL _ FALSE;
IF br.ScanMapping[val, HardKillPair, dir].found THEN ERROR;
IF some THEN had.some _ TRUE ELSE had.all _ FALSE;
RETURN [FALSE]};
IF set.Scan[IF easy THEN EasyKill ELSE HardKill].found THEN ERROR;
RETURN};

END.
ΒBiRelDefaults.Mesa
Last tweaked by Mike Spreitzer on December 18, 1987 12:20:13 pm PST
A i B scanBounds: i - goalBounds.min IN bounds
A i B scanBounds: i + goalBounds.Length-1 IN brBounds
ΚΘ–

"cedar" style˜
code™Kš
œC™C—K˜KšΟk	œ>˜GK˜šΟn
œœ
˜Kšœ1˜8Kšœ˜K˜
—K˜Kšœ
œžœ#˜GK˜š
žœœ
œœœ˜FK˜ KšœŒ
˜’
—K˜šžœœ
œ'œ˜fK˜K˜Kšœœ˜šžœœœœ˜*Kšœœ"œ˜BKšœœ
˜Kšœœ˜—K˜XKšœ˜—K˜šž	œœ
œ<œ
œœ˜uKšœœœ"˜FKšœœ
œ7˜JK˜!Kšœ˜ —K˜š
ž
œœ
œœœ"˜lKšœœœ˜GKšœ8˜:Kšœ˜ šœ˜K˜ šžœœœœ˜.šœ	˜Kšœœ*œ˜DKšœœ˜—Kšœœ˜—K˜K˜	—Kšœ
œœ˜3Kšœ˜—K˜šžœœ
œ9œ˜nK˜(Kš
œ;˜;K˜šœ
œœ˜Kš
œ7˜7Kš
œ˜—Kš
œ+˜+K˜ Kš
œ*˜*šœœœ˜Kšœœ
œ˜Kšœœœ
˜š
žœœœœœ˜8Kšœœœ˜=Kšœ
œœ˜Kšœ	œ˜K˜—Kšœœœœ˜.Kšœœ
œ˜(Kšœ˜—šœ˜Kšœœœ
˜š
žœœœœœ˜8šœ$˜.Kšœœœ
œ/œ	œ˜fKšœœ
˜Kšœœœ
œ,œ	œ˜fKšœ
œ
˜Kšœœ
˜—Kšœ˜—Kšœœ
œ
˜"Kš
œ	œœœœ˜H—K˜—K˜š
žœœ
œ.œœ˜eKšœ˜K˜"Kšœœœœ˜OKš
œ+˜+Kšœ	œ˜"Kš	œ
œœœœ˜Sš
œ$˜$KšΟm
œŸ
œ œ™.KšŸ
œŸ
œ%œ	™5Kšœœ˜-Kš
œ.˜.—š
žœœœœœ˜%šœœœ˜(Kšœœ˜"šœœ
œ$˜3Kšœœœ˜'Kšœœ˜Kš
œ
œœ
œœ˜(Kšœ
˜—Kšœœ˜—Kšœœ˜—Kšœœ
œœœ
œœœ˜Ošœ˜šœ
œœ

œ
œ$˜CKš
œœ
œœœ˜8Kš
˜—š	œ
œœ
œ$˜8Kš
œœ
œœœ˜8Kšœ
˜——Kšœ˜—K˜šžœœ
œ#œœœ˜kš
žœœœœ

œ˜0Kšœ˜Kš
œ$˜$Kšœ˜—Kš
œ$˜$Kšœ˜—K˜šžœœ
œ+œ˜gKšœœ
œœ
œœœ˜8K˜*K˜ š
˜Kšœœœ8˜NKšœœœ8˜K—šœ˜K˜šœœ˜šœ	œ˜Kšœœœœ˜4Kšœ
œ
œ
œ˜ K˜—Kšœ
˜—Kšœœ	˜—šœ˜K˜ Kšœœ
œ˜'Kšœœœ
˜šžœœœœ˜*šœœ
œœ˜9Kšœœ.˜?Kšœœ/˜@—Kšœœ˜—Kšœœ
œ
˜"Kšœœ
œ˜Kšœœ
˜—Kšœ
œœœ˜-K˜—K˜Kšœ
œ
œ˜!K˜Kšžœœ
œ
œ˜FK˜šžœœ
œ
œ
˜<Kšœœœ
œœ
œ˜V—K˜šž
œœ
œ
œ˜?Kšœœœœ˜Q—K˜šžœœ
œ˜(Kšœœœ˜J—K˜šžœœ
œœ˜EKšœK˜Q—K˜šžœœ
œœ˜KKšœœ
œœ
˜M—K˜šžœœ
œ(œ˜]K˜ Kšœ2œ
œ<˜{K˜—K˜šž
œœ
œ#œœ
œ
œ˜mšžœœœœ˜1K˜$Kšœ&œ
˜+Kšœ&œ
˜+Kšœœ˜—Kšœ
œœ˜.Kšœœ
œ
˜,Kšœ˜—K˜šžœœ
œ)˜AK˜ Kšœœ
œ
˜)K˜K˜K˜.Kšœ
œ˜šžœœœœ˜)K˜K˜Kšœœ˜—K˜Kšœ%œ
œ
˜2K˜Kšœœ˜Kšœœ
œ
˜#Kšœ˜	—K˜šžœœ
œœ˜NK˜ Kšœ2œ
œA˜€
K˜—K˜šž
œœ
œœ˜Lšžœœœœ˜1K˜ Kšœ&œ
˜+Kšœ&œ
˜+Kšœœ˜—Kšœ
œœ˜.Kšœœ
œ
˜,Kšœ˜—K˜šž
œœ
œ%œœœ˜bK˜$šœK˜MKšœ
œN˜Y—Kš
œ˜K˜Kšœ
œ˜šžœœ
œœ˜-K˜K˜Kšœ
œ
˜Kšœœ˜—Kšœ*œ
œ
˜7Kšœ˜	—K˜šžœœ
œ#œ˜_K˜K˜Kšœœ*˜4šžœœœœ˜.Kš
œœœ
œœ
˜BKšœœ˜—šžœœœœ˜.Kšœ
œ˜šžœœ
œœ˜1K˜K˜Kšœœ
˜Kšœœ˜—Kšœœœ
˜Kšœ.œ
œ
˜;Kš
œœœ
œœ
˜2Kšœœ˜—Kšœ
œœ
œœ
œ
˜BKšœ˜—K˜Kšœ
˜—…—&3ž