-- RightFeaturePQImpl.mesa

-- A generic package to organize items
-- in a priority queue, sorted by increasing order of
-- Val.

-- last modified by E. McCreight, August 3, 1982  11:03 AM
-- written by E. McCreight, February 8, 1982  2:04 PM

DIRECTORY
  InlineDefs,
  RightFeaturePQ;

RightFeaturePQImpl: PROGRAM
  IMPORTS InlineDefs, RightFeaturePQ
  EXPORTS RightFeaturePQ SHARES RightFeaturePQ =
  BEGIN OPEN RightFeaturePQ;

  RightFeaturePQUnderflow: PUBLIC SIGNAL = CODE;


  NewRightFeaturePQ: PUBLIC PROCEDURE[zone: UNCOUNTED ZONE,
    max: CARDINAL ← 50]
    RETURNS[PQHandle] =
    {RETURN[zone.NEW[PQObject ← [zone: zone, size: 0,
      s: zone.NEW[PQSeq[max]]]]]};


  DestroyRightFeaturePQ: PUBLIC PROCEDURE[p: PQHandle]
    RETURNS[PQHandle] =
    BEGIN
    zone: UNCOUNTED ZONE ← p.zone;
    zone.FREE[@p.s];
    zone.FREE[@p];
    RETURN[NIL];
    END; -- of DestroyRightFeaturePQ


  InsertRightFeaturePQ: PUBLIC PROCEDURE[p: PQHandle, item: Item] =
    BEGIN
    i, j: CARDINAL;
    pqs: PQSeqPtr ← GrowingPQ[p];
    p.size ← p.size+1;
    FOR j ← p.size-1, i WHILE j>0 DO
      i ← (j-1)/2;
      IF NOT ValLess[item, pqs.heap[i]] THEN EXIT
      ELSE pqs.heap[j] ← pqs.heap[i];
      ENDLOOP;
    pqs.heap[j] ← item;
    END;

  ExtractRightFeaturePQ: PUBLIC PROCEDURE[p: PQHandle]
    RETURNS[item: Item] =
    BEGIN
    pqs: PQSeqPtr ← ShrinkingPQ[p];
    result: Item ← pqs.heap[0];
    IF (p.size ← p.size-1)>0 THEN
      BEGIN
      i, j: CARDINAL;
      r: CARDINAL ← p.size-1; -- max index
      item: Item ← pqs.heap[p.size];
      FOR i ← 0, j  DO
        j ← i+i+1;
        IF j>r THEN EXIT;
        IF j<r AND ValLess[pqs.heap[j+1], pqs.heap[j]] THEN j ← j+1;
        IF NOT ValLess[pqs.heap[j], item] THEN EXIT
        ELSE pqs.heap[i] ← pqs.heap[j];
        ENDLOOP;
      pqs.heap[i] ← item;
      END;
    RETURN[result];
    END;


  MapEqualRightFeaturePQ: PUBLIC PROCEDURE[p: PQHandle,
    proc: PROCEDURE[item: Item]] =
    BEGIN
    pqs: PQSeqPtr ← p.s;
    stack: ARRAY[1..20) OF CARDINAL;
    stackTop: [0..20) ← 1;
    stack[stackTop] ← 0;
    WHILE 0<stackTop DO
      i: CARDINAL ← stack[stackTop];
      IF p.size<=i OR
        ValLess[pqs.heap[0], pqs.heap[i]] THEN
        stackTop ← stackTop-1
      ELSE
        BEGIN
        proc[pqs.heap[i]];
        stack[stackTop] ← i+i+1;
        stackTop ← stackTop+1;
        stack[stackTop] ← i+i+2;
        END;
      ENDLOOP;
    END; -- of MapEqualLeftFeaturePQ


  DeleteEqualRightFeaturePQ: PUBLIC PROCEDURE[p: PQHandle] =
    BEGIN
    pqs: PQSeqPtr ← p.s;
    original: Item ← pqs.heap[0];
    size: CARDINAL ← p.size;
    WHILE 0<size AND
      NOT ValLess[original, pqs.heap[0]] DO
      i, j: CARDINAL;
      r: CARDINAL ← (size ← size-1); -- max index
      item: Item ← pqs.heap[size];
      FOR i ← 0, j  DO
        j ← i+i+1;
        IF j>r THEN EXIT;
        IF j<r AND ValLess[pqs.heap[j+1], pqs.heap[j]] THEN j ← j+1;
        IF NOT ValLess[pqs.heap[j], item] THEN EXIT
        ELSE pqs.heap[i] ← pqs.heap[j];
        ENDLOOP;
      pqs.heap[i] ← item;
      ENDLOOP;
    p.size ← size+1;
    [] ← ShrinkingPQ[p];
    p.size ← size;
    END; -- of DeleteEqualRightFeaturePQ


GrowingPQ: PROCEDURE[p: PQHandle] RETURNS[PQSeqPtr] =
    BEGIN
    IF p.size>=p.s.max THEN
      BEGIN
      oldSeq: PQSeqPtr ← p.s;
      newSeq: PQSeqPtr ←
        p.zone.NEW[PQSeq[MAX[
          InlineDefs.LowHalf[(LONG[15]*p.size)/10], 50]]];
      FOR i: CARDINAL IN [0..p.size) DO
        newSeq[i] ← oldSeq[i];
        ENDLOOP;
      p.s ← newSeq;
      p.zone.FREE[@oldSeq];
      END;
    RETURN[p.s];
    END;


  ShrinkingPQ: PROCEDURE[p: PQHandle] RETURNS[PQSeqPtr] =
    BEGIN
    WHILE p.size<1 DO SIGNAL RightFeaturePQUnderflow ENDLOOP;
    IF MAX[p.size, 50]<p.s.max/2 THEN
      BEGIN
      oldSeq: PQSeqPtr ← p.s;
      newSeq: PQSeqPtr ←
        p.zone.NEW[PQSeq[MAX[
          InlineDefs.LowHalf[(LONG[15]*p.size)/10], 50]]];
      FOR i: CARDINAL IN [0..p.size) DO
        newSeq[i] ← oldSeq[i];
        ENDLOOP;
      p.s ← newSeq;
      p.zone.FREE[@oldSeq];
      END;
    RETURN[p.s];
    END;


  CheckPQ: PROCEDURE[p: PQHandle] = {NULL};
    -- or DoCheckPQ[p] for checking

  PQDisorder: SIGNAL = CODE;

  DoCheckPQ: PROCEDURE[p: PQHandle] =
    BEGIN
    size: CARDINAL ← p.size;
    pqs: PQSeqPtr ← p.s;
    FOR i: CARDINAL IN [0..size/2) DO
      IF ValLess[pqs[2*i+1], pqs[i]] OR
        ((2*i+2<size) AND ValLess[pqs[2*i+2], pqs[i]]) THEN
        SIGNAL PQDisorder;
      ENDLOOP;
    END;

  END. -- of RightFeaturePQImpl