-- RightFeaturePQImpl.mesa

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

-- last modified by E. McCreight, September 28, 1984  10:12 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] =
    BEGIN
    p: PQHandle _ zone.NEW[PQObject _ [zone: zone]];
    p.s[0] _ zone.NEW[PQSeq[max]];
    RETURN[p];
    END;


  DestroyRightFeaturePQ: PUBLIC PROCEDURE[p: PQHandle]
    RETURNS[PQHandle] =
    BEGIN
    zone: UNCOUNTED ZONE _ p.zone;
    FOR i: [0..maxNSeqs) IN [0..p.topSeq) DO zone.FREE[@p.s[i]] ENDLOOP;
    zone.FREE[@p];
    RETURN[NIL];
    END; -- of DestroyRightFeaturePQ


  InsertRightFeaturePQ: PUBLIC PROCEDURE[p: PQHandle, item: Item] =
    BEGIN
    GrowingPQ[p];
    CheckPQ[p];
    p.size _ p.size+1;
    IF p.topSeq=0 THEN
      BEGIN
      pqs: PQSeqPtr _ p.s[0];
      i, j: CARDINAL;
      FOR j _ InlineDefs.LowHalf[p.size]-1, i WHILE j>0 DO
        i _ (j-1)/2;
        IF NOT ValLess[item, pqs[i]] THEN EXIT
        ELSE pqs[j] _ pqs[i];
        ENDLOOP;
      pqs[j] _ item;
      END
    ELSE
      BEGIN
      i, j: LONG INTEGER;
      FOR j _ p.size-1, i WHILE j>0 DO
        i _ (j-1)/2;
        IF NOT ValLess[item, GetItem[p, i]] THEN EXIT
        ELSE SetItem[p, j, GetItem[p, i]];
        ENDLOOP;
      SetItem[p, j, item];
      END;
    CheckPQ[p];
    END;

  ExtractRightFeaturePQ: PUBLIC PROCEDURE[p: PQHandle]
    RETURNS[item: Item] =
    BEGIN
    result: Item _ p.s[0][0];
    ShrinkingPQ[p];
    CheckPQ[p];
    IF (p.size _ p.size-1)>0 THEN
      BEGIN
      IF p.topSeq=0 THEN
        BEGIN
        pqs: PQSeqPtr _ p.s[0];
        i, j: CARDINAL;
        r: CARDINAL _ InlineDefs.LowHalf[p.size]-1; -- max index
        item: Item _ pqs[InlineDefs.LowHalf[p.size]];
        FOR i _ 0, j  DO
          j _ i+i+1;
          IF j>r THEN EXIT;
          IF j<r AND ValLess[pqs[j+1], pqs[j]] THEN j _ j+1;
          IF NOT ValLess[pqs[j], item] THEN EXIT
          ELSE pqs[i] _ pqs[j];
          ENDLOOP;
        pqs[i] _ item;
        END
      ELSE
        BEGIN
        i, j: LONG INTEGER;
        r: LONG INTEGER _ p.size-1; -- max index
        item: Item _ GetItem[p, p.size];
        FOR i _ 0, j  DO
          j _ i+i+1;
          IF j>r THEN EXIT;
          IF j<r AND ValLess[GetItem[p, j+1], GetItem[p, j]] THEN j _ j+1;
          IF NOT ValLess[GetItem[p, j], item] THEN EXIT
          ELSE SetItem[p, i, GetItem[p, j]];
          ENDLOOP;
        SetItem[p, i, item];
        END;
      END;
    CheckPQ[p];
    RETURN[result];
    END;


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


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


  GrowingPQ: PROCEDURE[p: PQHandle] =
    BEGIN
    IF p.size>=p.topSeq*maxItemsPerSeq+p.s[p.topSeq].max THEN
      BEGIN
      IF p.s[p.topSeq].max=maxItemsPerSeq THEN
        BEGIN -- new sequence
        p.topSeq _ p.topSeq+1;
        p.s[p.topSeq] _ p.zone.NEW[PQSeq[maxItemsPerSeq/2]];
        END
      ELSE
        BEGIN -- lengthen existing sequence
        oldSeq: PQSeqPtr _ p.s[p.topSeq];
        newSeq: PQSeqPtr _
          p.zone.NEW[PQSeq[(IF p.topSeq>0 THEN maxItemsPerSeq ELSE
            MIN[maxItemsPerSeq, MAX[50, 
              InlineDefs.LowHalf[(LONG[15]*p.size)/10]]])]];
        FOR i: CARDINAL IN [0..InlineDefs.LowHalf[p.size MOD maxItemsPerSeq]) DO
          newSeq[i] _ oldSeq[i];
          ENDLOOP;
        p.s[p.topSeq] _ newSeq;
        p.zone.FREE[@oldSeq];
        END;
      END;
    END;


  ShrinkingPQ: PROCEDURE[p: PQHandle] =
    BEGIN
    WHILE p.size<1 DO SIGNAL RightFeaturePQUnderflow ENDLOOP;
    IF p.topSeq>0 THEN
      BEGIN
      IF p.size < p.topSeq*maxItemsPerSeq-maxItemsPerSeq/2 THEN
        BEGIN -- get rid of entire top sequence
        END;
      END
    ELSE
      BEGIN
      IF MAX[p.size, 50]< p.s[0].max/2 THEN
        BEGIN -- shorten the (single) sequence
        oldSeq: PQSeqPtr _ p.s[0];
        newSeq: PQSeqPtr _
          p.zone.NEW[PQSeq[MAX[
            InlineDefs.LowHalf[(LONG[15]*p.size)/10], 50]]];
        FOR i: CARDINAL IN [0..InlineDefs.LowHalf[p.size]) DO
          newSeq[i] _ oldSeq[i];
          ENDLOOP;
        p.s[0] _ newSeq;
        p.zone.FREE[@oldSeq];
        END;
      END;
    END;


  GetItem: PROCEDURE [p: PQHandle, i: LONG INTEGER] RETURNS [item: Item] =
    BEGIN
    RETURN[p.s[InlineDefs.LowHalf[i/maxItemsPerSeq]][InlineDefs.LowHalf[i MOD maxItemsPerSeq]]];
    END;

  SetItem: PROCEDURE [p: PQHandle, i: LONG INTEGER, item: Item] =
    BEGIN
    p.s[InlineDefs.LowHalf[i/maxItemsPerSeq]][InlineDefs.LowHalf[i MOD maxItemsPerSeq]] _ item;
    END;


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

  PQDisorder: SIGNAL = CODE;

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

  END. -- of RightFeaturePQImpl