1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT LIBRARY COMPONENTS                          --
4--                                                                          --
5--                       ADA.CONTAINERS.GENERIC_SORT                        --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--            Copyright (C) 2011, Free Software Foundation, Inc.            --
10--                                                                          --
11-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12-- terms of the  GNU General Public License as published  by the Free Soft- --
13-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17--                                                                          --
18-- As a special exception under Section 7 of GPL version 3, you are granted --
19-- additional permissions described in the GCC Runtime Library Exception,   --
20-- version 3.1, as published by the Free Software Foundation.               --
21--                                                                          --
22-- You should have received a copy of the GNU General Public License and    --
23-- a copy of the GCC Runtime Library Exception along with this program;     --
24-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25-- <http://www.gnu.org/licenses/>.                                          --
26--                                                                          --
27-- This unit was originally developed by Matthew J Heaney.                  --
28------------------------------------------------------------------------------
29
30--  This algorithm was adapted from GNAT.Heap_Sort (see g-heasor.ad[sb])
31
32with System;
33
34procedure Ada.Containers.Generic_Sort (First, Last : Index_Type'Base) is
35   type T is range System.Min_Int .. System.Max_Int;
36
37   function To_Index (J : T) return Index_Type;
38   pragma Inline (To_Index);
39
40   function Lt (J, K : T) return Boolean;
41   pragma Inline (Lt);
42
43   procedure Xchg (J, K : T);
44   pragma Inline (Xchg);
45
46   procedure Sift (S : T);
47
48   --------------
49   -- To_Index --
50   --------------
51
52   function To_Index (J : T) return Index_Type is
53      K : constant T'Base := Index_Type'Pos (First) + J - T'(1);
54   begin
55      return Index_Type'Val (K);
56   end To_Index;
57
58   --------
59   -- Lt --
60   --------
61
62   function Lt (J, K : T) return Boolean is
63   begin
64      return Before (To_Index (J), To_Index (K));
65   end Lt;
66
67   ----------
68   -- Xchg --
69   ----------
70
71   procedure Xchg (J, K : T) is
72   begin
73      Swap (To_Index (J), To_Index (K));
74   end Xchg;
75
76   Max : T := Index_Type'Pos (Last) - Index_Type'Pos (First) + T'(1);
77
78   ----------
79   -- Sift --
80   ----------
81
82   procedure Sift (S : T) is
83      C      : T := S;
84      Son    : T;
85      Father : T;
86
87   begin
88      loop
89         Son := C + C;
90
91         if Son < Max then
92            if Lt (Son, Son + 1) then
93               Son := Son + 1;
94            end if;
95         elsif Son > Max then
96            exit;
97         end if;
98
99         Xchg (Son, C);
100         C := Son;
101      end loop;
102
103      while C /= S loop
104         Father := C / 2;
105
106         if Lt (Father, C) then
107            Xchg (Father, C);
108            C := Father;
109         else
110            exit;
111         end if;
112      end loop;
113   end Sift;
114
115--  Start of processing for Generic_Sort
116
117begin
118   for J in reverse 1 .. Max / 2 loop
119      Sift (J);
120   end loop;
121
122   while Max > 1 loop
123      Xchg (1, Max);
124      Max := Max - 1;
125      Sift (1);
126   end loop;
127end Ada.Containers.Generic_Sort;
128