DIRECTORY AbSets, BiRelBasics, BiRels, IntStuff, SetBasics;

SetsAsBiRels: CEDAR PROGRAM
IMPORTS AbSets, BiRelBasics, BiRels, SetBasics
EXPORTS AbSets
=

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

key: ATOM ~ $SetsAsBiRelsKey;

Narrowing: TYPE ~ REF NarrowingPrivate;
NarrowingPrivate: TYPE ~ RECORD [
set: Set,
spaces: SpacePair,
ro: TotalRelOrder];

DefaultQuaBiRel: PUBLIC PROC [set: Set] RETURNS [found: BOOL, class, data: REF ANY] ~ {
space: Space ~ set.SpaceOf[];
mps: MaybePairSpace ~ QuaPairSpace[space];
IF NOT mps.found THEN RETURN [FALSE, NIL, NIL];
{n: Narrowing ~ NEW [NarrowingPrivate _ [
set: set,
spaces: mps.it.sp,
ro: mps.it.tro]];
RETURN [TRUE, narrowClasses[set.MutabilityOf[]], n]}};

NarrowClasses: TYPE ~ ARRAY Mutability OF BiRelClass;
narrowClasses: REF NarrowClasses ~ NEW [NarrowClasses];

NarrPrimitive: PROC [br: BiRel, op: ATOM, arg1, arg2: REF ANY] RETURNS [PrimitiveAnswer] ~ {
n: Narrowing ~ NARROW[br.data];
SELECT op FROM
$AsSet => {
ro: RelOrder ~ ToRO[arg1].CanonizeRelOrder[br.Functional[]];
RETURN [IF ro=n.ro THEN yes ELSE no]};
$HasPair => RETURN [IF n.set.Can[$HasMember] THEN yes ELSE no];
$ScanRestriction => {
sets: RefSetPair ~ ToSets[arg1];
ro: RelOrder ~ ToRO[arg2].CanonizeRelOrder[br.Functional[]];
wro: MaybeSetsRelOrder ~ Wro[n, ro];
RETURN [IF sets^=ALL[nilSet] AND wro.found AND n.set.Can[$scan] THEN yes ELSE no]};
$GetOne => {
remove: BOOL ~ ToBool[arg1];
ro: RelOrder ~ ToRO[arg2].CanonizeRelOrder[br.Functional[]];
wro: MaybeSetsRelOrder ~ Wro[n, ro];
RETURN [IF wro.found AND n.set.Can[$GetOne, LIST[FromBool[remove], Sets.FromRO[wro.it]]] THEN yes ELSE no]};
$Get3 => {
ro: RelOrder ~ ToRO[arg1].CanonizeRelOrder[br.Functional[]];
wro: MaybeSetsRelOrder ~ Wro[n, ro];
RETURN [IF wro.found AND n.set.Can[$Get3, arg2] THEN yes ELSE no]};
$RestrictionSize => {
sets: RefSetPair ~ ToSets[arg1];
RETURN [IF sets^=ALL[nilSet] AND n.set.Can[$Size, arg2] THEN yes ELSE no]};
$GetBounds => {
want: EndBools ~ ToEB[arg1];
ro: RelOrder ~ ToRO[arg2].CanonizeRelOrder[br.Functional[]];
wro: MaybeSetsRelOrder ~ Wro[n, ro];
RETURN [IF wro.found AND n.set.Can[$GetBounds, LIST[FromEB[ReorderEB[wro.it, want]]]] THEN yes ELSE no]};
$Copy, $Insulate, $ValueOf, $Freeze, $Thaw => RETURN [IF n.set.Can[op] THEN yes ELSE no];
ENDCASE => RETURN [pass];
};

NarrAsSet: PROC [br: BiRel, ro: RelOrder] RETURNS [Set--of REF Pair--] ~ {
n: Narrowing ~ NARROW[br.data];
ro _ ro.CanonizeRelOrder[br.Functional[]];
IF ro = n.ro THEN RETURN [n.set] ELSE RETURN DefaultAsSet[br, ro]};

NarrHasPair: PROC [br: BiRel, pair: Pair] RETURNS [BOOL] ~ {
n: Narrowing ~ NARROW[br.data];
RETURN n.set.HasMember[Wp[pair]]};

NarrScanRestriction: PROC [br: BiRel, sets: SetPair, Test: Tester, ro: RelOrder] RETURNS [MaybePair] ~ {
n: Narrowing ~ NARROW[br.data];
Pass: PROC [val: Value] RETURNS [pass: BOOL] ~ {
pair: Pair ~ Nv[val];
pass _ Test[pair];
RETURN};
wro: MaybeSetsRelOrder ~ Wro[n, ro _ CanonizeRelOrder[ro, br.Functional[]]];
IF sets # ALL[nilSet] OR NOT wro.found THEN RETURN DefaultScanRestriction[br, sets, Test, ro];
RETURN Nmv[n.set.Scan[Pass, wro.it]]};

NarrGetOne: PROC [br: BiRel, remove: BOOL, ro: RelOrder] RETURNS [MaybePair] ~ {
n: Narrowing ~ NARROW[br.data];
wro: MaybeSetsRelOrder ~ Wro[n, CanonizeRelOrder[ro, br.Functional[]]];
IF NOT wro.found THEN RETURN DefaultGetOne[br, remove, ro];
RETURN Nmv[n.set.GetOne[remove, wro.it]]};

NarrGet3: PROC [br: BiRel, pair: Pair, ro: RelOrder, want: TripleBool] RETURNS [TripleMaybePair] ~ {
n: Narrowing ~ NARROW[br.data];
wro: MaybeSetsRelOrder ~ Wro[n, CanonizeRelOrder[ro, br.Functional[]]];
IF NOT wro.found THEN RETURN DefaultGet3[br, pair, ro, want];
{tmv: TripleMaybeValue ~ n.set.Get3[Wp[pair], want];
RETURN [SELECT wro.it FROM
no, fwd => [Nmv[tmv.prev], Nmv[tmv.same], Nmv[tmv.next]],
bwd => [Nmv[tmv.next], Nmv[tmv.same], Nmv[tmv.prev]],
ENDCASE => ERROR];
}};

NarrRestrictionSize: PROC [br: BiRel, sets: SetPair, limit: EINT] RETURNS [EINT] ~ {
n: Narrowing ~ NARROW[br.data];
IF sets = ALL[nilSet] THEN RETURN n.set.Size[limit];
RETURN DefaultRestrictionSize[br, sets, limit]};

NarrGetBounds: PROC [br: BiRel, want: EndBools, ro: RelOrder] RETURNS [MaybePairInterval] ~ {
n: Narrowing ~ NARROW[br.data];
wro: MaybeSetsRelOrder ~ Wro[n, CanonizeRelOrder[ro, br.Functional[]]];
IF NOT wro.found THEN RETURN DefaultGetBounds[br, want, ro];
{mi: MaybeInterval ~ n.set.GetBounds[ReorderEB[wro.it, want]];
IF NOT mi.found THEN RETURN [[FALSE, []]];
RETURN [[TRUE, IF wro.it=bwd
THEN [Nv[mi.it[max]], Nv[mi.it[min]]]
ELSE [Nv[mi.it[min]], Nv[mi.it[max]]]
]]}};

NarrCopy: PROC [br: BiRel] RETURNS [VarBiRel] ~ {
n: Narrowing ~ NARROW[br.data];
RETURN SetAsBiRel[n.set.Copy].AsVar};

NarrInsulate: PROC [br: BiRel] RETURNS [UWBiRel] ~ {
n: Narrowing ~ NARROW[br.data];
RETURN SetAsBiRel[n.set.Insulate].AsUW};

NarrValueOf: PROC [br: BiRel] RETURNS [ConstBiRel] ~ {
n: Narrowing ~ NARROW[br.data];
RETURN SetAsBiRel[n.set.ValueOf].AsConst};

NarrFreeze: PROC [br: BiRel] RETURNS [ConstBiRel] ~ {
n: Narrowing ~ NARROW[br.data];
RETURN SetAsBiRel[n.set.Freeze].AsConst};

NarrThaw: PROC [br: BiRel] ~ {
n: Narrowing ~ NARROW[br.data];
n.set.Thaw[];
RETURN};

NarrSpaces: PROC [br: BiRel] RETURNS [SpacePair] ~ {
n: Narrowing ~ NARROW[br.data];
RETURN [n.spaces]};

Nv: PROC [v: Value] RETURNS [Pair]
~ INLINE {RETURN [NARROW[v.VA, REF Pair]^]};

Wp: PROC [p: Pair] RETURNS [Value]
~ INLINE {RETURN [AV[NEW [Pair _ p]]]};

Wmp: PROC [mp: MaybePair] RETURNS [MaybeValue]
~ INLINE {RETURN [IF mp.found THEN [TRUE, Wp[mp.it]] ELSE noMaybe]};

Nmv: PROC [mv: MaybeValue] RETURNS [MaybePair]
~ INLINE {RETURN [IF mv.found THEN [TRUE, Nv[mv.it]] ELSE noMaybePair]};

Nro: PROC [ro: Sets.RelOrder] RETURNS [RelOrder]
~ INLINE {RETURN [SELECT ro FROM
no => [],
fwd => [ALL[fwd]],
bwd => [ALL[bwd]],
ENDCASE => ERROR]};

MaybeSetsRelOrder: TYPE ~ RECORD [found: BOOL, it: Sets.RelOrder];

Wro: PROC [n: Narrowing, ro: RelOrder] RETURNS [MaybeSetsRelOrder] ~ {
IF ro.sub = ALL[no] THEN RETURN [[TRUE, no]];
IF ro.first # n.ro.first THEN RETURN [[FALSE, no]];
{rev: BOOL ~ ro.sub[ro.first] # n.ro.sub[ro.first];
s2: Side ~ OtherSide[ro.first];
IF ro.sub[s2]#no AND (rev # (ro.sub[s2] # n.ro.sub[s2])) THEN RETURN [[FALSE, no]];
RETURN [[TRUE, IF rev THEN bwd ELSE fwd]]}};

ReorderEB: PROC [ro: Sets.RelOrder, eb: EndBools] RETURNS [EndBools]
~ INLINE {RETURN [IF ro=bwd THEN [min: eb[max], max: eb[min]] ELSE eb]};


CreateList: PUBLIC PROC [vals: LOV, space: Space _ refs, mutability: Mutability _ variable, order: Sets.RelOrder _ no, assumeSorted: BOOL _ FALSE] RETURNS [Set] ~ {
head, tail: LOP _ NIL;
assumeSorted _ assumeSorted OR vals=NIL OR vals.rest=NIL;
IF assumeSorted THEN FOR vals _ vals, vals.rest WHILE vals#NIL DO
this: LOP ~ LIST[ALL[vals.first]];
IF tail#NIL THEN tail.rest _ this ELSE head _ this;
ENDLOOP;
{br: BiRel ~ BiRels.CreateList[head, ALL[TRUE], ALL[space], IF assumeSorted THEN mutability ELSE variable, [ALL[order]], assumeSorted];
ans: Set ~ ImplementSetByIDSubset[br];
IF NOT assumeSorted THEN {
FOR vals _ vals, vals.rest WHILE vals#NIL DO
[] _ ans.AddElt[vals.first];
ENDLOOP;
IF mutability#variable THEN RETURN [ans.Freeze]};
RETURN [ans]}};

ListFromLORA: PUBLIC PROC [vals: LORA, space: Space _ refs, mutability: Mutability _ variable, order: Sets.RelOrder _ no, assumeSorted: BOOL _ FALSE] RETURNS [Set] ~ {
head, tail: LOV _ NIL;
FOR vals _ vals, vals.rest WHILE vals#NIL DO
this: LOV ~ LIST[AV[vals.first]];
IF tail=NIL THEN head _ this ELSE tail.rest _ this;
tail _ this;
ENDLOOP;
RETURN CreateList[head, space, mutability, order, assumeSorted]};

CreateRedBlackSet: PUBLIC PROC [space: Space _ refs] RETURNS [VarSet] ~ {
br: BiRel ~ CreateRedBlackTable[spaces: ALL[space]];
RETURN ImplementSetByIDSubset[br].AsVar};

Start: PROC ~ {
FOR mut: Mutability IN Mutability DO
narrowClasses[mut] _ CreateClass[[
Primitive: NarrPrimitive,
AsSet: NarrAsSet,
HasPair: NarrHasPair,
ScanRestriction: NarrScanRestriction,
GetOne: NarrGetOne,
Get3: NarrGet3,
RestrictionSize: NarrRestrictionSize,
GetBounds: NarrGetBounds,
Copy: NarrCopy,
Insulate: IF mut=variable THEN NarrInsulate ELSE NIL,
ValueOf: IF mut#constant THEN NarrValueOf ELSE NIL,
Freeze: IF mut=variable THEN NarrFreeze ELSE NIL,
Thaw: IF mut=variable THEN NarrThaw ELSE NIL,
Spaces: NarrSpaces,
mutability: mut
]];
ENDLOOP;
RETURN};

Start[];

END.
\SetsAsBiRels.Mesa
Last tweaked by Mike Spreitzer on February 27, 1988 12:11:07 pm PST
Κ
ί–

"cedar" style˜
code™Kš
œC™C—K˜KšΟk	œ2˜;K˜šΟnœœ
˜Kšœ'˜.Kšœ˜K˜
—K˜Kšœ
œžœ#˜=K˜Kšœœ˜K˜Kšœœœ˜'šœœœ˜!Kš
œ	˜	K˜Kš
œ˜—K˜šžœœ
œœ	œœ
œ˜WK˜Kš
œ*˜*Kšœ
œœ
œœœœ˜/šœœ˜)K˜	K˜K˜—Kšœœ*˜6—K˜Kšœœœœ˜5Kšœœœ˜7K˜šž
œœœœ
œœ˜\Kšœœ
˜šœ˜˜K˜<Kšœœ	œœ˜&—Kš	œœœœœ˜?š
œ˜K˜ K˜<Kš
œ$˜$Kšœœœ	œœœœ˜S—˜Kšœœ˜K˜<Kš
œ$˜$Kšœœœœ)œœ˜l—˜
K˜<Kš
œ$˜$Kš
œœœœœ˜C—š
œ˜K˜ Kšœœœ	œœœ˜K—˜K˜K˜<Kš
œ$˜$Kšœœœœ#œœ˜i—Kš	œ.œœœœ˜YKšœœ˜—K˜—K˜šž	œœœΟcœ˜JKšœœ
˜K˜*Kš
œœ
œ	œ
œ˜C—K˜šžœœœœ˜<Kšœœ
˜Kšœ˜"—K˜šžœœžœœ˜hKšœœ
˜šžœœœœ˜0K˜K˜Kšœ˜—Kš
œL˜LKšœœ	œ
œœ
œ,˜^Kšœ ˜&—K˜šž
œœœœ˜PKšœœ
˜Kš
œG˜GKšœ
œœ
œ˜;Kšœ$˜*—K˜šžœœ9œ˜dKšœœ
˜Kš
œG˜GKšœ
œœ
œ!˜=Kš
œ4˜4šœœ˜Kš
œ9˜9Kš
œ5˜5Kšœœ˜—K˜—K˜š
žœœ#œœœ˜TKšœœ
˜Kšœœ	œ
œ˜4Kšœ*˜0—K˜šž
œœ+œ˜]Kšœœ
˜Kš
œG˜GKšœ
œœ
œ ˜<Kš
œ>˜>Kš
œ
œ
œ
œœ˜*šœœœ˜Kšœ!˜%Kšœ!˜%K˜——K˜šžœœ
œ˜1Kšœœ
˜Kšœ˜%—K˜šžœœ
œ˜4Kšœœ
˜Kšœ"˜(—K˜šžœœ
œ˜6Kšœœ
˜Kšœ$˜*—K˜šž
œœ
œ˜5Kšœœ
˜Kšœ#˜)—K˜šžœœ˜Kšœœ
˜K˜
Kšœ˜—K˜šž
œœ
œ˜4Kšœœ
˜Kšœ
˜—K˜šžœœœ˜"Kšœœœœœœ
˜,—K˜šžœœœ˜"Kšœœœ˜'—K˜šžœœœ
˜.Kš
œœœœ
œœ
œ˜D—K˜šžœœœ˜.Kš
œœœœ
œœ
œ˜H—K˜šžœœœ˜0šœœœœ˜ K˜	Kšœœ˜Kšœœ˜Kšœœ˜——K˜Kšœœœ	œ˜BK˜šžœœœ˜FKš
œ
œœ
œœ˜-Kšœœ
œœ˜3Kšœœ)˜3K˜Kš
œœ%œ
œœ˜SKš
œœœœœ	˜,—K˜šž	œœ#œ˜DKšœœœœœœ˜H—K˜K˜šž
œœ
œœcœœœ
˜€
Kšœœœ
˜Kš	œœœ
œœ
˜9šœœ
œœœ
˜AKšœœœ
œ˜"Kšœœ
œœ
˜3Kšœ
˜—Kšœ%œ
œœ	œœœœ˜‡
Kš
œ&˜&šœ
œœ˜šœœœ
˜,K˜Kšœ
˜—Kšœœ
œ˜1—Kšœ	˜—K˜šžœœ
œœcœœœ
˜§
Kšœœœ
˜šœœœ
˜,Kšœœœ˜!Kšœœ
œ
œ˜3K˜Kšœ
˜—Kšœ;˜A—K˜šžœœ
œœ
˜IKšœ(œ	˜4Kšœ#˜)—K˜šžœœ˜šœœ˜$š
œ"˜"Kšž	œ˜Kšžœ˜Kšžœ˜Kšžœ˜%Kšžœ
˜Kšžœ˜Kšžœ˜%Kšž	œ˜Kšžœ˜Kš
žœœœœ
œ
˜5Kš
žœœœ
œ
œ
˜3Kš
žœœœœ
œ
˜1Kš
žœœœ
œ
œ
˜-Kšžœ
˜K˜Kš
œ˜—Kšœ
˜—Kšœ˜—K˜K˜K˜Kšœ
˜—…— ž+Ω