(* Copyright (C) 1989, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* Last modified on Tue Oct 29 14:18:16 PST 1991 by muller         *)
(*      modified on Tue Jan 17 12:10:41 1989 by ellis          *)

MODULE IntTable;

IMPORT List, Word;

CONST 
    BitsPerWord = BITSIZE( Word.T );
    Multiplier  = -1664117991; 
        (* = LOOPHOLE( Round( .6125423371 * 2^32 ), INTEGER ) *)


TYPE 
Entry    = REF EntryRec;
EntryRec = RECORD
    nextEntry: Entry;
    key:       INTEGER;
    value:     REFANY;
    END;
Buckets = REF ARRAY OF Entry;

REVEAL
  T = BRANDED "IntTable v1.0" REF RECORD
    buckets:         Buckets;
    logSize:         CARDINAL;
    entries:         CARDINAL;
    nonEmptyBuckets: CARDINAL;
    maxChainLength:  CARDINAL;
    END;



PROCEDURE New(
    initialSize:    CARDINAL    := 64;
    maxChainLength: CARDINAL    := 2
    ): T RAISES {} =
VAR
    table:   T;
    s:       CARDINAL;
    logSize: CARDINAL := 0;
BEGIN
    IF initialSize > 2 THEN
      logSize := 1;
      s := 2;
      WHILE s <= initialSize DIV 2 DO
        s := s * 2;
        INC (logSize);
      END;
      initialSize := s;
    END;

    table := NEW (T);
    table^.buckets := NEW (Buckets, initialSize);

    table^.logSize         := logSize;
    table^.maxChainLength  := maxChainLength;
    table^.entries         := 0;
    table^.nonEmptyBuckets := 0;

    RETURN table;
    END New;
    

PROCEDURE Get( 
        table: T; 
        key:   INTEGER;
    VAR value: REFANY
    ): BOOLEAN RAISES {} =
VAR
    i:     CARDINAL;
    entry: Entry;
BEGIN
    i := Word.Shift ( key * Multiplier, 
                      - BitsPerWord + table^.logSize );

    entry := table^.buckets^[ i ];
    LOOP
        IF entry = NIL THEN EXIT; END;
        IF key < entry^.key THEN
            EXIT;
	ELSIF key = entry^.key THEN
	    value := entry^.value;
            RETURN TRUE;
        ELSE
            entry := entry^.nextEntry;
	    END;
	END;

    value := NIL;
    RETURN FALSE;
    END Get;		    	    
	        	    

PROCEDURE Put(
    table: T;
    key:   INTEGER;
    value: REFANY
    ): BOOLEAN RAISES {} =
VAR
    i:         CARDINAL;
    entry:     Entry;
    prevEntry: Entry;
    newEntry:  Entry;
BEGIN
    i := Word.Shift ( key * Multiplier, 
                       - BitsPerWord + table^.logSize );

    prevEntry := NIL;
    entry     := table^.buckets^[ i ];
    LOOP
        IF entry = NIL THEN EXIT; END;
        IF key < entry^.key THEN
            EXIT;
	ELSIF key = entry^.key THEN
	    entry^.value := value;
            RETURN TRUE;
        ELSE
            prevEntry := entry;
            entry     := entry^.nextEntry;
	    END;
	END;
    
    newEntry := NEW (Entry);
    newEntry^.key       := key;
    newEntry^.value     := value;
    newEntry^.nextEntry := entry;
    IF prevEntry = NIL THEN
        IF table^.buckets^[ i ] = NIL THEN
            table^.nonEmptyBuckets := table^.nonEmptyBuckets + 1;
	    END;
        table^.buckets^[ i ] := newEntry;
    ELSE
        prevEntry^.nextEntry := newEntry;
        END;

    table^.entries := table^.entries + 1;
    IF (table^.entries + table^.nonEmptyBuckets - 1) DIV table^.nonEmptyBuckets
       > table^.maxChainLength
    THEN
        Expand( table );
        END;

    RETURN FALSE;
    END Put;


PROCEDURE Expand( table: T ) =
  VAR
    oldBuckets:   Buckets;
    oldEntry:     Entry;
    nextOldEntry: Entry;
    entry:        Entry;
    prevEntry:    Entry;
    i:            CARDINAL;
  BEGIN
    oldBuckets            := table.buckets;
    table.buckets         := NEW (Buckets, 2 * NUMBER (oldBuckets^));
    table.logSize         := table.logSize + 1;
    table.nonEmptyBuckets := 0;
    
    FOR oldI := 0 TO LAST (oldBuckets^) DO
      oldEntry := oldBuckets [oldI];
      WHILE oldEntry # NIL DO
	nextOldEntry := oldEntry.nextEntry;

        i := Word.Shift (oldEntry.key * Multiplier, 
                           - BitsPerWord + table.logSize);
        
        prevEntry := NIL;
        entry     := table.buckets [i];
        LOOP
          IF entry = NIL THEN EXIT; END;
          IF oldEntry.key < entry.key THEN
            EXIT;
          ELSIF oldEntry.key = entry.key THEN
            <* ASSERT FALSE *> (* Duplicate key while expanding Table? *)
          ELSE
            prevEntry := entry;
            entry     := entry.nextEntry; END; END;
            
        oldEntry.nextEntry := entry;
        IF prevEntry = NIL THEN
          IF table.buckets [i] = NIL THEN
            INC (table.nonEmptyBuckets); END;
          table.buckets [i] := oldEntry;
        ELSE
          prevEntry.nextEntry := oldEntry; END;
	    
        oldEntry := nextOldEntry; END; END;
  END Expand;	
    
    
PROCEDURE Delete (table: T; key: INTEGER; VAR value: REFANY):
                 BOOLEAN RAISES {} =
  VAR
    i := Word.Shift (key * Multiplier, - BitsPerWord + table.logSize);
    entry: Entry := table.buckets [i];
    prevEntry: Entry := NIL;

  BEGIN
    LOOP
      IF entry = NIL THEN EXIT; END;
      IF key < entry.key THEN
        EXIT;
      ELSIF key = entry.key THEN
        value := entry.value;
        IF prevEntry = NIL THEN
          table.buckets [i] := entry.nextEntry;
	  IF entry.nextEntry = NIL THEN
            DEC (table.nonEmptyBuckets); END;
        ELSE
          prevEntry.nextEntry := entry.nextEntry; END;
        DEC (table.entries);
        RETURN TRUE;
      ELSE
        prevEntry := entry;
        entry     := entry.nextEntry; END; END;
    
    value := NIL;
    RETURN FALSE;

  END Delete;


PROCEDURE Clear( table: T ) RAISES {} =
BEGIN
  FOR i := 0 TO LAST (table^.buckets^ ) DO
    table^.buckets^[ i ] := NIL;
  END;
  table^.entries         := 0;
  table^.nonEmptyBuckets := 0;
END Clear;
    
    
PROCEDURE Copy( table: T ): T RAISES {} =
VAR
    newTable:  T;
    entry:     Entry;
    newEntry:  Entry;
    lastEntry: Entry;
BEGIN
     newTable  := NEW (T);    
    newTable^ := table^;

    newTable.buckets := NEW (Buckets, NUMBER( table^.buckets^ ) );
    FOR i := 0 TO LAST( table^.buckets^ ) DO
        entry     := table^.buckets^[ i ];
        lastEntry := NIL;
        WHILE entry # NIL DO
             newEntry  := NEW (Entry);
            newEntry^.key   := entry^.key;
            newEntry^.value := entry^.value;
            IF lastEntry = NIL THEN
                newTable^.buckets^[ i ] := newEntry;
            ELSE
                lastEntry^.nextEntry := newEntry;
                END;
            lastEntry := newEntry;
            entry     := entry^.nextEntry;
            END;
        END;        

    RETURN newTable;
    END Copy;


PROCEDURE Enumerate(
        table:   T;
        proc:    EnumerateProc;
        procArg: REFANY;
    VAR key:     INTEGER;
    VAR value:   REFANY
    ): BOOLEAN RAISES {} =
VAR
    entry: Entry;
BEGIN
    FOR i := 0 TO LAST ( table^.buckets^ ) DO
        entry := table^.buckets^[ i ];
	WHILE entry # NIL DO
            IF proc( procArg, entry^.key, entry^.value ) THEN
	        key   := entry^.key;
		value := entry^.value;
		RETURN TRUE;
		END;
	    entry := entry^.nextEntry;
	    END;
	END;
    RETURN FALSE;
    END Enumerate;

        
PROCEDURE ToValuesList( table: T ): List.T RAISES {} =
VAR
    entry: Entry;
    l:     List.T;
BEGIN
    l := NIL;
   FOR i := 0 TO LAST( table^.buckets^ ) DO
        entry := table^.buckets^[ i ];
	WHILE entry # NIL DO
            List.Push( l, entry^.value );
	    entry := entry^.nextEntry;
	    END;
	END;
    RETURN l;
    END ToValuesList;

     
    
PROCEDURE NewInteger (i: INTEGER): REF INTEGER =
  VAR
    r: REF INTEGER;
  BEGIN
    r := NEW (REF INTEGER);
    r^ := i;
    RETURN (r);
  END NewInteger;

PROCEDURE ToAssocList( table: T ): List.T RAISES {} =
VAR
    entry: Entry;
    l:     List.T;
BEGIN
    l := NIL;
    FOR i := 0 TO LAST( table^.buckets^ ) DO
        entry := table^.buckets^[ i ];
	WHILE entry # NIL DO
            	  
            List.Push (l, List.List2 (NewInteger (entry^.key ), 
                                      entry^.value ) );
	    entry := entry^.nextEntry;
	    END;
	END;
    RETURN l;
    END ToAssocList;

BEGIN    
END IntTable.