BiRelsHashed.Mesa
Last tweaked by Mike Spreitzer on December 15, 1987 11:06:46 am PST
DIRECTORY AbSets, BiRelBasics, BiRels, IntStuff, SetBasics, ValueHashTables;
BiRelsHashed:
CEDAR
MONITOR
LOCKS NARROW[br.data, HashRelation] USING br: BiRel
IMPORTS AbSets, BiRelBasics, BiRels, IntStuff, SetBasics, ValueHashTables
EXPORTS BiRels
=
BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRels, HT:ValueHashTables;
Ability: TYPE ~ {none, image, map};
Abilities: TYPE ~ ARRAY Direction OF Ability;
HashRelation: TYPE ~ REF HashRelationPrivate;
HashRelationPrivate:
TYPE ~
MONITORED
RECORD [
spaces: SpacePair,
ability: Abilities,
bestAbility: Ability,
bestDir: Direction,
tables: ARRAY Direction OF HT.HashTable,
size: LNAT ← 0,
freezeCount: NATURAL ← 0
];
Classes: TYPE ~ ARRAY --leftToRight--Ability OF ARRAY --rightToLeft--Ability OF ARRAY Mutability OF BiRelClass;
classes: PUBLIC REF Classes ~ NEW[Classes];
CreateHashReln:
PUBLIC
PROC [spaces: SpacePair ← [refs, refs], functional: BoolPair ← [
FALSE,
FALSE], mappable: BoolPair ← [
TRUE,
TRUE]]
RETURNS [VarBiRel] ~ {
ability: Abilities;
FOR dir: Direction
IN Direction
DO
ability[dir] ← IF functional[dir] THEN map ELSE IF mappable[dir] THEN image ELSE none;
ENDLOOP;
{bestDir: Direction ~ IF ability[rightToLeft] > ability[leftToRight] THEN rightToLeft ELSE leftToRight;
hr: HashRelation ~
NEW [HashRelationPrivate ← [
spaces: spaces,
ability: ability,
bestDir: bestDir,
bestAbility: ability[bestDir],
tables: [HT.Create[spaces[left]], HT.Create[spaces[right]]]
]];
RETURN [AsVar[[FetchClass[hr.ability, variable], hr]]];
}};
CreateHashCopy:
PUBLIC
PROC [br: BiRel, spaces: SpacePair ← [
NIL,
NIL], mappable: BoolPair ← [
FALSE,
FALSE]]
RETURNS [copy: HashFn] ~ {
FOR side: Side
IN Side
DO
IF spaces[side]=NIL THEN spaces[side] ← br.Spaces[][side];
ENDLOOP;
copy ← CreateHashReln[spaces, br.Functional, mappable];
[] ← copy.AddSet[br];
RETURN};
FetchClass: PROC [ability: Abilities, mutability: Mutability] RETURNS [class: BiRelClass] ~ INLINE {RETURN [classes[ability[leftToRight]][ability[rightToLeft]][mutability]]};
Frigid:
PROC [class: BiRelClass]
RETURNS [
BOOL]
~ INLINE {RETURN [class.data = $Frigid]};
HasherPrimitive:
PROC [br: BiRel, op:
ATOM, arg1, arg2:
REF
ANY ←
NIL]
RETURNS [PrimitiveAnswer] ~ {
hr: HashRelation ~ NARROW[br.data];
SELECT op
FROM
$HasPair => RETURN [IF Frigid[br.class] AND hr.freezeCount=0 OR hr.bestAbility#none THEN yes ELSE no];
$Apply => RETURN [IF Frigid[br.class] AND hr.freezeCount=0 OR hr.ability[ToDir[arg1]]#none THEN yes ELSE no];
$ScanRestriction => {sets: RefSetPair ~ ToSets[arg1];
ro: RelOrder ~ ToRO[arg2].CanonizeRelOrder[br.Functional];
RETURN [IF Frigid[br.class] AND hr.freezeCount=0 OR ro.sub[ro.first]=no AND sets^=ALL[nilSet] AND hr.bestAbility#none THEN yes ELSE no]};
$RestrictionSize => RETURN [IF ToSets[arg1]^=ALL[nilSet] THEN yes ELSE no];
$DeleteSet => RETURN [IF hr.ability[From[ToSide[arg2]]]#none THEN yes ELSE no];
ENDCASE => RETURN [pass];
};
HasherHasPair:
ENTRY
PROC [br: BiRel, pair: Pair]
RETURNS [
BOOL] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[br.data];
IF Frigid[br.class] AND hr.freezeCount=0 THEN RETURN WITH ERROR Error[Sets.unfrozen, LIST[AV[br.Refify]]];
{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 [Sets.DeRef[map.it.VA].HasMember[y]];
map => RETURN [hr.spaces[Dest[hr.bestDir]].SEqual[map.it, y]];
ENDCASE => ERROR;
}};
HasherApply:
PROC [br: BiRel, v: Value, dir: Direction]
RETURNS [MaybeValue] ~ {
hr: HashRelation ~ NARROW[br.data];
EasyApply:
ENTRY
PROC [br: BiRel]
RETURNS [MaybeValue] ~ {
ENABLE UNWIND => NULL;
IF Frigid[br.class] AND hr.freezeCount=0 THEN RETURN WITH ERROR Error[Sets.unfrozen, LIST[AV[br.Refify]]];
RETURN hr.tables[dir].Map[v];
};
SELECT hr.ability[dir]
FROM
none => RETURN DefaultApply[br, v, dir];
image => {br.Complain["%g not functional in this direction"]; ERROR};
map => RETURN EasyApply[br];
ENDCASE => ERROR;
};
HasherScanRestriction:
PROC [br: BiRel, sets: SetPair,
Test: Tester, ro: RelOrder]
RETURNS [mp: MaybePair ← noMaybePair] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[br.data];
cro: RelOrder ~ ro.CanonizeRelOrder[br.Functional];
PassSet:
PROC [pair: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
x: Value ~ pair[left];
set: Set ~ Sets.DeRef[pair[right].VA];
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 ← set.Scan[PassElt].found;
RETURN};
InvTest:
PROC [pair: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
rev: Pair ~ BiRelBasics.InvertPair[pair];
IF (pass ← Test[rev]) THEN mp ← [TRUE, rev];
RETURN};
IF Frigid[br.class] AND hr.freezeCount=0 THEN ERROR Error[Sets.unfrozen, LIST[AV[br.Refify]]];
IF ro.sub[ro.first]#no OR sets#ALL[nilSet] THEN RETURN DefaultScanRestriction[br, sets, Test, ro];
SELECT hr.bestAbility
FROM
none => ERROR;
image => hr.tables[hr.bestDir] ← hr.tables[hr.bestDir].Scan[PassSet].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[InvTest].same;
ENDCASE => ERROR;
ENDCASE => ERROR;
RETURN};
HasherRestrictionSize:
PROC [br: BiRel, sets: SetPair, limit:
EINT]
RETURNS [
EINT] ~ {
hr: HashRelation ~ NARROW[br.data];
WithLock:
ENTRY
PROC [br: BiRel]
RETURNS [
EINT] ~ {
ENABLE UNWIND => NULL;
IF Frigid[br.class] AND hr.freezeCount=0 THEN RETURN WITH ERROR Error[Sets.unfrozen, LIST[AV[br.Refify]]];
SELECT hr.bestAbility
FROM
none => ERROR;
image => RETURN [IE[hr.size]];
map => RETURN [IE[hr.tables[hr.bestDir].Size]];
ENDCASE => ERROR};
IF sets#ALL[nilSet] THEN RETURN DefaultRestrictionSize[br, sets, limit];
RETURN WithLock[br]};
HasherCopy:
PROC [br: BiRel]
RETURNS [VarBiRel] ~ {
mappable: BoolPair ~ [
leftToRight: br.GoodImpl[$Image, LIST[$leftToRight]],
rightToLeft: br.GoodImpl[$Image, LIST[$rightToLeft]]];
RETURN CreateHashCopy[br, ALL[NIL], mappable]};
HasherInsulate:
ENTRY
PROC [br: BiRel]
RETURNS [UWBiRel] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[br.data];
RETURN [AsUW[[FetchClass[hr.ability, readonly], hr]]];
};
HasherFreeze:
ENTRY
PROC [br: BiRel]
RETURNS [ConstBiRel] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[br.data];
IF br.MutabilityOf # variable THEN RETURN WITH ERROR Error[notVariable, LIST[AV[br.Refify]]];
hr.freezeCount ← hr.freezeCount + 1;
RETURN [AsConst[[FetchClass[hr.ability, constant], hr]]];
};
HasherThaw:
ENTRY
PROC [br: BiRel] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[br.data];
IF br.MutabilityOf # variable THEN RETURN WITH ERROR Error[notVariable, LIST[AV[br.Refify]]];
IF hr.freezeCount = 0 THEN RETURN WITH ERROR Error["thawing unfrozen collection", LIST[AV[br.Refify]]];
hr.freezeCount ← hr.freezeCount - 1;
};
HasherAddPair:
ENTRY
PROC [br: BiRel, pair: Pair, if: IfHadPair]
RETURNS [had: HadPair] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[br.data];
fnl: BoolPair ~ br.Functional[];
remove: ARRAY Direction OF MaybeValue ← ALL[Sets.noMaybe];
inc, dont: BOOL ← FALSE;
dirs: ARRAY [0 .. 1] OF Direction ← [leftToRight, rightToLeft];
IF br.MutabilityOf#variable THEN RETURN WITH ERROR Error[notVariable, LIST[AV[br.Refify]]];
IF hr.freezeCount # 0 THEN RETURN WITH ERROR Error[Sets.frozen, LIST[AV[br.Refify]]];
IF fnl=
ALL[
TRUE]
THEN {
dir: Direction ~ rightToLeft;
src: Side ~ Source[dir];
dst: Side ~ Dest[dir];
dom: Value ~ pair[src];
rng: Value ~ pair[dst];
map: MaybeValue ~ hr.tables[dir].Map[dom];
had[dir] ← IF map.found THEN IF hr.spaces[dst].SEqual[map.it, rng] THEN same ELSE different ELSE none;
IF NOT if[dir][had[dir]=none] THEN dont ← TRUE;
}
ELSE IF fnl = [FALSE, TRUE] THEN dirs ← [rightToLeft, leftToRight];
FOR i: [0 .. 1]
IN [0 .. 1]
DO
dir: Direction ~ dirs[i];
src: Side ~ Source[dir];
dst: Side ~ Dest[dir];
dom: Value ~ pair[src];
rng: Value ~ pair[dst];
AddIDecide:
PROC [map: MaybeValue]
RETURNS [MaybeValue] ~ {
IF map.found
THEN {
set: Set ~ Sets.DeRef[map.it.VA];
IF set.AddElt[rng] THEN inc ← TRUE;
RETURN [map]}
ELSE {
set: Sets.HashSet ~ Sets.CreateHashSet[hr.spaces[dst]];
[] ← set.AddElt[rng];
inc ← TRUE;
RETURN [[TRUE, AV[set.Refify] ]];
};
};
AddMDecide:
PROC [map: MaybeValue]
RETURNS [MaybeValue] ~ {
IF i=0
THEN {
had[dir] ← IF map.found THEN IF hr.spaces[dst].SEqual[map.it, rng] THEN same ELSE different ELSE none;
IF NOT if[dir][had[dir]=none] THEN dont ← TRUE;
};
IF dont THEN RETURN [map];
IF had[dir]=different THEN remove[OtherDirection[dir]] ← map;
RETURN [[TRUE, rng]]};
SELECT hr.ability[dir]
FROM
none => NULL;
image => hr.tables[dir] ← hr.tables[dir].Update[dom, AddIDecide];
map => hr.tables[dir] ← hr.tables[dir].Update[dom, AddMDecide];
ENDCASE => ERROR;
IF dont THEN RETURN;
ENDLOOP;
IF inc THEN hr.size ← hr.size+1;
FOR dir: Direction
IN Direction
DO
IF remove[dir].found THEN [] ← HalfRem[hr, dir, remove[dir].it, pair[Dest[dir]], FALSE];
ENDLOOP;
RETURN};
HalfRem:
INTERNAL
PROC [hr: HashRelation, dir: Direction, dom, rng: Value, decr:
BOOL]
RETURNS [had: Had] ~ {
doit: BOOL ← FALSE;
MRemIfNecessary:
PROC [old: MaybeValue]
RETURNS [MaybeValue] ~ {
had ←
SELECT
TRUE
FROM
NOT old.found => none,
hr.spaces[Dest[dir]].SEqual[old.it, rng] => same,
ENDCASE => different;
RETURN [Sets.noMaybe]};
IRemIfNecessary:
PROC [map: MaybeValue]
RETURNS [MaybeValue] ~ {
IF map.found
THEN {
set: Set ~ Sets.DeRef[map.it.VA];
had ← IF (doit ← set.RemElt[rng]) THEN same ELSE different;
RETURN [IF set.Empty THEN noMaybe ELSE map]}
ELSE {had ← none; RETURN [map]};
};
SELECT hr.ability[dir]
FROM
none => had ← none--well, nothing is appropriate, but an un-initialized variable can lead to intermittent behavior, which is hard to debug--;
image => hr.tables[dir] ← hr.tables[dir].Update[dom, IRemIfNecessary];
map => hr.tables[dir] ← hr.tables[dir].Update[dom, MRemIfNecessary];
ENDCASE => ERROR;
IF decr AND doit THEN hr.size ← hr.size-1;
RETURN};
HasherRemPair:
ENTRY
PROC [br: BiRel, pair: Pair]
RETURNS [had: HadPair] ~ {
ENABLE UNWIND => NULL;
hr: HashRelation ~ NARROW[br.data];
IF br.MutabilityOf#variable THEN RETURN WITH ERROR Error[notVariable, LIST[AV[br.Refify]]];
IF hr.freezeCount # 0 THEN RETURN WITH ERROR Error[Sets.frozen, LIST[AV[br.Refify]]];
FOR dir: Direction
IN Direction
DO
had[dir] ← HalfRem[hr, dir, pair[Source[dir]], pair[Dest[dir]], dir=hr.bestDir];
ENDLOOP;
RETURN};
HasherDeleteSet:
PROC [br: BiRel, set: Set, side: Side]
RETURNS [had: SomeAll ← []] ~ {
hr: HashRelation ~ NARROW[br.data];
dir: Direction ~ From[side];
WithLock:
ENTRY
PROC [br: BiRel] ~ {
ENABLE UNWIND => NULL;
odir: Direction ~ To[side];
EltRem:
INTERNAL
PROC [val: Value] ~ {
remove: Set ~ HalfDelete[hr, val, dir];
InnerRem:
INTERNAL
PROC [back: Value] ~ {
IF HalfRem[hr, odir, back, val, FALSE]#same THEN ERROR;
RETURN};
IF remove=nilSet
OR remove.Empty
THEN had.all ←
FALSE
ELSE {
had.some ← TRUE;
IF hr.ability[odir]#none THEN remove.Enumerate[InnerRem];
};
RETURN};
IF br.MutabilityOf#variable THEN RETURN WITH ERROR Error[notVariable, LIST[AV[br.Refify]]];
IF hr.freezeCount # 0 THEN RETURN WITH ERROR Error[Sets.frozen, LIST[AV[br.Refify]]];
set.Enumerate[EltRem];
RETURN};
IF hr.ability[dir]=none THEN RETURN DefaultDeleteSet[br, set, side];
WithLock[br];
RETURN};
HalfDelete:
INTERNAL
PROC [hr: HashRelation, val: Value, dir: Direction]
RETURNS [remove: Set ← nilSet] ~ {
SELECT hr.ability[dir]
FROM
none => ERROR;
image => {
DIRemIfNecessary:
PROC [old: MaybeValue]
RETURNS [MaybeValue] ~ {
IF old.found THEN remove ← Sets.DeRef[old.it.VA];
RETURN [Sets.noMaybe]};
hr.tables[dir] ← hr.tables[dir].Update[val, DIRemIfNecessary];
};
map => {
DMRemIfNecessary:
PROC [old: MaybeValue]
RETURNS [MaybeValue] ~ {
IF old.found THEN remove ← Sets.CreateSingleton[old.it, hr.spaces[Dest[dir]]];
RETURN [Sets.noMaybe]};
hr.tables[dir] ← hr.tables[dir].Update[val, DMRemIfNecessary];
};
ENDCASE => ERROR;
hr.size ← hr.size - remove.Size[].EI;
};
HasherSpaces:
PROC [br: BiRel]
RETURNS [SpacePair] ~ {
hr: HashRelation ~ NARROW[br.data];
RETURN [hr.spaces];
};
Start:
PROC ~ {
FOR lr: Ability
IN Ability
DO
FOR rl: Ability
IN Ability
DO
classes[lr][rl][variable] ← CreateClass[[
Primitive: HasherPrimitive,
HasPair: HasherHasPair,
Apply: HasherApply,
ScanRestriction: HasherScanRestriction,
RestrictionSize: HasherRestrictionSize,
Copy: HasherCopy,
Insulate: HasherInsulate,
Freeze: HasherFreeze,
Thaw: HasherThaw,
AddPair: HasherAddPair,
RemPair: HasherRemPair,
DeleteSet: HasherDeleteSet,
Spaces: HasherSpaces,
functional: [lr=map, rl=map],
mutability: variable]];
classes[lr][rl][readonly] ← CreateClass[[
Primitive: HasherPrimitive,
HasPair: HasherHasPair,
Apply: HasherApply,
ScanRestriction: HasherScanRestriction,
RestrictionSize: HasherRestrictionSize,
Copy: HasherCopy,
Spaces: HasherSpaces,
functional: [lr=map, rl=map],
mutability: readonly]];
classes[lr][rl][constant] ← CreateClass[[
Primitive: HasherPrimitive,
HasPair: HasherHasPair,
Apply: HasherApply,
ScanRestriction: HasherScanRestriction,
RestrictionSize: HasherRestrictionSize,
Copy: HasherCopy,
Spaces: HasherSpaces,
functional: [lr=map, rl=map],
mutability: constant,
data: $Frigid]];
ENDLOOP ENDLOOP;
};
Start[];
END.