Go to Procedure Interface

WITH Swap_Generic;
PROCEDURE Sort_Quick_Generic(List: IN OUT ListType) IS
------------------------------------------------------------------------
--| Body of generic Quicksort Procedure
--| Author: Michael B. Feldman, The George Washington University
--| Last Modified: January 1996
------------------------------------------------------------------------

  -- main procedure, which calls recursive procedure
  -- Quick to do the sorting.

  PROCEDURE Exchange IS NEW Swap_Generic (ValueType => ElementType);

  FUNCTION "<="(Left, Right: KeyType) RETURN Boolean IS
  BEGIN
    RETURN (Left < Right) OR (Left = Right);
  END "<=";

  PROCEDURE Partition (List : IN OUT ListType;
             PivIndex : OUT IndexType) IS
  -- Partitions the array slice List with bounds List'First and
  -- List'Last into two subarrays.
  -- Pre : List is defined and T'First <= T'Last.
  -- Post: PivIndex is defined such that all values less than or equal
  --    to List(PivIndex) have subscripts < PivIndex; all values
  --    greater than List(PivIndex) have subscripts > PivIndex.

    Pivot : ElementType;          -- the pivot value
    Up    : IndexType;          -- pointer to values > Pivot
    Down  : IndexType;          -- pointer to values <= Pivot

  BEGIN  -- Partition

    Pivot := List(List'First);    -- define leftmost element as the pivot

    -- Find and exchange values that are out of place.
    Up :=   List'First;     -- set Up to point to leftmost element
    Down := List'Last;           -- set Down to point to rightmost element

    LOOP
      -- Move Up to the next value larger than Pivot.
      WHILE (KeyOf(List(Up)) <= KeyOf(Pivot)) AND (Up < List'Last) LOOP
        Up := Up + 1;
      END LOOP;
      -- assertion:  List(Up) > Pivot or Up is equal to List'Last

      -- Move Down to the next value less than or equal to Pivot.
      WHILE (KeyOf(Pivot) < KeyOf(List(Down)))
        AND (Down > List'First) LOOP
        Down := Down - 1;
      END LOOP;
      -- assertion:  List(Down) <= Pivot

      -- Exchange out of order values.
      IF Up < Down THEN
        Exchange (List(Up), List(Down));
      END IF;

      EXIT WHEN Up >= Down;       -- until Up meets or passes Down
    END LOOP;
    -- Assertion: values <= Pivot have subscripts <= Down and
    --  values > Pivot have subscripts > Down

    -- Put pivot value where it belongs and define PivIndex.
    Exchange (List(List'First), List(Down));
    PivIndex := Down;

  END Partition;


  PROCEDURE Quick(List: IN OUT ListType) IS
  -- Recursive procedure to sort the array slice List with
  -- bounds List'First and List'Last.
  -- Pre : array List is defined and List'First <= List'Last
  -- Post: List is sorted.

    PivIndex : IndexType;        -- subscript of pivot value
                                 -- returned by Partition

  BEGIN -- Quick

    IF List'First < List'Last THEN
      -- Split into two subarrays separated by value at PivIndex
      Partition (List, PivIndex);
      -- sort the two subarrays
      IF PivIndex > List'First THEN
        Quick (List(List'First..PivIndex - 1));
      END IF;
      IF PivIndex < List'Last THEN
        Quick (List(PivIndex + 1..List'Last));
      END IF;
    END IF;

    Put(List);

  END Quick;

BEGIN -- Sort_Quick_Generic

  Quick(List => List);

END Sort_Quick_Generic;