SetsAsBiRels.Mesa
Last tweaked by Mike Spreitzer on February 27, 1988 12:11:07 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 [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.