-- 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.