-- Copyright (C) 1984  by Xerox Corporation. All rights reserved. 
-- HeapSorter.mesa, HGM,  9-Jul-84 23:28:04

DIRECTORY
  HeapSort USING [];

HeapSorter: PROGRAM EXPORTS HeapSort =
  BEGIN

  -- Knuth vol 3 section 5.2.3 algorithm H  (pg 146)

  Key: TYPE = UNSPECIFIED;

  Sort: PUBLIC PROCEDURE [
    base: LONG POINTER, length: CARDINAL,
    less: PROCEDURE [Key, Key] RETURNS [BOOLEAN]] =
    BEGIN
    array: LONG POINTER TO ARRAY OF Key ¬ base;
    i, j, l, r: CARDINAL;
    key: Key;
    IF length <= 1 THEN RETURN;
    l ¬ length/2;
    r ¬ length - 1;
    DO
      IF l > 0 THEN BEGIN l ¬ l - 1; key ¬ array[l]; END
      ELSE
        BEGIN
        key ¬ array[r];
        array[r] ¬ array[0];
        r ¬ r - 1;
        IF r = 0 THEN BEGIN array[0] ¬ key; EXIT; END;
        END;
      j ¬ l;
      DO
        i ¬ j;
        j ¬ j*2 + 1;
        IF j > r THEN EXIT;
        IF j < r AND less[array[j], array[j + 1]] THEN j ¬ j + 1;
        IF ~less[key, array[j]] THEN EXIT;
        array[i] ¬ array[j];
        ENDLOOP;
      array[i] ¬ key;
      ENDLOOP;
    END;

 
  LongKey: TYPE = LONG UNSPECIFIED;
 
  SortLong: PUBLIC PROCEDURE [
    base: LONG POINTER, length: CARDINAL,
    less: PROCEDURE [LongKey, LongKey] RETURNS [BOOLEAN]] =
    BEGIN
    array: LONG POINTER TO ARRAY OF LongKey ¬ base;
    i, j, l, r: CARDINAL;
    key: LongKey;
    IF length <= 1 THEN RETURN;
    l ¬ length/2;
    r ¬ length - 1;
    DO
      IF l > 0 THEN BEGIN l ¬ l - 1; key ¬ array[l]; END
      ELSE
        BEGIN
        key ¬ array[r];
        array[r] ¬ array[0];
        r ¬ r - 1;
        IF r = 0 THEN BEGIN array[0] ¬ key; EXIT; END;
        END;
      j ¬ l;
      DO
        i ¬ j;
        j ¬ j*2 + 1;
        IF j > r THEN EXIT;
        IF j < r AND less[array[j], array[j + 1]] THEN j ¬ j + 1;
        IF ~less[key, array[j]] THEN EXIT;
        array[i] ¬ array[j];
        ENDLOOP;
      array[i] ¬ key;
      ENDLOOP;
    END;

  END.