HeapImpl.mesa
Copyright Ó 1986, 1987, 1992 by Xerox Corporation. All rights reserved.
Greene, August 13, 1990 7:14 pm PDT
Russ Atkinson (RRA) September 23, 1986 2:43:30 pm PDT
Fiala May 11, 1987 3:10:21 pm PDT CompareINT => CompareInt.
DIRECTORY
Heap,
HeapPrivate USING [QueueBody, QueueRec],
Rope;
HeapImpl: CEDAR PROGRAM
EXPORTS Heap = BEGIN OPEN Heap, HeapPrivate;
Queue: TYPE = REF QueueRec;
QueueRec: PUBLIC TYPE = HeapPrivate.QueueRec;
Overflow: PUBLIC ERROR = CODE;
CreateQueue: PUBLIC PROC [compare: CompareEvents, conjectureSize: CARDINAL ¬ 64, reusable: Queue ¬ NIL] RETURNS [heap: Queue] ~ {
IF reusable # NIL THEN {
heap ¬ reusable;
heap.compare ¬ compare
}
ELSE {
heap ¬ NEW[QueueRec ¬ [compare: compare]];
heap.array ¬ NEW[QueueBody[PowerOf2[conjectureSize]]];
};
};
PowerOf2: PROC [in: CARDINAL] RETURNS [out: CARDINAL ¬ 64] ~ {
UNTIL out >= in DO
out ¬ out * 2;
ENDLOOP;
IF out > largestHeap THEN out ¬ largestHeap;
};
largestHeap: NAT = 10000000; --Was 32758 in the D-world
InsertEvent: PUBLIC PROC [heap: Queue, event: Event] ~ TRUSTED {
oldSize: CARDINAL = heap.size;
array: REF QueueBody ¬ heap.array;
pL: Event ¬ event;
pos: CARDINAL ¬ heap.size ¬ oldSize + 1;
IF oldSize = array.max THEN {
Must expand the array
newMax: NAT; new: REF QueueBody;
IF array.max = largestHeap THEN {heap.size ¬ oldSize; ERROR Overflow};
newMax ¬ IF array.max < largestHeap/2 THEN array.max*2 ELSE largestHeap;
new ¬ NEW[QueueBody[newMax]];
FOR i: CARDINAL IN [0..oldSize) DO new.data[i] ¬ array.data[i]; ENDLOOP;
heap.array ¬ array ¬ new;
};
Now bubble the event towards the "top" of the heap (decreasing indexes).
UNTIL pos = 1 DO
pH: Event ¬ array.data[pos/2 - 1];
IF heap.compare[pL, pH] = less THEN EXIT;
array.data[pos - 1] ¬ pH;
pos ¬ pos / 2;
ENDLOOP;
array.data[pos - 1] ¬ pL;
};
NextEvent: PUBLIC PROC [heap: Queue] RETURNS [event: Event ¬ NIL] ~ TRUSTED {
array: REF QueueBody ¬ heap.array;
size: CARDINAL = heap.size;
SELECT size FROM
0 =>
If empty, the convention is to return NIL.
RETURN [NIL];
1 => {
The one element case is dead easy.
event ¬ array.data[0];
heap.size ¬ 0;
};
2 => {
The two element case also requires no comparisons!
event ¬ array.data[0];
array.data[0] ¬ array.data[1];
heap.size ¬ 1;
};
ENDCASE => {
There are at least three elements. The
lower: CARDINAL ¬ 2;
pos: CARDINAL ¬ 1;
event ¬ array.data[0];
Now move the hole "down" in the heap (increasing indexes).
UNTIL lower >= size DO
eL: Event = array.data[lower-1];
eR: Event = array.data[lower];
IF heap.compare[eL, eR] # greater
THEN {
array.data[pos - 1] ¬ eR;
pos ¬ lower + 1;
}
ELSE {
array.data[pos - 1] ¬ eL;
pos ¬ lower;
};
lower ¬ pos*2;
ENDLOOP;
heap.size ¬ size - 1;
SELECT TRUE FROM
lower = size =>
array.data[pos - 1] ¬ array.data[lower - 1];
pos # size => {
Now bubble the event towards the "top" of the heap.
pL: Event ¬ array.data[size - 1];
UNTIL pos = 1 DO
pH: Event ¬ array.data[pos/2 - 1];
IF heap.compare[pL, pH] = less THEN EXIT;
array.data[pos - 1] ¬ pH;
pos ¬ pos / 2;
ENDLOOP;
array.data[pos - 1] ¬ pL;
};
ENDCASE;
};
};
PeekNextEvent: PUBLIC PROC [heap: Queue] RETURNS [event: Event] ~ {
RETURN [IF heap.size = 0 THEN NIL ELSE heap.array.data[0]];
};
Erase: PUBLIC PROC [heap: Queue] ~ {
heap.size ¬ 0;
};
Empty: PUBLIC PROC [heap: Queue] RETURNS [empty: BOOL ¬ FALSE] ~ {
RETURN [heap.size = 0];
};
GetSize: PUBLIC PROC [heap: Queue] RETURNS [CARDINAL] ~ {
RETURN [heap.size];
};
Testing routines
RefIntCompareProc: CompareEvents = {
r1: REF INT ← NARROW[e1];
r2: REF INT ← NARROW[e2];
RETURN [Basics.CompareInt[r1^, r2^]];
};
InsertInt: PROC [heap: Queue, int: INT] = {
ref: REF INT ← NEW[INT ← int];
InsertEvent[heap, ref];
};
q: Heap.Queue;
s: IO.STREAM;
i: INT;
IF testing THEN {
s ← FS.StreamOpen["HeapImpl.testlog", $create];
q ← CreateQueue[RefIntCompareProc];
IF NOT q.Empty[] THEN s.PutF["Created queue not empty.\n"];
InsertInt[q,1]; InsertInt[q,2]; InsertInt[q,3];
i ← q.GetSize[];
IF NOT i = 3 THEN s.PutF["Size reported was: %g\n", IO.int[i]];
i ← NARROW[q.PeekNextEvent[], REF INT]^;
IF NOT i = 3 THEN s.PutF["Peek was: %g\n", IO.int[i]];
i ← NARROW[q.NextEvent[], REF INT]^;
IF NOT i = 3 THEN s.PutF["First return was: %g\n", IO.int[i]];
InsertInt[q,4]; InsertInt[q,5];
i ← NARROW[q.NextEvent[], REF INT]^;
IF NOT i = 5 THEN s.PutF["Second return was: %g\n", IO.int[i]];
i ← NARROW[q.NextEvent[], REF INT]^;
IF NOT i = 4 THEN s.PutF["Third return was: %g\n", IO.int[i]];
i ← NARROW[q.NextEvent[], REF INT]^;
IF NOT i = 2 THEN s.PutF["Fourth return was: %g\n", IO.int[i]];
i ← NARROW[q.NextEvent[], REF INT]^;
IF NOT i = 1 THEN s.PutF["Fifth return was: %g\n", IO.int[i]];
FOR j: INT IN [1..100000] DO
InsertInt[q,j]
ENDLOOP;
FOR j: INT DECREASING IN [1..100000] DO
i ← NARROW[q.NextEvent[], REF INT]^;
IF NOT i=j THEN {s.PutF["Error i was: %g, j was: %g\n", IO.int[i], IO.int[j] ]; EXIT};
ENDLOOP;
s.Close[];
}
END.