-------------------------------------------------------------------------------
--
-- <STRONG>Copyright (c) 1999 - 2002 by Thomas Wolf.</STRONG>
-- <BLOCKQUOTE>
--    AdaBrowse is free software; you can redistribute it and/or modify it
--    under the terms of the  GNU General Public License as published by the
--    Free Software  Foundation; either version 2, or (at your option) any
--    later version. AdaBrowse is distributed in the hope that it will be
--    useful, but <EM>without any warranty</EM>; without even the implied
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
--    See the GNU General Public License for  more details. You should have
--    received a copy of the GNU General Public License with this distribution,
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
--    USA.
-- </BLOCKQUOTE>
-- <BLOCKQUOTE>
--   As a special exception from the GPL, if other files instantiate generics
--   from this unit, or you link this unit with other files to produce an
--   executable, this unit does not by itself cause the resulting executable
--   to be covered by the GPL. This exception does not however invalidate any
--   other reasons why the executable file might be covered by the GPL.
-- </BLOCKQUOTE>
--
-- <DL><DT><STRONG>
-- Author:</STRONG><DD>
--   Thomas Wolf  (TW)
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
--
-- <DL><DT><STRONG>
-- Purpose:</STRONG><DD>
--   Speed and space optimized quicksort. Actually, an <EM>introspective
--   quicksort</EM> with a <STRONG>worst-case</STRONG> runtime complexity of
--   <CODE>O (N * log2 (N))</CODE>.</DL>
--
-- <DL><DT><STRONG>
-- Literature:</STRONG><DD>
--   Musser, D.R.: "Introspective Sorting and Selection Algorithms",
--      <EM>Software -- Practice & Experience (8):983-993</EM>; 1997.</DL>
--
-- <DL><DT><STRONG>
-- Tasking semantics:</STRONG><DD>
--   N/A. Not abortion-safe.</DL>
--
-- <DL><DT><STRONG>
-- Storage semantics:</STRONG><DD>
--   No dynamic storage allocation. Stack space used is
--   <CODE>O (log2 (N))</CODE>.</DL>
--
-- <--
-- Revision History
--
--   21-JAN-1999   TW  Initial version
--   26-JAN-1999   TW  Some minor fine-tuning.
-- -->
-------------------------------------------------------------------------------

pragma License (Modified_GPL);

with Ada.Numerics.Elementary_Functions;

package body GAL.Sorting is

   Cut_Off : constant := 10;
   --  Empirically determined constant. For smaller arrays, it's actually
   --  faster to use a simple insertion sort.

   function Max_Depth
     (Nof_Elements : in Natural)
     return Natural
   is
      --  Compute the recursion depth bound at which we'll switch to using
      --  Heapsort instead of proceeding further down with Quicksort.
      use Ada.Numerics.Elementary_Functions;
      --  This seems to give us the fastest logarithm around...
   begin
      return 2 * Natural (Log (Float (Nof_Elements), 2.0));
      --  This is Musser's suggestion, which seems to work well in practice.
      --     Note: it should not be too low, or we'll switch to using
      --  Heapsort prematurely. Since Heapsort is slower than Quicksort
      --  on the average (its constant factor in the O(N*log2(N)) is
      --  larger), we might lose. If it's too high, we'll start using
      --  Heapsort too late and hence we cannot ensure the O(N*log2(N))
      --  upper bound.
   end Max_Depth;

   ----------------------------------------------------------------------------
   --  A sort with a classic interface:

   --  generic
   --     type Index_Type   is (<>);
   --     type Element_Type is private;
   --     type Array_Type   is array (Index_Type range <>) of Element_Type;
   --     with function "<"
   --            (Left, Right : in Element_Type) return Boolean is <>;
   procedure Sort_G
     (To_Sort : in out Array_Type)
   is
      --  Recursion depth is bounded by log2 (To_Sort'Length).
      --  Worst-case runtime complexity is O(N*log2(N)), not O(N**2)!
      --  Note: for sensible performance measures, compile with a typical
      --  optimization level and all checks off (e.g. gcc -O3 -gnatp). For
      --  correctness testing, switch on checks!

      pragma Suppress (Overflow_Check);
      pragma Suppress (Index_Check);
      pragma Suppress (Range_Check);
      --  For correctness testing, you should also comment out these pragmas!

      Pivot, Temp : Element_Type;
      --  We need exactly two temporary locations, one for Quicksort's pivot
      --  element, and a second one for swapping elements and as a general
      --  temporary during Insertion_Sort or Heap_Sort.

      procedure Swap (Left, Right : in Index_Type);
      pragma Inline (Swap); --  inline this for increased performance.

      procedure Swap (Left, Right : in Index_Type)
      is
      begin
         Temp            := To_Sort (Left);
         To_Sort (Left)  := To_Sort (Right);
         To_Sort (Right) := Temp;
      end Swap;

      --  For array slices with less than 'Cut_Off' elements, we use a simple
      --  insertion sort: it's faster than quicksort.

      procedure Insertion_Sort
        (L, R : in Index_Type)
      is
         --  Precondition: L < R.
         J : Index_Type;
      begin --  Insertion_Sort
         for I in Index_Type range Index_Type'Succ (L) .. R loop
            Temp := To_Sort (I);
            J := I;
            while J > L and then Temp < To_Sort (Index_Type'Pred (J)) loop
               To_Sort (J) := To_Sort (Index_Type'Pred (J));
               J := Index_Type'Pred (J);
            end loop;
            To_Sort (J) := Temp;
         end loop;
      end Insertion_Sort;

      --  If the (logical) recursion depth of quicksort gets too deep, we
      --  assume that the input is one of the pathological cases causing
      --  quadratic behavior of quicksort. At that moment, we switch to
      --  heapsort to sort the sub-array. (This pays off because heap sort
      --  has a worst-case runtime complexity of O(N*log2(N))).

      procedure Heap_Sort
        (Left, Right : in Index_Type)
      is
         --  Precondition: Left < Right

         Offset : Integer;
         --  Used for mapping the true index range to 1 .. N.

         procedure Sift
           (L, R : in Index_Type)
         is
            --  Normal heapsort algorithms always sort an array indexed by a
            --  range 1 .. N. We have to juggle a bit to map this back to a
            --  range L .. R, and to avoid overflow if R happens to be
            --  Index_Type'Base'Last.
            I    : Index_Type   := L;
            C    : Index_Type   := L;
         begin
            Temp := To_Sort (L);
            while (Index_Type'Pos (C) - Offset +  1) <=
                  (Index_Type'Pos (R) - Offset +  1) / 2
            loop
               C := Index_Type'Val
                 ((Index_Type'Pos (I) - Offset + 1) * 2 - 1 + Offset);
               --  We must add 'Offset - 1'. Make sure to subtract one first,
               --  otherwise we might get an overflow if I = 'Last and
               --  Offset = 'Last-1.
               if
                  C < R and then To_Sort (C) < To_Sort (Index_Type'Succ (C))
               then
                  C := Index_Type'Succ (C);
               end if;
               exit when not (Temp < To_Sort (C));
               To_Sort (I) := To_Sort (C);
               I := C;
            end loop;
            To_Sort (I) := Temp;
         end Sift;

         J : Index_Type;

      begin --  Heap_Sort
         --  Precondition: Left < Right
         Offset := Index_Type'Pos (Left);
         --  Set J to the middle:
         J := Index_Type'Val
           ((Index_Type'Pos (Right) - Offset + 1) / 2 + Offset - 1);
         --  Build the heap:
         for I in reverse Index_Type range Left .. J loop
            Sift (I, Right);
         end loop;
         --  And now extract elements and re-build the heap.
         J := Right;
         loop
            --  Put the largest element (which is now in front) at the end and
            --  replace it with the last element.
            Swap (Left, J);
            J := Index_Type'Pred (J);
            exit when J = Left;
            --  Rebuild the remaining heap (one element less).
            Sift (Left, J);
         end loop;
      end Heap_Sort;

      procedure Intro_Sort
        (L, R : in Index_Type;
         D    : in Natural)
      is
         --  This is a quicksort with median-of-three pivot selection and
         --  stack depth optimization: the tail recusion is resolved by
         --  always sorting the larger sub-array iteratively instead of
         --  recursing. This limits the physical recursion depth to log2(N)
         --  and thus avoids stack overflows even for pathological huge inputs.
         --     Actually, this is an introspective sort (see Musser's paper).
         --  It switches to heapsort if the logical recursion depth becomes
         --  too deep and thus avoids quicksort's usual worst-case quadratic
         --  behavior.

         Left        : Index_Type := L;
         Right       : Index_Type := R;
         --  L and R are in parameters, so copy.
         Depth       : Natural    := D;    --  Ditto for D.
         I           : Index_Type := Left;
         J           : Index_Type := Right;
         Middle      : Index_Type;

      begin --  Intro_Sort
         while Index_Type'Pos (Right) - Index_Type'Pos (Left) > Cut_Off loop
            --  Only proceed until we have a small unsorted array fragment
            --  left. This fragment will then be sorted with Insertion_Sort,
            --  which is faster than quicksort for small arrays.
            if Depth = 0 then Heap_Sort (Left, Right); return; end if;
            --  If the (logical) recursion depth gets too deep, we switch
            --  to heapsort, which has a worst-case run-time complexity of
            --  O(N*log(N)). This gives Intro_Sort an overall worst-case
            --  bound of O(N*log(N)), compared with the O(N**2) bound of
            --  plain quicksort (even with median-of-three).
            --
            --  Don't use (Left + Right) / 2; it might overflow. Instead use
            --  Left + (Right - Left) / 2, which is equivalent.
            Middle :=
              Index_Type'Val
              (Index_Type'Pos (Left) +
               (Index_Type'Pos (Right) - Index_Type'Pos (Left)) / 2);
            --  Median-of-three:
            if To_Sort (Middle) < To_Sort (Left) then
               Swap (Middle, Left);
            end if;
            if To_Sort (Right) < To_Sort (Left) then
               Swap (Right, Left);
            end if;
            if To_Sort (Right) < To_Sort (Middle) then
               Swap (Right, Middle);
            end if;
            Pivot := To_Sort (Middle);
            --  Here, I = Left and J = Right
            while I < J loop
               while To_Sort (I) < Pivot loop
                  I := Index_Type'Succ (I);
               end loop;
               while Pivot < To_Sort (J) loop
                  J := Index_Type'Pred (J);
               end loop;
               if I <= J then
                  if I < J then Swap (I, J); end if;
                  --  Now increment I and decrement J..., but beware of
                  --  boundary conditions!
                  if I < Index_Type'Last then
                     I := Index_Type'Succ (I);
                  end if;
                  if J > Index_Type'First then
                     J := Index_Type'Pred (J);
                  end if;
                  --  I and J saturate at the bounds of Index_Type... this
                  --  doesn't hurt, we'll quit the loop in this case, and
                  --  continue only (both recusively and iteratively) if
                  --  this didn't happen.
               end if;
            end loop;
            --  Decrement the logical recursion depth. The next iteration will
            --  hence be (correctly) seen like a true recursive call.
            Depth := Depth - 1;
            --  Now handle the shorter part recusively, and do the longer part
            --  iteratively. This limits the (physical) recusion depth to
            --  log2(N). Note: Musser advocates omitting this and just doing
            --  one half recursively and the other one iteratively regardless
            --  of their sizes, as the 'Depth' counter already puts an
            --  O(log2(N)) bound on the maximum stack depth. The speed savings
            --  are marginal, though, and I prefer a bound of log2(N) over one
            --  of 2 * log2(N)...
            if Index_Type'Pos (J) - Index_Type'Pos (Left) >
               Index_Type'Pos (Right) - Index_Type'Pos (I)
            then
               --  Left part is longer. If I saturated, it is >= Right, and we
               --  won't do the recursive call.
               if I < Right then Intro_Sort (I, Right, Depth); end if;
               --  Iteratively process To_Sort (Left .. J). Set up the indices:
               I := Left; Right := J;
            else
               --  Right part is longer. If J saturated, it is <= Left, and we
               --  won't do the recursive call.
               if J > Left then Intro_Sort (Left, J, Depth); end if;
               --  Iteratively process To_Sort (I .. Right). Set up the
               --  indices:
               J := Right; Left := I;
            end if;
            --  If either I or J saturated, Left >= Right now, and we'll
            --  quit the outer loop.
         end loop;
         if Left < Right then Insertion_Sort (Left, Right); end if;
         --  Note: an alternative is to simply return and run a single
         --  insertion sort over the whole input at the very end. However,
         --  in my tests this made sorting slower. Nevertheless it should be
         --  pointed out that some people advocate this single post-sorting
         --  insertion sort, notably Musser in his paper.
      end Intro_Sort;

   begin --  Sort_G
      if To_Sort'Last > To_Sort'First then
         Intro_Sort (To_Sort'First, To_Sort'Last,
                     Max_Depth (To_Sort'Length));
      end if;
   end Sort_G;

   ----------------------------------------------------------------------------
   --  The same with an access parameter and range bounds.

   --  generic
   --     type Index_Type   is (<>);
   --     type Element_Type is private;
   --     type Array_Type   is array (Index_Type range <>) of Element_Type;
   --     with function "<"
   --            (Left, Right : in Element_Type) return Boolean is <>;
   procedure Sort_Slice_G
     (To_Sort  : access Array_Type;
      From, To : in     Index_Type)
   is
      pragma Suppress (Overflow_Check);
      pragma Suppress (Index_Check);
      pragma Suppress (Range_Check);

      Pivot, Temp : Element_Type;

      procedure Swap
        (Table       : access Array_Type;
         Left, Right : in     Index_Type);
      pragma Inline (Swap); --  inline this for increased performance.

      procedure Swap
        (Table       : access Array_Type;
         Left, Right : in     Index_Type)
      is
      begin
         Temp          := Table (Left);
         Table (Left)  := Table (Right);
         Table (Right) := Temp;
      end Swap;

      procedure Insertion_Sort
        (To_Sort : access Array_Type;
         L, R    : in     Index_Type)
      is
         --  Precondition: L < R.
         J : Index_Type;
      begin --  Insertion_Sort
         for I in Index_Type range Index_Type'Succ (L) .. R loop
            Temp := To_Sort (I);
            J := I;
            while J > L and then Temp < To_Sort (Index_Type'Pred (J)) loop
               To_Sort (J) := To_Sort (Index_Type'Pred (J));
               J := Index_Type'Pred (J);
            end loop;
            To_Sort (J) := Temp;
         end loop;
      end Insertion_Sort;

      procedure Heap_Sort
        (To_Sort     : access Array_Type;
         Left, Right : in     Index_Type)
      is
         --  Precondition: Left < Right

         Offset : Integer;

         procedure Sift
           (To_Sort : access Array_Type;
            L, R    : in     Index_Type)
         is
            I    : Index_Type   := L;
            C    : Index_Type   := L;
         begin
            Temp := To_Sort (L);
            while (Index_Type'Pos (C) - Offset +  1) <=
                  (Index_Type'Pos (R) - Offset +  1) / 2
            loop
               C := Index_Type'Val
                 ((Index_Type'Pos (I) - Offset + 1) * 2 - 1 + Offset);
               if
                  C < R and then To_Sort (C) < To_Sort (Index_Type'Succ (C))
               then
                  C := Index_Type'Succ (C);
               end if;
               exit when not (Temp < To_Sort (C));
               To_Sort (I) := To_Sort (C);
               I := C;
            end loop;
            To_Sort (I) := Temp;
         end Sift;

         J : Index_Type;

      begin --  Heap_Sort
         --  Precondition: Left < Right
         Offset := Index_Type'Pos (Left);
         --  Set J to the middle:
         J := Index_Type'Val
           ((Index_Type'Pos (Right) - Offset + 1) / 2 + Offset - 1);
         --  Build the heap:
         for I in reverse Index_Type range Left .. J loop
            Sift (To_Sort, I, Right);
         end loop;
         --  And now extract elements and re-build the heap.
         J := Right;
         loop
            --  Put the largest element (which is now in front) at the end and
            --  replace it with the last element.
            Swap (To_Sort, Left, J);
            J := Index_Type'Pred (J);
            exit when J = Left;
            --  Rebuild the remaining heap (one element less).
            Sift (To_Sort, Left, J);
         end loop;
      end Heap_Sort;

      procedure Intro_Sort
        (To_Sort : access Array_Type;
         L, R    : in     Index_Type;
         D       : in     Natural)
      is

         Left        : Index_Type := L;
         Right       : Index_Type := R;
         --  L and R are in parameters, so copy.
         Depth       : Natural    := D;    --  Ditto for D.
         I           : Index_Type := Left;
         J           : Index_Type := Right;
         Middle      : Index_Type;

      begin --  Intro_Sort
         while Index_Type'Pos (Right) - Index_Type'Pos (Left) > Cut_Off loop
            if Depth = 0 then Heap_Sort (To_Sort, Left, Right); return; end if;
            Middle :=
              Index_Type'Val
              (Index_Type'Pos (Left) +
               (Index_Type'Pos (Right) - Index_Type'Pos (Left)) / 2);
            --  Median-of-three:
            if To_Sort (Middle) < To_Sort (Left) then
               Swap (To_Sort, Middle, Left);
            end if;
            if To_Sort (Right) < To_Sort (Left) then
               Swap (To_Sort, Right, Left);
            end if;
            if To_Sort (Right) < To_Sort (Middle) then
               Swap (To_Sort, Right, Middle);
            end if;
            Pivot := To_Sort (Middle);
            --  Here, I = Left and J = Right
            while I < J loop
               while To_Sort (I) < Pivot loop
                  I := Index_Type'Succ (I);
               end loop;
               while Pivot < To_Sort (J) loop
                  J := Index_Type'Pred (J);
               end loop;
               if I <= J then
                  if I < J then Swap (To_Sort, I, J); end if;
                  --  Now increment I and decrement J..., but beware of
                  --  boundary conditions!
                  if I < Index_Type'Last then
                     I := Index_Type'Succ (I);
                  end if;
                  if J > Index_Type'First then
                     J := Index_Type'Pred (J);
                  end if;
               end if;
            end loop;
            Depth := Depth - 1;
            if Index_Type'Pos (J) - Index_Type'Pos (Left) >
               Index_Type'Pos (Right) - Index_Type'Pos (I)
            then
               if I < Right then Intro_Sort (To_Sort, I, Right, Depth); end if;
               I := Left; Right := J;
            else
               if J > Left then Intro_Sort (To_Sort, Left, J, Depth); end if;
               J := Right; Left := I;
            end if;
            --  If either I or J saturated, Left >= Right now, and we'll
            --  quit the outer loop.
         end loop;
         if Left < Right then Insertion_Sort (To_Sort, Left, Right); end if;
      end Intro_Sort;

   begin --  Sort_Slice_G
      if To_Sort'Last > To_Sort'First and then From <= To then
         if From < To_Sort'First or else To > To_Sort'Last then
            --  If 'From' is > To_Sort'Last, then so is 'To'. And if 'To' is
            --  < To_Sort'First, then so is 'From'. Hence the above condition
            --  is sufficient to ensure that *both* indices are within range.
            raise Constraint_Error;
         end if;
         Intro_Sort
           (To_Sort, From, To,
            Max_Depth (Index_Type'Pos (To) - Index_Type'Pos (From) + 1));
      end if;
   end Sort_Slice_G;

   ----------------------------------------------------------------------------
   --  A very general sort that can be used to sort whatever you like. As
   --  long as you can provide random access in constant time, this will
   --  be a logarithmic sort. (It's an introspective quicksort, too.)

   --  generic
   --     with function  Is_Smaller (Left, Right : in Integer) return Boolean;
   --     --  Shall return True if the element at index 'Left' is smaller than
   --     --  the element at index 'Right' and Fasle otherwise.
   --     with procedure Copy       (To, From    : in Integer);
   --     --  Shall copy the element at index 'From' to position 'To'.
   procedure Sort_Indexed_G
     (Left, Right : in Natural)
   is
      pragma Suppress (Overflow_Check);
      pragma Suppress (Index_Check);
      pragma Suppress (Range_Check);

      procedure Swap (L, R : in Natural);
      pragma Inline (Swap); --  inline this for increased performance.

      procedure Swap (L, R : in Natural)
      is
      begin
         Copy (-1, L); Copy (L, R); Copy (R, -1);
      end Swap;

      procedure Insertion_Sort
        (L, R : in Positive)
      is
         --  Precondition: L < R.
         J : Natural;
      begin --  Insertion_Sort
         for I in Natural range L + 1 .. R loop
            Copy (-1, I);
            J := I;
            while J > L and then Is_Smaller (-1, J - 1) loop
               Copy (J, J - 1);
               J := J - 1;
            end loop;
            Copy (J, -1);
         end loop;
      end Insertion_Sort;

      procedure Heap_Sort
        (Left, Right : in Positive)
      is
         --  Precondition: Left < Right

         Offset : constant Integer := Left;

         procedure Sift
           (L, R : in Natural)
         is
            I : Integer := L;
            C : Integer := L;
         begin
            Copy (-1, L);
            while (C - Offset + 1) <= (R - Offset + 1) / 2 loop
               C := (I - Offset + 1) * 2 - 1 + Offset;
               if C < R and then Is_Smaller (C, C + 1) then
                  C := C + 1;
               end if;
               exit when not Is_Smaller (-1, C);
               Copy (I, C);
               I := C;
            end loop;
            Copy (I, -1);
         end Sift;

         J : Natural;

      begin --  Heap_Sort
         --  Precondition: Left < Right
         J := (Right - Offset + 1) / 2 + Offset - 1;
         --  Build the heap:
         for I in reverse Positive range Left .. J loop
            Sift (I, Right);
         end loop;
         --  And now extract elements and re-build the heap.
         J := Right;
         loop
            --  Put the largest element (which is now in front) at the end and
            --  replace it with the last element.
            Swap (Left, J);
            J := J - 1;
            exit when J = Left;
            --  Rebuild the remaining heap (one element less).
            Sift (Left, J);
         end loop;
      end Heap_Sort;

      procedure Intro_Sort
        (L, R : in Natural;
         D    : in Natural)
      is
         Left        : Natural := L; --  L and R are in parameters, so copy.
         Right       : Natural := R;
         Depth       : Natural := D; --  Ditto for D.
         I           : Natural := Left;
         J           : Natural := Right;
         Middle      : Natural;

      begin --  Intro_Sort
         while Right - Left > Cut_Off loop
            if Depth = 0 then Heap_Sort (Left, Right); return; end if;
            Middle := Left + (Right - Left) / 2;
            --  Median-of-three:
            if Is_Smaller (Middle, Left)  then Swap (Middle, Left);  end if;
            if Is_Smaller (Right, Left)   then Swap (Right, Left);   end if;
            if Is_Smaller (Right, Middle) then Swap (Right, Middle); end if;
            Copy (-2, Middle);
            --  Here, I = Left and J = Right
            while I < J loop
               while Is_Smaller (I, -2) loop I := I + 1; end loop;
               while Is_Smaller (-2, J) loop J := J - 1; end loop;
               if I <= J then
                  if I < J then Swap (I, J); end if;
                  if I < Positive'Last then I := I + 1; end if;
                  if J > 1             then J := J - 1; end if;
               end if;
            end loop;
            Depth := Depth - 1;
            if
               Integer (J) - Integer (Left) > Integer (Right) - Integer (I)
            then
               --  Left part is longer.
               if I < Right then Intro_Sort (I, Right, Depth); end if;
               I := Left; Right := J;
            else
               --  Right part is longer.
               if J > Left then Intro_Sort (Left, J, Depth); end if;
               J := Right; Left := I;
            end if;
         end loop;
         if Left < Right then Insertion_Sort (Left, Right); end if;
      end Intro_Sort;

   begin --  Sort_Indexed_G
      if Left < Right then
         Intro_Sort (Left, Right, Max_Depth (Right - Left + 1));
      end if;
   end Sort_Indexed_G;

   ----------------------------------------------------------------------------
   --  Same as above, but using access-to-subroutines.

   procedure Sort
     (Left, Right : in Natural;
      Is_Smaller  : in Comparator;
      Copy        : in Copier)
   is
      pragma Suppress (Overflow_Check);
      pragma Suppress (Index_Check);
      pragma Suppress (Range_Check);
      pragma Suppress (Access_Check);

      procedure Swap (L, R : in Natural);
      pragma Inline (Swap); --  inline this for increased performance.

      procedure Swap (L, R : in Natural)
      is
      begin
         Copy (-1, L); Copy (L, R); Copy (R, -1);
      end Swap;

      procedure Insertion_Sort
        (L, R : in Positive)
      is
         --  Precondition: L < R.
         J : Natural;
      begin --  Insertion_Sort
         for I in Natural range L + 1 .. R loop
            Copy (-1, I);
            J := I;
            while J > L and then Is_Smaller (-1, J - 1) loop
               Copy (J, J - 1);
               J := J - 1;
            end loop;
            Copy (J, -1);
         end loop;
      end Insertion_Sort;

      procedure Heap_Sort
        (Left, Right : in Natural)
      is
         --  Precondition: Left < Right

         Offset : constant Integer := Left;

         procedure Sift
           (L, R : in Natural)
         is
            I    : Integer := L;
            C    : Integer := L;
         begin
            Copy (-1, L);
            while (C - Offset + 1) <= (R - Offset + 1) / 2 loop
               C := (I - Offset + 1) * 2 - 1 + Offset;
               if C < R and then Is_Smaller (C, C + 1) then
                  C := C + 1;
               end if;
               exit when not Is_Smaller (-1, C);
               Copy (I, C);
               I := C;
            end loop;
            Copy (I, -1);
         end Sift;

         J : Natural;

      begin --  Heap_Sort
         --  Precondition: Left < Right
         J := (Right - Offset + 1) / 2 + Offset - 1;
         --  Build the heap:
         for I in reverse Positive range Left .. J loop
            Sift (I, Right);
         end loop;
         --  And now extract elements and re-build the heap.
         J := Right;
         loop
            --  Put the largest element (which is now in front) at the end and
            --  replace it with the last element.
            Swap (Left, J);
            J := J - 1;
            exit when J = Left;
            --  Rebuild the remaining heap (one element less).
            Sift (Left, J);
         end loop;
      end Heap_Sort;

      procedure Intro_Sort
        (L, R : in Natural;
         D    : in Natural)
      is
         Left        : Natural := L; --  L and R are in parameters, so copy.
         Right       : Natural := R;
         Depth       : Natural := D; --  Ditto for D.
         I           : Natural := Left;
         J           : Natural := Right;
         Middle      : Natural;

      begin --  Intro_Sort
         while Right - Left > Cut_Off loop
            if Depth = 0 then Heap_Sort (Left, Right); return; end if;
            Middle := Left + (Right - Left) / 2;
            --  Median-of-three:
            if Is_Smaller (Middle, Left)  then Swap (Middle, Left);  end if;
            if Is_Smaller (Right, Left)   then Swap (Right, Left);   end if;
            if Is_Smaller (Right, Middle) then Swap (Right, Middle); end if;
            Copy (-2, Middle);
            --  Here, I = Left and J = Right
            while I < J loop
               while Is_Smaller (I, -2) loop I := I + 1; end loop;
               while Is_Smaller (-2, J) loop J := J - 1; end loop;
               if I <= J then
                  if I < J then Swap (I, J); end if;
                  if I < Positive'Last then I := I + 1; end if;
                  if J > 1             then J := J - 1; end if;
               end if;
            end loop;
            Depth := Depth - 1;
            if
               Integer (J) - Integer (Left) > Integer (Right) - Integer (I)
            then
               --  Left part is longer.
               if I < Right then Intro_Sort (I, Right, Depth); end if;
               I := Left; Right := J;
            else
               --  Right part is longer.
               if J > Left then Intro_Sort (Left, J, Depth); end if;
               J := Right; Left := I;
            end if;
         end loop;
         if Left < Right then Insertion_Sort (Left, Right); end if;
      end Intro_Sort;

   begin --  Sort
      if Left < Right then
         --  We have suppressed access checks. Do it once and for all times
         --  by hand.
         if Is_Smaller = null or else Copy = null then
            raise Constraint_Error;
         end if;
         Intro_Sort (Left, Right, Max_Depth (Right - Left + 1));
      end if;
   end Sort;

   ----------------------------------------------------------------------------

end GAL.Sorting;
