DIRECTORY HashTable, LichenSetTheory; LichenSetTheoryImpl: CEDAR PROGRAM IMPORTS HashTable EXPORTS LichenSetTheory = BEGIN OPEN LichenSetTheory; NotMutable: PUBLIC ERROR = CODE; CreateHashMapper: PUBLIC PROC [equal: HashTable.EqualProc _ NIL, hash: HashTable.HashProc _ NIL] RETURNS [m: Mapper] = { m _ NEW [MapperPrivate _ [class: hashMapperClass, data: HashTable.Create[equal: equal, hash: hash]]]}; CreateHashDictionary: PUBLIC PROC [caseSensitive: BOOL] RETURNS [m: Mapper] = { m _ NEW [MapperPrivate _ [ class: hashMapperClass, data: IF caseSensitive THEN HashTable.Create[equal: HashTable.RopeEqual, hash: HashTable.HashRope] ELSE HashTable.Create[equal: HashTable.RopeEqualModCase, hash: HashTable.HashRopeModCase] ]]}; hashMapperClass: MapperClass = NEW [MapperClassPrivate _ [ Map: MapByHash, SetMapping: SetHashMapping, Enumerate: EnumerateHashMapping, Size: HashMappingSize]]; MapByHash: PROC [m: Mapper, domain: REF ANY] RETURNS [range: REF ANY] = { ht: HashTable.Table = NARROW[m.data]; range _ ht.Fetch[domain].value}; SetHashMapping: PROC [m: Mapper, domain, range: REF ANY] RETURNS [hadMapping: BOOL] = { ht: HashTable.Table = NARROW[m.data]; SELECT range FROM =NIL => hadMapping _ ht.Delete[domain]; #NIL => hadMapping _ NOT ht.Store[domain, range]; ENDCASE => ERROR; }; EnumerateHashMapping: PROC [m: Mapper, Consume: PROC [domain, range: REF ANY]] = { ht: HashTable.Table = NARROW[m.data]; Pass: PROC [key, value: REF ANY] RETURNS [quit: BOOL _ FALSE] --HashTable.EachPairAction-- = {Consume[key, value]}; [] _ ht.Pairs[Pass]; }; HashMappingSize: PROC [m: Mapper] RETURNS [size: INT] = { ht: HashTable.Table = NARROW[m.data]; size _ ht.GetSize[]}; CreateSingleton: PUBLIC PROC [elt: REF ANY] RETURNS [set: Set] = { set _ NEW [SetPrivate _ [singletonClass, FALSE, elt]]; }; singletonClass: SetClass = NEW [SetClassPrivate _ [ TestSingletonMembership, DontUnionSingleton, DontUnionSet, DontRemoveElt, EnumerateSingleton, DontErase, SingletonSize]]; TestSingletonMembership: PROC [set: Set, elt: REF ANY] RETURNS [in: BOOL] = { in _ elt = set.data}; DontUnionSet: PUBLIC PROC [self, other: Set] = {ERROR}; DontRemoveElt: PUBLIC PROC [set: Set, elt: REF ANY] = {ERROR}; DontErase: PUBLIC PROC [set: Set] = {ERROR}; EnumerateSingleton: PROC [set: Set, Consumer: PROC [REF ANY]] = {Consumer[set.data]}; SingletonSize: PROC [set: Set] RETURNS [INT] = {RETURN[1]}; CreateHashSet: PUBLIC PROC [equal: HashTable.EqualProc _ NIL, hash: HashTable.HashProc _ NIL] RETURNS [set: Set] = { set _ NEW [SetPrivate _ [class: hashSetClass, data: HashTable.Create[equal: equal, hash: hash]]]}; hashSetClass: SetClass = NEW [SetClassPrivate _ [ TestHashSetMembership, HashSetUnionSingleton, HashSetUnionSet, RemoveHashSetElt, EnumerateHashSet, EraseHashSet, HashSetSize]]; TestHashSetMembership: PROC [set: Set, elt: REF ANY] RETURNS [b: BOOL] = { ht: HashTable.Table = NARROW[set.data]; b _ ht.Fetch[elt].found}; HashSetUnionSingleton: PROC [set: Set, elt: REF ANY] RETURNS [new: BOOL] = { ht: HashTable.Table = NARROW[set.data]; new _ ht.Store[elt, $T]; }; HashSetUnionSet: PROC [self, other: Set] = { ht: HashTable.Table = NARROW[self.data]; Addit: PROC [elt: REF ANY] = { [] _ ht.Insert[elt, $T]}; other.class.Enumerate[other, Addit]; }; RemoveHashSetElt: PROC [set: Set, elt: REF ANY] = { ht: HashTable.Table = NARROW[set.data]; IF NOT ht.Delete[elt] THEN ERROR; }; EnumerateHashSet: PROC [set: Set, Consumer: PROC [REF ANY]] = { ht: HashTable.Table = NARROW[set.data]; PerPair: PROC [key, value: REF ANY] RETURNS [quit: BOOL _ FALSE] --HashTable.EachPairAction-- = { Consumer[key]; }; [] _ ht.Pairs[PerPair]}; EraseHashSet: PROC [set: Set] = { ht: HashTable.Table = NARROW[set.data]; ht.Erase[]}; HashSetSize: PROC [set: Set] RETURNS [size: INT] = { ht: HashTable.Table = NARROW[set.data]; size _ ht.GetSize[]}; Unioned: TYPE = REF UnionedPrivate; UnionedPrivate: TYPE = RECORD [ incr, decr: SetList, --ordered by increasing size, decreasing size eltsImmutable: BOOL, size: INT _ notComputed ]; notComputed: INT = FIRST[INT]; unionSetClass: SetClass = NEW [SetClassPrivate _ [ TestUnionMembership, DontUnionSingleton, UnionUnionSet, DontRemoveElt, EnumerateUnion, DontErase, UnionSize]]; CreateUnion: PUBLIC PROC [sets: SetList, eltsImmutable: BOOL _ TRUE] RETURNS [set: Set] = { u: Unioned = NEW [UnionedPrivate _ [eltsImmutable: eltsImmutable]]; [u.incr, u.decr] _ SizeSort[sets]; set _ NEW [SetPrivate _ [ class: unionSetClass, data: u ]]; }; TestUnionMembership: PROC [set: Set, elt: REF ANY] RETURNS [in: BOOL] = { u: Unioned = NARROW[set.data]; FOR sets: SetList _ u.decr, sets.rest WHILE sets # NIL DO IF sets.first.class.TestMembership[sets.first, elt] THEN RETURN [TRUE]; ENDLOOP; in _ FALSE; }; DontUnionSingleton: PUBLIC PROC [set: Set, elt: REF ANY] RETURNS [new: BOOL] = { ERROR}; UnionUnionSet: PROC [self, other: Set] = { u: Unioned = NARROW[self.data]; [u.incr, u.decr] _ SizeInsert[u.incr, u.decr, other]; u.size _ notComputed; }; EnumerateUnion: PROC [set: Set, Consumer: PROC [REF ANY]] = { u: Unioned = NARROW[set.data]; IF u.incr = NIL THEN RETURN; u.incr.first.class.Enumerate[u.incr.first, Consumer]; EnumerateSetlistRestUnion[u.incr, Consumer]; }; EnumerateSetlistRestUnion: PROC [sets: SetList, Consumer: PROC [REF ANY]] = { FOR i: SetList _ sets.rest, i.rest WHILE i # NIL DO Filter: PROC [elt: REF ANY] = { FOR j: SetList _ sets, j.rest WHILE j # i DO IF j.first.class.TestMembership[j.first, elt] THEN RETURN; ENDLOOP; Consumer[elt]; }; i.first.class.Enumerate[i.first, Filter]; ENDLOOP; }; UnionSize: PROC [set: Set] RETURNS [size: INT] = { u: Unioned = NARROW[set.data]; CountIt: PROC [REF ANY] = {size _ size + 1}; IF u.size # notComputed THEN RETURN [u.size]; IF u.decr = NIL THEN RETURN [u.size _ 0]; size _ u.decr.first.class.Size[u.decr.first]; EnumerateSetlistRestUnion[u.decr, CountIt]; IF u.eltsImmutable THEN u.size _ size; }; SizeSort: PROC [sets: SetList] RETURNS [increasing, decreasing: SetList] = { increasing _ decreasing _ NIL; WHILE sets # NIL DO next: SetList = sets.rest; increasing _ IncrInsert[increasing, sets]; sets _ next; ENDLOOP; FOR sets _ increasing, sets.rest WHILE sets # NIL DO decreasing _ CONS[sets.first, decreasing]; ENDLOOP; }; SizeInsert: PROC [oIncr, oDecr: SetList, set: Set] RETURNS [nIncr, nDecr: SetList] = { nIncr _ IncrInsert[oIncr, LIST[set]]; nDecr _ DecrInsert[oDecr, LIST[set]]; }; IncrInsert: PROC [old, this: SetList] RETURNS [new: SetList] = { thisSize: INT = this.first.class.Size[this.first]; prev: SetList _ NIL; following: SetList _ new _ old; WHILE following # NIL AND thisSize > following.first.class.Size[following.first] DO prev _ following; following _ following.rest; ENDLOOP; this.rest _ following; IF prev = NIL THEN new _ this ELSE prev.rest _ this; }; DecrInsert: PROC [old, this: SetList] RETURNS [new: SetList] = { thisSize: INT = this.first.class.Size[this.first]; prev: SetList _ NIL; following: SetList _ new _ old; WHILE following # NIL AND thisSize <= following.first.class.Size[following.first] DO prev _ following; following _ following.rest; ENDLOOP; this.rest _ following; IF prev = NIL THEN new _ this ELSE prev.rest _ this; }; END. ˆLichenSetTheoryImpl.Mesa Last Edited by: Spreitzer, May 11, 1986 4:18:25 pm PDT Mike Spreitzer September 20, 1986 3:05:37 pm PDT Κ %˜™J™6Icode™0—J˜KšΟk œ˜%K˜šΠbxœœ˜"Kšœ ˜Kšœ˜K˜Kšœœ˜K˜Kšœ œœœ˜ K˜š Οnœœœœœœ˜xKšœœ_˜f—K˜š Ÿœœœœœ˜Ošœœ˜Kšœ˜KšœœœHœU˜ΌKšœ˜——K˜šœœ˜:KšŸœ ˜KšŸ œ˜KšŸ œ˜ KšŸœ˜—K˜šŸ œœœœœ œœ˜IKšœœ ˜%K˜ —K˜š Ÿœœœœœœ˜WKšœœ ˜%šœ˜Kšœœ#˜'Kšœœœ˜1Kšœœ˜—K˜—K˜š Ÿœœ Ÿœœœœ˜RKšœœ ˜%KšŸœœœœœœœΟcœ˜sK˜K˜—K˜šŸœœ œœ˜9Kšœœ ˜%Kšœ˜—K˜š Ÿœœœœœœ˜BKšœœ œ˜6K˜—K˜šœœ˜3K˜K˜K˜ Kšœ˜K˜Kšœ ˜ K˜—K˜š Ÿœœœœœœ˜MK˜—K˜KšŸ œœœœ˜7K˜Kš Ÿ œœœœœœ˜>K˜KšŸ œœœœ˜,K˜Kš Ÿœœ Ÿœœœœ˜UK˜Kš Ÿ œœ œœœ˜;K˜š Ÿ œœœœœœ˜tKšœœY˜b—K˜šœœ˜1K˜K˜K˜K˜K˜K˜ K˜—K˜š Ÿœœœœœœ˜JKšœœ ˜'K˜—K˜š Ÿœœœœœœ˜LKšœœ ˜'K˜K˜—K˜šŸœœ˜,Kšœœ ˜(šŸœœœœ˜Kšœ˜—K˜$K˜—K˜šŸœœœœ˜3Kšœœ ˜'Kšœœœœ˜!K˜—K˜š Ÿœœ Ÿœœœœ˜?Kšœœ ˜'•StartOfExpansionP -- [key: HashTable.Key, value: HashTable.Value] RETURNS [quit: BOOLEAN _ FALSE]šŸœœœœœœœ œ˜aK˜K˜—Kšœ˜—K˜šŸ œœ˜!Kšœœ ˜'K˜ —K˜šŸ œœ œœ˜4Kšœœ ˜'Kšœ˜—K˜Kšœ œœ˜#šœœœ˜Kšœ -˜BKšœœ˜Kšœœ˜K˜—K˜Kšœ œœœ˜K˜šœœ˜2K˜K˜K˜K˜K˜K˜ K˜ —K˜š Ÿ œœœ œœœ˜[Kšœ œ3˜CKšœ"˜"šœœ˜Kšœ˜Kšœ˜K˜—K˜—K˜š Ÿœœœœœœ˜IKšœ œ ˜šœ#œœ˜9Kšœ2œœœ˜GKšœ˜—Kšœœ˜ K˜—K˜šŸœœœœœœœ˜PKšœ˜—K˜šŸ œœ˜*Kšœ œ ˜K˜5K˜K˜—K˜š Ÿœœ Ÿœœœœ˜=Kšœ œ ˜Kšœ œœœ˜Kšœ5˜5Kšœ,˜,K˜—K˜š ŸœœŸœœœœ˜Mšœ œœ˜3šŸœœœœ˜šœœ˜,Kšœ,œœ˜:Kšœ˜—K˜K˜—Kšœ)˜)Kšœ˜—K˜—K˜šŸ œœ œœ˜2Kšœ œ ˜KšŸœœœœ˜,Kšœœœ ˜-Kšœ œœœ˜)Kšœ-˜-Kšœ+˜+Kšœœ˜&K˜—K˜šŸœœœ&˜LKšœœ˜šœœ˜Kšœ˜Kšœ*˜*K˜ Kšœ˜—šœœœ˜4Kšœ œ˜*Kšœ˜—K˜—K˜š Ÿ œœ#œΟgœ‘œ˜VKš‘œœ˜%Kš‘œœ˜%K˜—K˜šŸ œœœ˜@Kšœ œ%˜2Kšœœ˜Kšœ˜šœ œœ8˜SKšœ˜Kšœ˜Kšœ˜—K˜Kšœœœ œ˜4K˜—K˜šŸ œœœ˜@Kšœ œ%˜2Kšœœ˜Kšœ˜šœ œœ9˜TKšœ˜Kšœ˜Kšœ˜—K˜Kšœœœ œ˜4K˜—K˜Kšœ˜——…—&Α