SetsAsBiRels.Mesa
Last tweaked by Mike Spreitzer on December 14, 1987 1:15:49 pm PST
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 [[a[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]};
ListFromLORA: PUBLIC PROC [vals: LORA, space: Space ← basic, mutability: Mutability ← variable, order: Sets.RelOrder ← no, assumeSorted: BOOLFALSE] RETURNS [Set] ~ {
head, tail: LOVNIL;
FOR vals ← vals, vals.rest WHILE vals#NIL DO
this: LOV ~ LIST[[a[vals.first]]];
IF tail=NIL THEN head ← this ELSE tail.rest ← this;
tail ← this;
ENDLOOP;
RETURN CreateList[head, space, mutability, order, assumeSorted]};
CreateList: PUBLIC PROC [vals: LOV, space: Space ← basic, mutability: Mutability ← variable, order: Sets.RelOrder ← no, assumeSorted: BOOLFALSE] RETURNS [Set] ~ {
head, tail: LOPNIL;
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], mutability, [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;
RETURN [ans]}};
CreateHashSet: PUBLIC PROC [space: Space ← basic] RETURNS [HashSet] ~ {
br: BiRel ~ CreateHashReln[spaces: ALL[space], functional: ALL[TRUE], mappable: [TRUE, FALSE]];
RETURN ImplementSetByIDSubset[br].AsVar};
CreateHashCopy: PUBLIC PROC [set: Set, space: Space ← NIL--NIL means to use the same space as the given set--] RETURNS [HashSet] ~ {
copy: HashSet ~ CreateHashSet[IF space=NIL THEN set.SpaceOf[] ELSE space];
[] ← copy.AddSet[set];
RETURN [copy]};
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.