HashPairCollectionsPrivateImpl.Mesa
Last tweaked by Mike Spreitzer on October 19, 1987 5:03:26 pm PDT
DIRECTORY HashPairCollectionsPrivate, HashTables, Collections, PairCollections;
HashPairCollectionsPrivateImpl:
CEDAR
MONITOR
LOCKS NARROW[pc.data, HashRelation] USING pc: PairColl
IMPORTS HashPairCollectionsPrivate, HashTables, Collections, PairCollections
EXPORTS HashPairCollectionsPrivate
=
BEGIN OPEN Colls:Collections, Collections, PairCollections, HashPairCollectionsPrivate;
classes: PUBLIC REF Classes ~ NEW[Classes];
Frigid:
PROC [class: PairCollClass]
RETURNS [
BOOL]
~ INLINE {RETURN [class.data = $Frigid]};
Primitive:
PROC [pc: PairColl, op:
ATOM, args: ArgList ←
NIL]
RETURNS [PrimitiveAnswer] ~ {
hr: HashRelation ~ NARROW[pc.data];
RETURN [
SELECT op
FROM
$ScanHalfRestriction, $DeleteColl => IF hr.ability[From[GetSide[args, 1]]]=none THEN no ELSE yes,
ENDCASE => pass];
};
HasPair:
ENTRY
PROC [pc: PairColl, pair: Pair]
RETURNS [
BOOL] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[pc.data];
IF Frigid[pc.class] AND hr.freezeCount=0 THEN RETURN WITH ERROR Error[Colls.unfrozen, LIST[Refify[pc]]];
{map: MaybeValue ~ hr.tables[hr.bestDir].Map[pair[Source[hr.bestDir]]];
y: Value ~ pair[Dest[hr.bestDir]];
IF NOT map.found THEN RETURN [FALSE];
SELECT hr.bestAbility
FROM
none => ERROR;
image => RETURN [Colls.DeRef[map.val].HasMember[y]];
map => RETURN [hr.spaces[Dest[hr.bestDir]].SpaceEqual[map.val, y]];
ENDCASE => ERROR;
}};
Apply:
PROC [pc: PairColl, v: Value, dir: Direction]
RETURNS [MaybeValue] ~ {
hr: HashRelation ~ NARROW[pc.data];
EasyApply:
ENTRY
PROC [pc: PairColl]
RETURNS [MaybeValue] ~ {
ENABLE UNWIND => NULL;
IF Frigid[pc.class] AND hr.freezeCount=0 THEN RETURN WITH ERROR Error[Colls.unfrozen, LIST[Refify[pc]]];
RETURN hr.tables[dir].Map[v];
};
SELECT hr.ability[dir]
FROM
none => RETURN DefaultApply[pc, v, dir];
image => {pc.Complain["%g not functional in this direction"]; ERROR};
map => RETURN EasyApply[pc];
ENDCASE => ERROR;
};
Scan:
PROC [pc: PairColl,
Test: Tester, bkwd:
BOOL ←
FALSE]
RETURNS [mp: MaybePair ← noMaybePair] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[pc.data];
PassColl:
PROC [pair: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
x: Value ~ pair[left];
coll: Collection ~ Colls.DeRef[pair[right]];
subj: Pair ← ALL[x];
PassElt:
PROC [val: Value]
RETURNS [pass:
BOOL ←
FALSE] ~ {
subj[Dest[hr.bestDir]] ← val;
IF (pass ← Test[subj]) THEN mp ← [TRUE, subj];
RETURN};
pass ← coll.Scan[PassElt].found;
RETURN};
RevTest:
PROC [pair: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
rev: Pair ~ InvertPair[pair];
IF (pass ← Test[rev]) THEN mp ← [TRUE, rev];
RETURN};
IF Frigid[pc.class] AND hr.freezeCount=0 THEN ERROR Error[Colls.unfrozen, LIST[Refify[pc]]];
SELECT hr.bestAbility
FROM
none => ERROR;
image => hr.tables[hr.bestDir] ← hr.tables[hr.bestDir].Scan[PassColl].same;
map =>
SELECT hr.bestDir
FROM
leftToRight => [hr.tables[hr.bestDir], mp] ← hr.tables[hr.bestDir].Scan[Test];
rightToLeft => hr.tables[hr.bestDir] ← hr.tables[hr.bestDir].Scan[RevTest].same;
ENDCASE => ERROR;
ENDCASE => ERROR;
RETURN};
ScanHalfRestriction:
PROC [pc: PairColl, side: Side, coll: Collection,
Test: Tester, bkwd:
BOOL]
RETURNS [mp: MaybePair ← noMaybePair] ~ {
ENABLE UNWIND => NULL;
dir: Direction ~ From[side];
hr: HashRelation ~ NARROW[pc.data];
IF Frigid[pc.class] AND hr.freezeCount=0 THEN ERROR Error[Colls.unfrozen, LIST[Refify[pc]]];
IF hr.ability[dir]=none OR NOT coll.Can[$Scan, LIST[FromBool[bkwd]]] THEN RETURN DefaultScanHalfRestriction[pc, side, coll, Test, bkwd];
{dom: Side ~ Source[dir];
rng: Side ~ Dest[dir];
PerDomElt:
PROC [val: Value]
RETURNS [pass:
BOOL ←
FALSE] ~ {
map: MaybeValue ~ hr.tables[dir].Map[val];
IF map.found
THEN {
pair: Pair ← ALL[val];
SELECT hr.ability[dir]
FROM
map => {
pair[rng] ← map.val;
IF (pass ← Test[pair]) THEN mp ← [TRUE, pair];
};
image => {
image: Collection ~ Colls.DeRef[map.val];
Pass:
PROC [w: Value]
RETURNS [
BOOL]
~ {pair[rng] ← w; RETURN Test[pair]};
mv: MaybeValue ~ image.Scan[Pass, bkwd];
IF (pass ← mv.found) THEN mp ← [TRUE, pair];
};
none => ERROR;
ENDCASE => ERROR;
};
};
[] ← coll.Scan[PerDomElt, bkwd];
RETURN}};
Size:
ENTRY
PROC [pc: PairColl, limit:
LNAT ←
LNAT.
LAST]
RETURNS [
LNAT] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[pc.data];
IF Frigid[pc.class] AND hr.freezeCount=0 THEN RETURN WITH ERROR Error[Colls.unfrozen, LIST[Refify[pc]]];
SELECT hr.bestAbility
FROM
none => ERROR;
image => RETURN [hr.size];
map => RETURN [hr.tables[hr.bestDir].Size];
ENDCASE => ERROR;
};
Copy:
PROC [pc: PairColl]
RETURNS [VarPairColl] ~ {
RETURN [CreateHashCopy[pc]];
};
Insulate:
ENTRY
PROC [pc: PairColl]
RETURNS [UWPairColl] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[pc.data];
RETURN [AsUW[[FetchClass[hr.ability, readonly], hr]]];
};
Freeze:
ENTRY
PROC [pc: PairColl]
RETURNS [const: ConstPairColl] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[pc.data];
IF pc.MutabilityOf # variable THEN RETURN WITH ERROR Error[notVariable, LIST[pc.Refify]];
hr.freezeCount ← hr.freezeCount + 1;
RETURN [AsConst[[FetchClass[hr.ability, constant], hr]]];
};
Thaw:
ENTRY
PROC [pc: PairColl] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[pc.data];
IF pc.MutabilityOf # variable THEN RETURN WITH ERROR Error[notVariable, LIST[pc.Refify]];
IF hr.freezeCount = 0 THEN RETURN WITH ERROR Error["thawing unfrozen collection", LIST[Refify[pc]]];
hr.freezeCount ← hr.freezeCount - 1;
};
AddColl:
PROC [pc, other: PairColl, if: IfNewsPair, where: Where]
RETURNS [some: NewsSetPair] ~ {
fnl: BoolPair ~ pc.Functional[];
Addit:
PROC [x: Pair] ~ {
news: NewsPair ~ AddPair[pc, x, if, where];
FOR dir: Direction IN Direction DO IF fnl[dir] THEN some[dir][news[dir]] ← TRUE ENDLOOP;
RETURN};
some ← ALL[ALL[FALSE]];
other.Enumerate[Addit];
RETURN};
AddPair:
ENTRY
PROC [pc: PairColl, pair: Pair, if: IfNewsPair, where: Where]
RETURNS [news: NewsPair] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[pc.data];
remove: ARRAY Direction OF MaybeValue ← ALL[Colls.noMaybe];
inc, dont: BOOL ← FALSE;
IF pc.MutabilityOf#variable THEN RETURN WITH ERROR Error[notVariable, LIST[Refify[pc]]];
IF hr.freezeCount # 0 THEN RETURN WITH ERROR Error[Colls.frozen, LIST[Refify[pc]]];
IF where.kind # any THEN RETURN WITH ERROR Cant[pc];
FOR dir: Direction
IN Direction
DO
src: Side ~ Source[dir];
dst: Side ~ Dest[dir];
dom: Value ~ pair[src];
rng: Value ~ pair[dst];
map: MaybeValue ~ hr.tables[dir].Map[dom];
SELECT hr.ability[dir]
FROM
none => NULL;
image => NULL;
map => {
news[dir] ← IF map.found THEN IF hr.spaces[dst].SpaceEqual[map.val, rng] THEN same ELSE different ELSE new;
IF NOT if[dir][news[dir]=new] THEN dont ← TRUE;
};
ENDCASE => ERROR;
ENDLOOP;
IF dont THEN RETURN;
FOR dir: Direction
IN Direction
DO
src: Side ~ Source[dir];
dst: Side ~ Dest[dir];
dom: Value ~ pair[src];
rng: Value ~ pair[dst];
map: MaybeValue ~ hr.tables[dir].Map[dom];
SELECT hr.ability[dir]
FROM
none => NULL;
image =>
IF map.found
THEN {
set: Set ~ Colls.DeRef[map.val];
IF set.AddElt[rng] THEN inc ← TRUE;
}
ELSE {
set: Colls.HashSet ~ Colls.CreateHashSet[hr.spaces[dst]];
[] ← set.AddElt[rng];
inc ← TRUE;
hr.tables[dir] ← hr.tables[dir].Store[dom, set.Refify];
};
map => {
IF news[dir]=different THEN remove[OtherDirection[dir]] ← map;
IF news[dir]#same THEN hr.tables[dir] ← hr.tables[dir].Store[dom, rng];
};
ENDCASE => ERROR;
ENDLOOP;
IF inc THEN hr.size ← hr.size+1;
FOR dir: Direction
IN Direction
DO
IF remove[dir].found THEN [] ← HalfRemove[hr, dir, remove[dir].val, pair[Dest[dir]], FALSE];
ENDLOOP;
RETURN};
HalfRemove:
INTERNAL
PROC [hr: HashRelation, dir: Direction, dom, rng: Value, decr:
BOOL]
RETURNS [had:
BOOL] ~ {
map: MaybeValue ~ hr.tables[dir].Map[dom];
doit: BOOL ← FALSE;
SELECT hr.ability[dir]
FROM
none => had ← FALSE--well, neither TRUE nor FALSE is appropriate, but an un-initialized BOOL can lead to intermittent behavior, which is hard to debug--;
image =>
IF map.found
THEN {
set: Set ~ Colls.DeRef[map.val];
doit ← had ← set.RemoveElt[rng];
IF set.Empty AND NOT hr.tables[dir].Delete[dom] THEN ERROR;
}
ELSE had ← FALSE;
map => {
RemIfNecessary:
PROC [old: MaybeValue]
RETURNS [new: MaybeValue] ~ {
had ← old.found AND hr.spaces[Dest[dir]].SpaceEqual[old.val, rng];
new ← Colls.noMaybe;
RETURN};
hr.tables[dir] ← hr.tables[dir].Update[dom, RemIfNecessary];
};
ENDCASE => ERROR;
IF decr AND doit THEN hr.size ← hr.size-1;
RETURN};
RemColl:
PROC [pc, other: PairColl, style: RemoveStyle]
RETURNS [hadSome, hadAll: BoolPair] ~ {
Remit:
PROC [x: Pair] ~ {
had: BoolPair ~ RemPair[pc, x, style];
FOR d: Direction IN Direction DO IF had[d] THEN hadSome[d] ← TRUE ELSE hadAll[d] ← FALSE ENDLOOP;
RETURN};
hadSome ← ALL[FALSE];
hadAll ← ALL[TRUE];
other.Enumerate[Remit];
RETURN};
RemPair:
ENTRY
PROC [pc: PairColl, pair: Pair, style: RemoveStyle]
RETURNS [hadMapping: BoolPair] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[pc.data];
IF pc.MutabilityOf#variable THEN RETURN WITH ERROR Error[notVariable, LIST[Refify[pc]]];
IF hr.freezeCount # 0 THEN RETURN WITH ERROR Error[Colls.frozen, LIST[Refify[pc]]];
FOR dir: Direction
IN Direction
DO
hadMapping[dir] ← HalfRemove[hr, dir, pair[Source[dir]], pair[Dest[dir]], dir=hr.bestDir];
ENDLOOP;
RETURN};
DeleteColl:
ENTRY
PROC [pc: PairColl, coll: Collection, side: Side, style: RemoveStyle]
RETURNS [hadSome, hadAll:
BOOL] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[pc.data];
dir: Direction ~ From[side];
odir: Direction ~ To[side];
EltRemove:
INTERNAL
PROC [val: Value] ~ {
remove: Collection ~ HalfDelete[hr, val, dir, style];
InnerRemove:
INTERNAL
PROC [back: Value] ~ {
IF NOT HalfRemove[hr, odir, back, val, FALSE] THEN ERROR;
RETURN};
IF remove.Empty
THEN hadAll ←
FALSE
ELSE {
hadSome ← TRUE;
IF hr.ability[odir]#none THEN remove.Enumerate[InnerRemove];
};
RETURN};
IF pc.MutabilityOf#variable THEN RETURN WITH ERROR Error[notVariable, LIST[Refify[pc]]];
IF hr.freezeCount # 0 THEN RETURN WITH ERROR Error[Colls.frozen, LIST[Refify[pc]]];
IF hr.ability[dir]=none THEN RETURN DefaultDeleteColl[pc, coll, side, style];
hadSome ← FALSE;
hadAll ← TRUE;
coll.Enumerate[EltRemove];
RETURN};
HalfDelete:
INTERNAL
PROC [hr: HashRelation, val: Value, dir: Direction, style: RemoveStyle]
RETURNS [remove: Collection] ~ {
remove ← Colls.emptySet;
SELECT hr.ability[dir]
FROM
none => ERROR;
image => {
RemIfNecessary:
PROC [old: MaybeValue]
RETURNS [new: MaybeValue] ~ {
IF old.found
THEN {
range: Set ~ Colls.DeRef[old.val];
SELECT style
FROM
any, all => {remove ← range; new ← Colls.noMaybe};
one, first => {
doomed: MaybeValue ~ range.First[];
IF NOT doomed.found THEN ERROR;
remove ← Colls.CreateSingleton[doomed.val, hr.spaces[Dest[dir]]];
IF NOT range.RemoveElt[doomed.val] THEN ERROR;
new ← IF range.Empty THEN Colls.noMaybe ELSE old;
};
ENDCASE => ERROR;
};
RETURN};
hr.tables[dir] ← hr.tables[dir].Update[val, RemIfNecessary];
};
map => {
RemIfNecessary:
PROC [old: MaybeValue]
RETURNS [new: MaybeValue] ~ {
IF old.found THEN remove ← Colls.CreateSingleton[old.val, hr.spaces[Dest[dir]]];
new ← Colls.noMaybe;
};
hr.tables[dir] ← hr.tables[dir].Update[val, RemIfNecessary];
};
ENDCASE => ERROR;
hr.size ← hr.size - remove.Size[];
};
Spaces:
PROC [pc: PairColl]
RETURNS [SpacePair] ~ {
hr: HashRelation ~ NARROW[pc.data];
RETURN [hr.spaces];
};
Start:
PROC ~ {
FOR lr: Ability
IN Ability
DO
FOR rl: Ability
IN Ability
DO
classes[lr][rl][variable] ← CreateClass[[
Primitive: Primitive,
HasPair: HasPair,
Apply: Apply,
Scan: Scan,
ScanHalfRestriction: ScanHalfRestriction,
Size: Size,
Copy: Copy,
Insulate: Insulate,
Freeze: Freeze,
Thaw: Thaw,
AddColl: AddColl,
RemColl: RemColl,
DeleteColl: DeleteColl,
Spaces: Spaces,
functional: [lr=map, rl=map],
mayDuplicate: FALSE,
mutability: variable]];
classes[lr][rl][readonly] ← CreateClass[[
Primitive: Primitive,
HasPair: HasPair,
Apply: Apply,
Scan: Scan,
ScanHalfRestriction: ScanHalfRestriction,
Size: Size,
Copy: Copy,
Spaces: Spaces,
functional: [lr=map, rl=map],
mayDuplicate: FALSE,
mutability: readonly]];
classes[lr][rl][constant] ← CreateClass[[
Primitive: Primitive,
HasPair: HasPair,
Apply: Apply,
Scan: Scan,
ScanHalfRestriction: ScanHalfRestriction,
Size: Size,
Copy: Copy,
Spaces: Spaces,
functional: [lr=map, rl=map],
mayDuplicate: FALSE,
mutability: constant]];
ENDLOOP ENDLOOP;
};
Start[];
END.