
    <<HashCollectionsPrivateImpl.Mesa>>
        <<Last tweaked by Mike Spreitzer on September 21, 1987 11:41:06 am PDT>>

    DIRECTORY Basics, HashCollectionsPrivate, Collections, PrincOps, Rope;

    HashCollectionsPrivateImpl: CEDAR MONITOR LOCKS NARROW[coll.data, HashColl] USING coll: Collection
        IMPORTS Collections
        EXPORTS HashCollectionsPrivate
        =

    BEGIN OPEN HashCollectionsPrivate, Collections;

    classes: PUBLIC ARRAY Mutability OF CollectionClass ~ [
        variable: CreateClass[[
            HasMember: HasMember,
            Scan: Scan,
            Size: Size,
            Copy: Copy,
            Insulate: Insulate,
            Freeze: Freeze,
            Thaw: Thaw,
            AddColl: AddColl,
            RemoveColl: RemoveColl,
            SpaceOf: SpaceOf,
            mayDuplicate: FALSE,
            mutability: variable,
            data: NIL]],
        readonly: CreateClass[[
            HasMember: HasMember,
            Scan: Scan,
            Size: Size,
            Copy: Copy,
            SpaceOf: SpaceOf,
            mayDuplicate: FALSE,
            mutability: readonly,
            data: NIL]],
        constant: CreateClass[[
            HasMember: HasMember,
            Scan: Scan,
            Size: Size,
            Copy: Copy,
            SpaceOf: SpaceOf,
            mayDuplicate: FALSE,
            mutability: constant,
            data: $Frigid]]
        ];

    ComputeIndex: PROC [hc: HashColl, elt: Value] RETURNS [SeqIndex]
        ~ INLINE {RETURN [(IF hc.space.Hash=NIL THEN HashRefI[elt] ELSE hc.space.Hash[hc.space.data, elt]) MOD hc.elts.max];
        };

    Frigid: PROC [class: CollectionClass] RETURNS [BOOL]
        ~ INLINE {RETURN [class.data = $Frigid]};

    HasMember: ENTRY PROC [coll: Collection, elt: Value] RETURNS [BOOL] ~ {
        ENABLE UNWIND => NULL;
        hc: HashColl ~ NARROW[coll.data];
        frigid: BOOL ~ Frigid[coll.class];
        index: SeqIndex ~ ComputeIndex[hc, elt];
        IF frigid AND hc.freezeCount=0 THEN RETURN WITH ERROR Error[unfrozen, LIST[Refify[coll]]];
        FOR node: LOV _ hc.elts[index], node.rest WHILE node # NIL DO
            v: Value ~ node.first;
            IF hc.space.SpaceEqual[v, elt] THEN RETURN [TRUE];
            ENDLOOP;
        RETURN [FALSE];
        };

    Scan: PROC [coll: Collection, Test: Tester, bkwd: BOOL] RETURNS [mv: MaybeValue _ noMaybe] ~ {
        hc: HashColl ~ NARROW[coll.data];
        frigid: BOOL ~ Frigid[coll.class];
        Inhibit: ENTRY PROC [coll: Collection] ~ {
            ENABLE UNWIND => NULL;
            IF frigid AND hc.freezeCount=0 THEN RETURN WITH ERROR Error[unfrozen, LIST[Refify[coll]]];
            hc.inhibitCount _ hc.inhibitCount + 1;
            };
        Release: ENTRY PROC [coll: Collection] ~ {
            ENABLE UNWIND => NULL;
            hc.inhibitCount _ hc.inhibitCount - 1;
            IF hc.inhibitCount#0 THEN RETURN;
            WHILE hc.size > hc.sizeLimit DO ReHash[hc] ENDLOOP;
            };
        Enumerate: PROC ~ {
            node: LOV _ NIL;
            index: CARDINAL _ 0;
            DO
                [node, index] _ GetNext[coll, node, index];
                IF node = NIL THEN EXIT;
                IF Test[node.first].pass THEN {mv _ [TRUE, node.first]; RETURN};
                ENDLOOP;
            };
        IF bkwd THEN RETURN DefaultScan[coll, Test, bkwd];
        Inhibit[coll];
        Enumerate[! UNWIND => Release[coll]];
        Release[coll];
        RETURN};

    GetNext: ENTRY PROC [coll: Collection, node: LOV, index: CARDINAL] RETURNS [LOV, CARDINAL] = {
        ENABLE UNWIND => NULL;
        hc: HashColl ~ NARROW[coll.data];
        IF node = NIL
            THEN index _ hc.elts.max
            ELSE {
                node _ node.rest;
                IF node # NIL THEN RETURN [node, index];
                };
        WHILE index > 0 DO
            index _ index - 1;
            node _ hc.elts[index];
            IF node # NIL THEN RETURN [node, index];
            ENDLOOP;
        RETURN [NIL, 0];
        };

    Size: ENTRY PROC [coll: Collection, limit: LNAT _ LNAT.LAST] RETURNS [INT] = {
        ENABLE UNWIND => NULL;
        hc: HashColl ~ NARROW[coll.data];
        frigid: BOOL ~ Frigid[coll.class];
        IF frigid AND hc.freezeCount=0 THEN RETURN WITH ERROR Error[unfrozen, LIST[Refify[coll]]];
        RETURN [hc.size];
        };

    AddColl: PROC [coll, other: Collection, where: Where] RETURNS [someNew, allNew: BOOL] ~ {
        hc: HashColl ~ NARROW[coll.data];
        frigid: BOOL ~ Frigid[coll.class];
        EachEltAdd: PROC [elt: Value] ~ {Addit[coll, elt]};
        Addit: ENTRY PROC [coll: Collection, elt: Value] ~ {
            ENABLE UNWIND => NULL;
            index: SeqIndex ~ ComputeIndex[hc, elt];
            IF frigid AND hc.freezeCount=0 THEN RETURN WITH ERROR Error[unfrozen, LIST[Refify[coll]]];
            FOR node: LOV _ hc.elts[index], node.rest WHILE node # NIL DO
                v: Value ~ node.first;
                IF hc.space.SpaceEqual[v, elt] THEN {allNew _ FALSE; RETURN};
                ENDLOOP;
            hc.elts[index] _ CONS[elt, hc.elts[index]];
            IF (hc.size _ hc.size + 1) > hc.sizeLimit AND hc.inhibitCount = 0 THEN ReHash[hc];
            someNew _ TRUE;
            };
        someNew _ FALSE;
        allNew _ TRUE;
        IF hc.freezeCount#0 THEN coll.Complain[frozen];
        other.Enumerate[EachEltAdd];
        RETURN;
        };

    RemoveColl: PROC [coll, other: Collection, style: RemoveStyle] RETURNS [hadSome, hadAll: BOOL] ~ {
        hc: HashColl ~ NARROW[coll.data];
        frigid: BOOL ~ Frigid[coll.class];
        EachEltRem: PROC [elt: Value] ~ {Remit[coll, elt]};
        Remit: ENTRY PROC [coll: Collection, elt: Value] ~ {
            ENABLE UNWIND => NULL;
            index: SeqIndex ~ ComputeIndex[hc, elt];
            prev: LOV _ NIL;
            IF frigid AND hc.freezeCount=0 THEN RETURN WITH ERROR Error[unfrozen, LIST[Refify[coll]]];
            FOR node: LOV _ hc.elts[index], node.rest WHILE node # NIL DO
                v: Value ~ node.first;
                IF hc.space.SpaceEqual[v, elt] THEN {
                    hadSome _ TRUE;
                    IF prev=NIL THEN hc.elts[index] _ node.rest ELSE prev.rest _ node.rest;
                    hc.size _ hc.size-1;
                    RETURN};
                prev _ node;
                ENDLOOP;
            hadAll _ FALSE;
            };
        hadSome _ FALSE;
        hadAll _ TRUE;
        IF hc.freezeCount#0 THEN coll.Complain[frozen];
        other.Enumerate[EachEltRem];
        RETURN;
        };

    Copy: PROC [coll: Collection] RETURNS [copy: VarColl] ~ {
        copy _ CreateHashCopy[coll];
        };

    Insulate: PROC [coll: Collection] RETURNS [UWColl] ~ {
        hc: HashColl ~ NARROW[coll.data];
        RETURN [AsUW[[classes[readonly], coll.data]]];
        };

    Freeze: ENTRY PROC [coll: Collection] RETURNS [const: ConstColl] ~ {
        ENABLE UNWIND => NULL;
        hc: HashColl ~ NARROW[coll.data];
        IF coll.MutabilityOf # variable THEN RETURN WITH ERROR Error[notVariable, LIST[coll.Refify]];
        hc.freezeCount _ hc.freezeCount + 1;
        RETURN [AsConst[[classes[constant], coll.data]]];
        };

    Thaw: ENTRY PROC [coll: Collection] ~ {
        ENABLE UNWIND => NULL;
        hc: HashColl ~ NARROW[coll.data];
        IF coll.MutabilityOf # variable THEN RETURN WITH ERROR Error[notVariable, LIST[coll.Refify]];
        IF hc.freezeCount=0 THEN RETURN WITH ERROR Error["too many thaws", LIST[Refify[coll]]];
        hc.freezeCount _ hc.freezeCount - 1;
        };

    SpaceOf: ENTRY PROC [coll: Collection] RETURNS [Space] ~ {
        ENABLE UNWIND => NULL;
        hc: HashColl ~ NARROW[coll.data];
        frigid: BOOL ~ Frigid[coll.class];
        IF frigid AND hc.freezeCount=0 THEN RETURN WITH ERROR Error[unfrozen, LIST[Refify[coll]]];
        RETURN [hc.space];
        };

    ReHash: INTERNAL PROC [hc: HashColl] = {
        oldData: REF Seq = hc.elts;
        newData: REF Seq;
        seek: CARDINAL = hc.elts.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 = hc.elts.max THEN {hc.sizeLimit _ LAST[INT]; RETURN};
        hc.sizeLimit _ newMod;
        hc.elts _ newData _ NEW [Seq[newMod]];
        FOR i: SeqIndex IN [0 .. oldData.max) DO
            next: LOV _ NIL;
            FOR cur: LOV _ oldData[i], next WHILE cur # NIL DO
                index: SeqIndex _ ComputeIndex[hc, cur.first];
                next _ cur.rest;
                cur.rest _ newData[index];
                newData[index] _ cur;
                ENDLOOP;
            IF next # NIL THEN ERROR;
            ENDLOOP;
        };

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

    END.