-- Generic sorting package.

    GENERIC

       TYPE elem IS PRIVATE ; -- generic object
       TYPE vector IS ARRAY ( INTEGER RANGE <> ) OF elem ;
       WITH FUNCTION ">" ( left, right : elem ) RETURN BOOLEAN ;

    PACKAGE gensort IS

--    swap => swap two values of the generic type
       PROCEDURE swap ( first, second : IN OUT elem ) ;

--    quicksort => Sorts an array of generic objects ( quicksort )
       PROCEDURE quicksort ( v : IN OUT vector ) ;

    END gensort ; ------------------------------------------------------

-- gensort => Body of generic sorting package.
    PACKAGE BODY gensort IS

-- swap => Swap values of two generic objects.
    PROCEDURE swap ( first, second : IN OUT elem ) IS

-- Local Variables :

    save : elem ; -- saves value during swap

    BEGIN -- swap

    save   := first ;  -- save first value
    first  := second ; -- copy second into first
    second := save  ;  -- copy saved value into second

    END swap ; ---------------------------------------------------------

-- quicksort => Sort an array of generic objects using quicksort.
    PROCEDURE quicksort ( v : IN OUT vector ) IS

-- Local Variables :

    i : INTEGER := v'FIRST ;          -- first partition index
    j : INTEGER := v'LAST  ;          -- second partition index
    x : elem := v ( ( i + j ) / 2 ) ; -- object to be tested against

    BEGIN -- quicksort

    WHILE i <= j LOOP -- loop until partitioned

       WHILE x > v ( i ) LOOP -- find left-most element out of order
          i := i + 1 ;
       END LOOP ;

       WHILE v ( j ) > x LOOP -- find right-most element out of order
          j := j - 1 ;
       END LOOP ;

       IF i <= j THEN
          swap ( v ( i ), v ( j ) ) ; -- swap out of order elements
          i := i + 1 ;
          J := j - 1 ;
       END IF ;
    END LOOP ;

    IF v'FIRST < j THEN

--    recursive call on left partition
       quicksort ( v ( v'FIRST..j ) ) ;
    END IF ;

    IF i < v'LAST THEN

--    recursive call on right partition
       quicksort ( v ( i..v'LAST ) ) ;
    END IF ;

    END quicksort ; ----------------------------------------------------

    END gensort ; ------------------------------------------------------