From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 15165 invoked by alias); 4 Nov 2011 13:46:20 -0000 Received: (qmail 15075 invoked by uid 22791); 4 Nov 2011 13:46:15 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00 X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 04 Nov 2011 13:45:59 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 4A0B62BACD1; Fri, 4 Nov 2011 09:45:58 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id pbNpZYUykESD; Fri, 4 Nov 2011 09:45:58 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 2D5012BACD0; Fri, 4 Nov 2011 09:45:58 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 2C37F3FEE8; Fri, 4 Nov 2011 09:45:58 -0400 (EDT) Date: Fri, 04 Nov 2011 13:55:00 -0000 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Matthew Heaney Subject: [Ada] Add Generic_Sort operation to standard library Message-ID: <20111104134558.GA7563@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="pf9I7BMVVzbSWLtt" Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org X-SW-Source: 2011-11/txt/msg00557.txt.bz2 --pf9I7BMVVzbSWLtt Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 562 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 * 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 --pf9I7BMVVzbSWLtt Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename=difs Content-length: 11786 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 -- +-- . -- +-- -- +-- 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 -- +-- . -- +-- -- +-- 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); --pf9I7BMVVzbSWLtt--