[Ada] Add Generic_Sort operation to standard library
Arnaud Charlet
charlet@adacore.com
Fri Nov 4 13:55:00 GMT 2011
Ada 2012 added a generic operation for sorting an anonymous array (or
array-like container), named Ada.Containers.Generic_Sort, per AI05-0001.
The text of AI05-0001 can be found here:
http://www.ada-auth.org/cgi-bin/cvsweb.cgi/ai05s/ai05-0001-1.txt
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-11-04 Matthew Heaney <heaney@adacore.com>
* Makefile.rtl, impunit.adb: Added a-cogeso.ad[sb]
* a-cgaaso.adb: Replaced implementation with instantiation
of Generic_Sort.
* a-cogeso.ad[sb] This is the new Ada 2012 unit
Ada.Containers.Generic_Sort
-------------- next part --------------
Index: impunit.adb
===================================================================
--- impunit.adb (revision 180935)
+++ impunit.adb (working copy)
@@ -494,6 +494,7 @@
-- Note: strictly the following should be Ada 2012 units, but it seems
-- harmless (and useful) to make then available in Ada 2005 mode.
+ ("a-cogeso", T), -- Ada.Containers.Generic_Sort
("a-secain", T), -- Ada.Strings.Equal_Case_Insensitive
("a-shcain", T), -- Ada.Strings.Hash_Case_Insensitive
("a-slcain", T), -- Ada.Strings.Less_Case_Insensitive
Index: a-cgaaso.adb
===================================================================
--- a-cgaaso.adb (revision 180934)
+++ a-cgaaso.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -27,103 +27,21 @@
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
--- This algorithm was adapted from GNAT.Heap_Sort (see g-heasor.ad[sb])
+-- This unit was originally a GNAT-specific addition to Ada 2005. A unit
+-- providing the same feature, Ada.Containers.Generic_Sort, was defined for
+-- Ada 2012. We retain Generic_Anonymous_Array_Sort for compatibility, but
+-- implement it in terms of the official unit, Generic_Sort.
-with System;
+with Ada.Containers.Generic_Sort;
procedure Ada.Containers.Generic_Anonymous_Array_Sort
(First, Last : Index_Type'Base)
is
- type T is range System.Min_Int .. System.Max_Int;
+ procedure Sort is new Ada.Containers.Generic_Sort
+ (Index_Type => Index_Type,
+ Before => Less,
+ Swap => Swap);
- function To_Index (J : T) return Index_Type;
- pragma Inline (To_Index);
-
- function Lt (J, K : T) return Boolean;
- pragma Inline (Lt);
-
- procedure Xchg (J, K : T);
- pragma Inline (Xchg);
-
- procedure Sift (S : T);
-
- --------------
- -- To_Index --
- --------------
-
- function To_Index (J : T) return Index_Type is
- K : constant T'Base := Index_Type'Pos (First) + J - T'(1);
- begin
- return Index_Type'Val (K);
- end To_Index;
-
- --------
- -- Lt --
- --------
-
- function Lt (J, K : T) return Boolean is
- begin
- return Less (To_Index (J), To_Index (K));
- end Lt;
-
- ----------
- -- Xchg --
- ----------
-
- procedure Xchg (J, K : T) is
- begin
- Swap (To_Index (J), To_Index (K));
- end Xchg;
-
- Max : T := Index_Type'Pos (Last) - Index_Type'Pos (First) + T'(1);
-
- ----------
- -- Sift --
- ----------
-
- procedure Sift (S : T) is
- C : T := S;
- Son : T;
- Father : T;
-
- begin
- loop
- Son := C + C;
-
- if Son < Max then
- if Lt (Son, Son + 1) then
- Son := Son + 1;
- end if;
- elsif Son > Max then
- exit;
- end if;
-
- Xchg (Son, C);
- C := Son;
- end loop;
-
- while C /= S loop
- Father := C / 2;
-
- if Lt (Father, C) then
- Xchg (Father, C);
- C := Father;
- else
- exit;
- end if;
- end loop;
- end Sift;
-
--- Start of processing for Generic_Anonymous_Array_Sort
-
begin
- for J in reverse 1 .. Max / 2 loop
- Sift (J);
- end loop;
-
- while Max > 1 loop
- Xchg (1, Max);
- Max := Max - 1;
- Sift (1);
- end loop;
+ Sort (First, Last);
end Ada.Containers.Generic_Anonymous_Array_Sort;
Index: Makefile.rtl
===================================================================
--- Makefile.rtl (revision 180935)
+++ Makefile.rtl (working copy)
@@ -122,6 +122,7 @@
a-ciormu$(objext) \
a-ciorse$(objext) \
a-clrefi$(objext) \
+ a-cogeso$(objext) \
a-cohama$(objext) \
a-cohase$(objext) \
a-cohata$(objext) \
Index: a-cogeso.adb
===================================================================
--- a-cogeso.adb (revision 0)
+++ a-cogeso.adb (revision 0)
@@ -0,0 +1,127 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT LIBRARY COMPONENTS --
+-- --
+-- ADA.CONTAINERS.GENERIC_SORT --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2011, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- This unit was originally developed by Matthew J Heaney. --
+------------------------------------------------------------------------------
+
+-- This algorithm was adapted from GNAT.Heap_Sort (see g-heasor.ad[sb])
+
+with System;
+
+procedure Ada.Containers.Generic_Sort (First, Last : Index_Type'Base) is
+ type T is range System.Min_Int .. System.Max_Int;
+
+ function To_Index (J : T) return Index_Type;
+ pragma Inline (To_Index);
+
+ function Lt (J, K : T) return Boolean;
+ pragma Inline (Lt);
+
+ procedure Xchg (J, K : T);
+ pragma Inline (Xchg);
+
+ procedure Sift (S : T);
+
+ --------------
+ -- To_Index --
+ --------------
+
+ function To_Index (J : T) return Index_Type is
+ K : constant T'Base := Index_Type'Pos (First) + J - T'(1);
+ begin
+ return Index_Type'Val (K);
+ end To_Index;
+
+ --------
+ -- Lt --
+ --------
+
+ function Lt (J, K : T) return Boolean is
+ begin
+ return Before (To_Index (J), To_Index (K));
+ end Lt;
+
+ ----------
+ -- Xchg --
+ ----------
+
+ procedure Xchg (J, K : T) is
+ begin
+ Swap (To_Index (J), To_Index (K));
+ end Xchg;
+
+ Max : T := Index_Type'Pos (Last) - Index_Type'Pos (First) + T'(1);
+
+ ----------
+ -- Sift --
+ ----------
+
+ procedure Sift (S : T) is
+ C : T := S;
+ Son : T;
+ Father : T;
+
+ begin
+ loop
+ Son := C + C;
+
+ if Son < Max then
+ if Lt (Son, Son + 1) then
+ Son := Son + 1;
+ end if;
+ elsif Son > Max then
+ exit;
+ end if;
+
+ Xchg (Son, C);
+ C := Son;
+ end loop;
+
+ while C /= S loop
+ Father := C / 2;
+
+ if Lt (Father, C) then
+ Xchg (Father, C);
+ C := Father;
+ else
+ exit;
+ end if;
+ end loop;
+ end Sift;
+
+-- Start of processing for Generic_Sort
+
+begin
+ for J in reverse 1 .. Max / 2 loop
+ Sift (J);
+ end loop;
+
+ while Max > 1 loop
+ Xchg (1, Max);
+ Max := Max - 1;
+ Sift (1);
+ end loop;
+end Ada.Containers.Generic_Sort;
Index: a-cogeso.ads
===================================================================
--- a-cogeso.ads (revision 0)
+++ a-cogeso.ads (revision 0)
@@ -0,0 +1,40 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT LIBRARY COMPONENTS --
+-- --
+-- ADA.CONTAINERS.GENERIC_SORT --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2011, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- This unit was originally developed by Matthew J Heaney. --
+------------------------------------------------------------------------------
+
+-- Allows an anonymous array (or array-like container) to be sorted. Generic
+-- formal Before returns the result of comparing the elements designated by
+-- the indexes, and generic formal Swap exchanges the designated elements.
+
+generic
+ type Index_Type is (<>);
+ with function Before (Left, Right : Index_Type) return Boolean;
+ with procedure Swap (Left, Right : Index_Type);
+
+procedure Ada.Containers.Generic_Sort (First, Last : Index_Type'Base);
+pragma Pure (Ada.Containers.Generic_Sort);
More information about the Gcc-patches
mailing list