DIRECTORY AbSets, IntStuff, SetBasics;

SetByHash: CEDAR MONITOR
LOCKS ht USING ht: HashTable
IMPORTS AbSets, IntStuff, SetBasics
EXPORTS AbSets
=

BEGIN OPEN SetBasics, Sets:AbSets, Sets, IS:IntStuff;

HashTable: TYPE ~ REF HashTablePrivate;
HashTablePrivate: PUBLIC TYPE ~ MONITORED RECORD [
space: Space,
size, sizeLimit, inhibitCount, frozenScans, freezeCount: INT _ 0,
seq: REF Seq
];

SeqIndex: TYPE = NAT;
Seq: TYPE = RECORD [nodes: SEQUENCE max: SeqIndex OF Node];
Node: TYPE ~ LOV;

Classes: TYPE ~ ARRAY Mutability OF SetClass;
classes: REF Classes ~ NEW [Classes];

frozenClass: SetClass ~ CreateClass[[
HasMember: HasMemByUpdate,
Scan: HashScan,
Size: HashSize,
Copy: HashCopy,
Insulate: HashInsulate,
ValueOf: HashValueOf,
Freeze: HashFreeze,
Thaw: HashThaw,
SpaceOf: HashSpaceOf,
mutability: constant,
data: $Frigid]];

ComputeIndex: PROC [ht: HashTable, key: Value] RETURNS [SeqIndex] = INLINE {
RETURN [ht.space.SHash[key] MOD ht.seq.max];
};

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]};

CreateHashSetFromProc: PUBLIC PROC [Produce: PROC [Consume: PROC [Value]], space: Space _ refs] RETURNS [HashSet] ~ {
set: HashSet ~ CreateHashSet[space];
Consume: PROC [val: Value] ~ {[] _ set.AddElt[val]; RETURN};
Produce[Consume];
RETURN [set]};

CreateHashSet: PUBLIC PROC [space: Space _ refs] RETURNS [HashSet] ~ {
ht: HashTable ~ NEW [HashTablePrivate _ [
space: space,
sizeLimit: initSize,
seq: NEW [Seq[initSize]]
]];
RETURN AsVar[[classes[variable], AV[ht]]]};

IsHash: PUBLIC PROC [set: Set] RETURNS [BOOL]
~ {RETURN [set.class.HasMember = classes[variable].HasMember]};

HasMemByUpdate: PROC [set: Set, elt: Value] RETURNS [BOOL] ~ {
ht: HashTable ~ NARROW[set.data.VA];
had: BOOL _ FALSE;
TestHas: PROC [has: BOOL] RETURNS [BOOL] ~ {RETURN [had _ has]};
HashUpdate[set, ht, elt, TestHas];
RETURN [had]};

HashScan: PROC [set: Set, Test: Tester, ro: RelOrder] RETURNS [mv: MaybeValue _ noMaybe] = {
ht: HashTable ~ NARROW[set.data.VA];
Inhibit: ENTRY PROC [ht: HashTable] ~ {
ENABLE UNWIND => NULL;
IF set.class.data=$Frigid AND ht.freezeCount=0 THEN RETURN WITH ERROR Error[unfrozen, LIST[AV[set.Refify]]];
ht.inhibitCount _ ht.inhibitCount + 1;
IF set.class=frozenClass THEN ht.frozenScans _ ht.frozenScans + 1;
};
Release: ENTRY PROC [ht: HashTable] ~ {
ENABLE UNWIND => NULL;
ht.inhibitCount _ ht.inhibitCount - 1;
IF set.class=frozenClass THEN ht.frozenScans _ ht.frozenScans - 1;
IF ht.inhibitCount#0 THEN RETURN;
WHILE ht.size > ht.sizeLimit DO ReHash[ht] ENDLOOP;
};
IF ro#no THEN RETURN DefaultScan[set, Test, ro];
Inhibit[ht];
{ENABLE UNWIND => Release[ht];
node: Node _ NIL;
index: CARDINAL _ 0;
DO
[node, index] _ GetNext[ht, node, index];
IF node = NIL THEN EXIT;
IF Test[node.first] THEN {mv _ [TRUE, node.first]; EXIT};
ENDLOOP;
};
Release[ht];
RETURN};

GetNext: ENTRY PROC [ht: HashTable, node: Node, index: CARDINAL] RETURNS [Node, CARDINAL] = {
ENABLE UNWIND => NULL;
IF node=NIL THEN index _ ht.seq.max
ELSE IF node.rest#NIL THEN RETURN [node.rest, index];
{seq: REF Seq ~ ht.seq;
WHILE index > 0 DO
index _ index - 1;
node _ seq[index];
IF node#NIL THEN RETURN [node, index];
ENDLOOP;
RETURN [NIL, 0]}};

HashSize: PROC [set: Set, limit: EINT] RETURNS [EINT] = {
ht: HashTable ~ NARROW[set.data.VA];
EasySize: ENTRY PROC [ht: HashTable] RETURNS [EINT] ~ {
ENABLE UNWIND => NULL;
IF set.class.data=$Frigid AND ht.freezeCount=0 THEN RETURN WITH ERROR Error[unfrozen, LIST[AV[set.Refify]]];
RETURN IS.IE[ht.size]};
RETURN EasySize[ht]};

LockedCopy: ENTRY PROC [set: Set, ht: HashTable] RETURNS [new: HashTable] ~ {
ENABLE UNWIND => NULL;
IF set.class.data=$Frigid AND ht.freezeCount=0 THEN RETURN WITH ERROR Error[unfrozen, LIST[AV[set.Refify]]];
{oldSeq: REF Seq ~ ht.seq;
newSeq: REF Seq ~ NEW [Seq[oldSeq.max]];
new _ NEW [HashTablePrivate _ ht^];
new.seq _ newSeq;
FOR i: SeqIndex IN [0 .. oldSeq.max) DO
start: Node ~ oldSeq[i];
IF start#NIL THEN {
tail: Node _ newSeq[i] _ LIST[start.first];
FOR from: Node _ start.rest, from.rest WHILE from#NIL DO
this: Node ~ LIST[from.first];
tail _ tail.rest _ this;
ENDLOOP;
tail _ tail;
};
ENDLOOP;
new.inhibitCount _ new.freezeCount _ 0;
RETURN}};

HashCopy: PROC [set: Set] RETURNS [VarSet] ~ {
old: HashTable ~ NARROW[set.data.VA];
RETURN AsVar[[classes[variable], AV[LockedCopy[set, old]]]]};

HashInsulate: PROC [set: Set] RETURNS [UWSet] ~ {
old: HashTable ~ NARROW[set.data.VA];
RETURN AsUW[[classes[readonly], AV[old]]]};

HashValueOf: PROC [set: Set] RETURNS [ConstSet] ~ {
old: HashTable ~ NARROW[set.data.VA];
RETURN AsConst[[classes[constant], AV[LockedCopy[set, old]]]]};

HashFreeze: PROC [set: Set] RETURNS [ConstSet] ~ {
ht: HashTable ~ NARROW[set.data.VA];
LockedFreeze: ENTRY PROC [ht: HashTable] ~ {
ENABLE UNWIND => NULL;
ht.freezeCount _ ht.freezeCount + 1;
RETURN};
LockedFreeze[ht];
RETURN AsConst[[frozenClass, AV[ht]]]};

HashThaw: PROC [set: Set] ~ {
ht: HashTable ~ NARROW[set.data.VA];
LockedThaw: ENTRY PROC [ht: HashTable] ~ {
ENABLE UNWIND => NULL;
IF ht.freezeCount=0 THEN RETURN WITH ERROR Error[unfrozen, LIST[AV[set.Refify]]];
ht.freezeCount _ ht.freezeCount-1;
IF ht.freezeCount=0 AND ht.frozenScans>0 THEN RETURN WITH ERROR Error[unfrozen, LIST[AV[set.Refify]]];
RETURN};
LockedThaw[ht];
RETURN};

UpdateDecider: TYPE ~ PROC [BOOL] RETURNS [BOOL];

HashUpdate: ENTRY PROC [set: Set, ht: HashTable, val: Value, Decide: UpdateDecider] ~ {
ENABLE UNWIND => NULL;
index: SeqIndex ~ ComputeIndex[ht, val];
prev: Node _ NIL;
IF set.class.data=$Frigid AND ht.freezeCount=0 THEN RETURN WITH ERROR Error[unfrozen, LIST[AV[set.Refify]]];
FOR node: Node _ ht.seq[index], node.rest WHILE node # NIL DO
IF ht.space.SEqual[val, node.first] THEN {
have: BOOL ~ Decide[TRUE];
IF have THEN NULL
ELSE IF ht.freezeCount#0 THEN RETURN WITH ERROR Error[frozen, LIST[AV[set.Refify]]]
ELSE {
IF prev=NIL THEN ht.seq[index] _ node.rest ELSE prev.rest _ node.rest;
ht.size _ ht.size - 1;
};
RETURN;
};
prev _ node;
ENDLOOP;
{have: BOOL ~ Decide[FALSE];
IF have THEN {
IF ht.freezeCount#0 THEN RETURN WITH ERROR Error[frozen, LIST[AV[set.Refify]]];
ht.seq[index] _ CONS[val, ht.seq[index]];
IF (ht.size _ ht.size + 1) > ht.sizeLimit AND ht.inhibitCount = 0 THEN ReHash[ht];
};
RETURN}};

AddSetByUpdate: PROC [set, other: Set] RETURNS [new: SomeAll _ []] ~ {
ht: HashTable ~ NARROW[set.data.VA];
AddElt: PROC [elt: Value] ~ {
DecideToAdd: PROC [has: BOOL] RETURNS [BOOL] ~ {
IF has THEN new.all _ FALSE ELSE new.some _ TRUE;
RETURN [TRUE]};
HashUpdate[set, ht, elt, DecideToAdd];
RETURN};
IF set.MutabilityOf[]#variable THEN set.Complain[notVariable];
other.Enumerate[AddElt];
RETURN};

RemSetByUpdate: PROC [set, other: Set] RETURNS [had: SomeAll _ []] ~ {
ht: HashTable ~ NARROW[set.data.VA];
RemElt: PROC [elt: Value] ~ {
DecideToRem: PROC [has: BOOL] RETURNS [BOOL] ~ {
IF has THEN had.some _ TRUE ELSE had.all _ FALSE;
RETURN [FALSE]};
HashUpdate[set, ht, elt, DecideToRem];
RETURN};
IF set.MutabilityOf[]#variable THEN set.Complain[notVariable];
IF other=set THEN RETURN Clear[set, ht];
other.Enumerate[RemElt];
RETURN};

Clear: ENTRY PROC [set: Set, ht: HashTable] RETURNS [SomeAll] ~ {
ENABLE UNWIND => NULL;
seq: REF Seq ~ ht.seq;
IF ht.freezeCount#0 THEN RETURN WITH ERROR Error[frozen, LIST[AV[set.Refify]]];
IF ht.size=0 THEN RETURN [[some: FALSE, all: TRUE]];
ht.size _ 0;
FOR i: SeqIndex IN [0 .. seq.max) DO seq[i] _ NIL ENDLOOP;
RETURN [[some: TRUE, all: TRUE]]};

HashSpaceOf: PROC [set: Set] RETURNS [Space] ~ {
ht: HashTable ~ NARROW[set.data.VA];
RETURN [ht.space]};

ReHash: INTERNAL PROC [ht: HashTable] ~ {
oldSeq: REF Seq = ht.seq;
newSeq: REF Seq;
seek: CARDINAL = oldSeq.max * 2;
newPTI: CARDINAL _ 0;
newMod: CARDINAL _ highPrime;
IF seek >= highPrime
THEN newPTI _ PrimeTableSize-1
ELSE DO
newMod _ primeTable[newPTI];
IF newMod >= seek THEN EXIT;
newPTI _ newPTI+1;
ENDLOOP;
IF newMod = oldSeq.max THEN {ht.sizeLimit _ LAST[INT]; RETURN};
ht.sizeLimit _ newMod;
ht.seq _ newSeq _ NEW [Seq[newMod]];
FOR i: SeqIndex IN [0 .. oldSeq.max) DO
next: Node _ NIL;
FOR cur: Node _ oldSeq[i], next WHILE cur # NIL DO
index: SeqIndex _ ComputeIndex[ht, cur.first];
next _ cur.rest;
cur.rest _ newSeq[index];
newSeq[index] _ cur;
ENDLOOP;
IF next # NIL THEN ERROR;
ENDLOOP;
RETURN};

PrimeTableSize: NAT = 14;
highPrime: CARDINAL[0..LAST[SeqIndex]] = 32749;
initSize: NAT ~ 5;
primeTable: ARRAY [0 .. PrimeTableSize) OF CARDINAL = [
00002,  00005,  00011,  00023,  00053,  00113,  00251,  00509,  01019,  02039,  04079,  08179,  16369,  highPrime];

Start: PROC ~ {
FOR mut: Mutability IN Mutability DO
classes[mut] _ CreateClass[[
HasMember: HasMemByUpdate,
Scan: HashScan,
Size: HashSize,
Copy: HashCopy,
Insulate: IF mut=variable THEN HashInsulate ELSE NIL,
ValueOf: IF mut#constant THEN HashValueOf ELSE NIL,
Freeze: IF mut=variable THEN HashFreeze ELSE NIL,
Thaw: IF mut=variable THEN HashThaw ELSE NIL,
AddSet: AddSetByUpdate,
RemSet: RemSetByUpdate,
SpaceOf: HashSpaceOf,
mutability: mut]];
ENDLOOP;
RETURN};

Start[];

END.
ZSetByHash.Mesa
Last tweaked by Mike Spreitzer on February 27, 1988 12:36:04 pm PST
Κ‚–

"cedar" style˜
code™Kš
œC™C—K˜KšΟk	œ˜&K˜šΟn	œœ
˜Kšœœ˜Kšœ˜#Kšœ˜K˜
—K˜Kšœ
œžœœ
˜5K˜Kšœœœ˜'š	œœ
œ	œ
œ˜2K˜
Kšœ9œ˜AKšœœ˜Kš
œ˜—K˜Kšœ
œœ
˜Kš	œœœ	œœ˜;Kšœœœ
˜K˜Kšœ	œœœ
˜-Kšœ	œœ˜%K˜š
œ%˜%Kšž	œ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ
˜Kšžœ˜Kšžœ˜Kš
œ˜Kš
œ˜—K˜šžœœœœ˜LKšœœ
˜,K˜—K˜šžœœ
œΟc4œœ˜„
Kš	œœœ
œœ˜JK˜Kšœ	˜—K˜šžœœ
œžœœžœœ œ˜uKš
œ$˜$Kšžœœ'œ˜<K˜Kšœ˜—K˜šž
œœ
œœ˜Fšœœ˜)Kš
œ
˜
K˜Kšœœ˜K˜—Kšœœ˜+—K˜š
žœœ
œœœ
˜-Kšœœ6˜?—K˜šžœœœœ˜>Kšœœ
œ˜$Kšœœœ
˜Kšžœœœœœœ˜@Kš
œ"˜"Kšœ˜—K˜šžœœžœœ˜\Kšœœ
œ˜$šžœœ
œ˜'Kšœ
œœ
˜Kšœœœ
œ
œ
œœ
œ˜lKš
œ&˜&Kšœœ%˜BK˜—šžœœ
œ˜'Kšœ
œœ
˜Kš
œ&˜&Kšœœ%˜BKšœœ
œ
˜!Kšœœœ
˜3K˜—Kšœœ
œ˜0š
œ˜Kšœ
œ
œ˜Kšœ
œ
˜Kšœœ˜š
˜Kš
œ)˜)Kšœœ
œ
œ
˜Kšœœœœ˜9Kšœ
˜—K˜—Kš
œ˜Kšœ˜—K˜šžœœ
œ$œœœ˜]Kšœ
œœ
˜Kšœœ
œ˜#Kš
œ
œœ
œ
œ˜5Kšœœ˜šœ˜Kš
œ˜Kš
œ˜Kšœœ
œ
œ˜&Kšœ
˜—Kšœœ˜—K˜š
žœœœœœ˜9Kšœœ
œ˜$š
žœœ
œœœ˜7Kšœ
œœ
˜Kšœœœ
œ
œ
œœ
œ˜lKšœ
œ
œ˜—Kšœ˜—K˜šž
œœ
œœ˜MKšœ
œœ
˜Kšœœœ
œ
œ
œœ
œ˜lKšœ	œ˜Kšœœœ˜(Kšœœ˜#Kš
œ˜šœ
œ˜'K˜šœœ
œ˜Kšœœ˜+šœ$œœ
˜8Kšœ
œ
˜Kš
œ˜Kšœ
˜—K˜K˜—Kšœ
˜—Kš
œ'˜'Kšœ˜	—K˜šžœœœ
˜.Kšœœ
œ˜%Kšœœ˜=—K˜šžœœœ˜1Kšœœ
œ˜%Kšœœ	˜+—K˜šžœœœ˜3Kšœœ
œ˜%Kšœœ˜?—K˜šž
œœœ˜2Kšœœ
œ˜$šžœœ
œ˜,Kšœ
œœ
˜K˜$Kšœ˜—K˜Kšœœ˜'—K˜šžœœ˜Kšœœ
œ˜$šž
œœ
œ˜*Kšœ
œœ
˜Kšœœ
œ
œ
œœ
œ˜QKš
œ"˜"Kšœœœ
œ
œ
œœ
œ˜fKšœ˜—K˜Kšœ˜—K˜Kšœœœœœœ˜1K˜šž
œœ
œ'žœ˜WKšœ
œœ
˜Kš
œ(˜(Kšœ
œ
˜Kšœœœ
œ
œ
œœ
œ˜lšœ'œœ
˜=šœ"œ˜*Kšœœ
œ˜Kšœœ
˜Kšœ
œœ
œ
œ
œœ
œ˜Sšœ˜Kšœœ
œœ˜FK˜K˜—Kšœ
˜K˜—K˜Kšœ
˜—Kšœœ
œ˜šœœ˜Kšœœ
œ
œ
œœ
œ˜OKšœœ˜)Kšœ(œœ˜RK˜—Kšœ˜	—K˜šžœœœ˜FKšœœ
œ˜$šžœœ˜š
žœœœœœ˜0Kš
œœœ
œœ
˜1Kšœœ˜—Kš
œ&˜&Kšœ˜—Kšœœ˜>K˜Kšœ˜—K˜šžœœœ˜FKšœœ
œ˜$šžœœ˜š
žœœœœœ˜0Kš
œœœ
œœ
˜1Kšœœ˜—Kš
œ&˜&Kšœ˜—Kšœœ˜>Kšœœ
œ˜(Kš
œ˜Kšœ˜—K˜šžœœ
œœ˜AKšœ
œœ
˜Kšœœ˜Kšœœ
œ
œ
œœ
œ˜OKš
œœ
œ	œœ˜4K˜Kš
œ
œœ
œ
œ
˜:Kšœ	œœ˜"—K˜šžœœœ˜0Kšœœ
œ˜$Kšœ
˜—K˜šžœœ
œ˜)Kšœœ˜Kšœœ˜Kšœœ˜ Kšœœ˜Kšœœ
˜šœ˜Kšœ˜šœ
˜Kš
œ˜Kšœœ
œ
˜Kš
œ˜Kšœ
˜——Kš
œœœ
œœ˜?K˜Kšœœ˜$šœ
œ˜'Kšœ
œ
˜šœœœ
˜2Kš
œ.˜.K˜Kš
œ˜Kš
œ˜Kšœ
˜—Kšœœ
œ
œ
˜Kšœ
˜—Kšœ˜—K˜šžœœ˜Kšœœœ˜/Kšœ
œ˜—šœœœ
œ˜7Kš
œs˜s—K˜šžœœ˜šœœ˜$˜Kšž	œ˜Kšžœ˜Kšžœ˜Kšžœ˜Kš
žœœœœ
œ
˜5Kš
žœœœ
œ
œ
˜3Kš
žœœœœ
œ
˜1Kš
žœœœ
œ
œ
˜-Kšžœ˜Kšžœ˜Kšžœ˜K˜—Kšœ
˜—Kšœ˜—K˜K˜K˜Kšœ
˜—…—#Ό2˜