OberonCore

TYPE
   
   List* = POINTER TO RECORD (O.Object)
      FCount,
      FCapacity: INTEGER;
      FList: POINTER TO ARRAY OF O.Object;
   END;

   ListSortCompare* = PROCEDURE (Index1, Index2: INTEGER): INTEGER;
   ListSortExchange* = PROCEDURE (Index1, Index2: INTEGER);
   ListSort* = PROCEDURE (l, r: INTEGER; Compare: ListSortCompare; Exchange: ListSortExchange);
   
   PROCEDURE QuickSort (
         L, R : INTEGER;
         Compare: ListSortCompare;
         Exchange: ListSortExchange);
      VAR
         I, J: INTEGER;
         P, Q: INTEGER;
   BEGIN
      REPEAT
         I := L;
         J := R;
         P := (L + R) DIV 2;
         REPEAT
            WHILE Compare (P, I) > 0 DO INC(I) END;
            WHILE Compare (P, J) < 0 DO DEC(J) END;
            IF I <= J THEN
               Exchange (I, J);
               INC(I);
               DEC(J)
            END;
         UNTIL I > J;
         IF L < J THEN QuickSort (L, J, Compare, Exchange) END;
         L := I;
      UNTIL I >= R;
   END QuickSort;
   
   PROCEDURE (L: List) Sort*(sortList: ListSort; Compare: ListSortCompare), NEW;
   BEGIN
      sortList (0, L.FCount - 1, Compare, L.Exchange)
   END Sort;

   PROCEDURE (L: List) QuickSort (
         l, r : INTEGER;
         Compare: ListSortCompare), NEW;
      VAR
         i, j: INTEGER;
         p, q: INTEGER;
   BEGIN
      REPEAT
         i := l;
         j := r;
         p := (l + r) DIV 2;
         REPEAT
            WHILE Compare (p, i) > 0 DO INC(i) END;
            WHILE Compare (p, j) < 0 DO DEC(j) END;
            IF i <= j THEN
               L.Exchange (i, j);
               INC(i);
               DEC(j)
            END;
         UNTIL i > j;
         IF i < j THEN L.QuickSort (l, j, Compare) END;
         l := i;
      UNTIL i >= r;
   END QuickSort;
   
   PROCEDURE (L: List) Sort*(Compare: ListSortCompare), NEW, EXTENSIBLE;
   BEGIN
      L.QuickSort (0, L.FCount - 1, Compare)
   END Sort;