From 392f673a0cbbc5f0d31836ad7f90df7d9eb9dd17 Mon Sep 17 00:00:00 2001 From: Matthew Heaney Date: Wed, 15 Feb 2006 10:33:04 +0100 Subject: [PATCH] a-cgcaso.adb, [...]: Implemented using heapsort instead of quicksort. 2006-02-13 Matthew Heaney * a-cgcaso.adb, a-cgaaso.adb: Implemented using heapsort instead of quicksort. From-SVN: r111036 --- gcc/ada/a-cgaaso.adb | 142 +++++++++++++++++++----------------- gcc/ada/a-cgcaso.adb | 166 ++++++++++++++++++------------------------- 2 files changed, 145 insertions(+), 163 deletions(-) diff --git a/gcc/ada/a-cgaaso.adb b/gcc/ada/a-cgaaso.adb index cd4cfaba076..b91de5fc55a 100644 --- a/gcc/ada/a-cgaaso.adb +++ b/gcc/ada/a-cgaaso.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -34,93 +34,103 @@ -- 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_Anonymous_Array_Sort (First, Last : Index_Type'Base) is - Pivot, Lo, Mid, Hi : Index_Type; + type T is range System.Min_Int .. System.Max_Int; -begin - if Last <= First then - return; - end if; - - Lo := First; - Hi := Last; - - if Last = Index_Type'Succ (First) then - if not Less (Lo, Hi) then - Swap (Lo, Hi); - end if; - - return; - end if; - - Mid := Index_Type'Val - (Index_Type'Pos (Lo) + - (Index_Type'Pos (Hi) - Index_Type'Pos (Lo)) / 2); - - -- We need to figure out which case we have: - -- x < y < z - -- x < z < y - -- z < x < y - -- y < x < z - -- y < z < x - -- z < y < x - - if Less (Lo, Mid) then - if Less (Lo, Hi) then - if Less (Mid, Hi) then - Swap (Lo, Mid); + function To_Index (J : T) return Index_Type; + pragma Inline (To_Index); - else - Swap (Lo, Hi); + function Lt (J, K : T) return Boolean; + pragma Inline (Lt); - end if; + 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; - else - null; -- lo is median - end if; + -------- + -- Lt -- + -------- - elsif Less (Lo, Hi) then - null; -- lo is median + function Lt (J, K : T) return Boolean is + begin + return Less (To_Index (J), To_Index (K)); + end Lt; - elsif Less (Mid, Hi) then - Swap (Lo, Hi); + ---------- + -- Xchg -- + ---------- - else - Swap (Lo, Mid); - end if; + procedure Xchg (J, K : T) is + begin + Swap (To_Index (J), To_Index (K)); + end Xchg; - Pivot := Lo; - Outer : loop + 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 - exit Outer when not (Pivot < Hi); + Son := C + C; - if Less (Hi, Pivot) then - Swap (Hi, Pivot); - Pivot := Hi; - Lo := Index_Type'Succ (Lo); + if Son < Max then + if Lt (Son, Son + 1) then + Son := Son + 1; + end if; + elsif Son > Max then exit; - else - Hi := Index_Type'Pred (Hi); end if; + + Xchg (Son, C); + C := Son; end loop; - loop - exit Outer when not (Lo < Pivot); + while C /= S loop + Father := C / 2; - if Less (Lo, Pivot) then - Lo := Index_Type'Succ (Lo); + if Lt (Father, C) then + Xchg (Father, C); + C := Father; else - Swap (Lo, Pivot); - Pivot := Lo; - Hi := Index_Type'Pred (Hi); exit; end if; end loop; - end loop Outer; + end Sift; - Generic_Anonymous_Array_Sort (First, Index_Type'Pred (Pivot)); - Generic_Anonymous_Array_Sort (Index_Type'Succ (Pivot), Last); +-- 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; end Ada.Containers.Generic_Anonymous_Array_Sort; diff --git a/gcc/ada/a-cgcaso.adb b/gcc/ada/a-cgcaso.adb index bef6fb0793a..43ddb645b04 100644 --- a/gcc/ada/a-cgcaso.adb +++ b/gcc/ada/a-cgcaso.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -34,130 +34,102 @@ -- This unit has originally being developed by Matthew J Heaney. -- ------------------------------------------------------------------------------ +-- This algorithm was adapted from GNAT.Heap_Sort_G (see g-hesorg.ad[sb]). + +with System; + procedure Ada.Containers.Generic_Constrained_Array_Sort (Container : in out Array_Type) is - function Is_Less (I, J : Index_Type) return Boolean; - pragma Inline (Is_Less); + type T is range System.Min_Int .. System.Max_Int; - procedure Swap (I, J : Index_Type); - pragma Inline (Swap); + function To_Index (J : T) return Index_Type; + pragma Inline (To_Index); - procedure Sort (First, Last : Index_Type'Base); + procedure Sift (S : T); - ------------- - -- Is_Less -- - ------------- + A : Array_Type renames Container; - function Is_Less (I, J : Index_Type) return Boolean is + -------------- + -- To_Index -- + -------------- + + function To_Index (J : T) return Index_Type is + K : constant T'Base := Index_Type'Pos (A'First) + J - T'(1); begin - return Container (I) < Container (J); - end Is_Less; + return Index_Type'Val (K); + end To_Index; + + Max : T := A'Length; + Temp : Element_Type; ---------- - -- Sort -- + -- Sift -- ---------- - procedure Sort (First, Last : Index_Type'Base) is - Pivot, Lo, Mid, Hi : Index_Type; + procedure Sift (S : T) is + C : T := S; + Son : T; begin - if Last <= First then - return; - end if; - - Lo := First; - Hi := Last; - - if Last = Index_Type'Succ (First) then - if not Is_Less (Lo, Hi) then - Swap (Lo, Hi); - end if; - - return; - end if; - - Mid := Index_Type'Val - (Index_Type'Pos (Lo) + - (Index_Type'Pos (Hi) - Index_Type'Pos (Lo)) / 2); - - -- We need to figure out which case we have: - -- x < y < z - -- x < z < y - -- z < x < y - -- y < x < z - -- y < z < x - -- z < y < x - - if Is_Less (Lo, Mid) then - if Is_Less (Lo, Hi) then - if Is_Less (Mid, Hi) then - Swap (Lo, Mid); - else - Swap (Lo, Hi); - end if; + loop + Son := 2 * C; - else - null; -- lo is median - end if; + exit when Son > Max; - elsif Is_Less (Lo, Hi) then - null; -- lo is median + declare + Son_Index : Index_Type := To_Index (Son); - elsif Is_Less (Mid, Hi) then - Swap (Lo, Hi); - - else - Swap (Lo, Mid); - end if; + begin + if Son < Max then + if A (Son_Index) < A (Index_Type'Succ (Son_Index)) then + Son := Son + 1; + Son_Index := Index_Type'Succ (Son_Index); + end if; + end if; - Pivot := Lo; + A (To_Index (C)) := A (Son_Index); -- Move (Son, C); + end; - Outer : loop - loop - exit Outer when not (Pivot < Hi); + C := Son; + end loop; - if Is_Less (Hi, Pivot) then - Swap (Hi, Pivot); - Pivot := Hi; - Lo := Index_Type'Succ (Lo); - exit; - else - Hi := Index_Type'Pred (Hi); - end if; - end loop; + while C /= S loop + declare + Father : constant T := C / 2; + Father_Elem : Element_Type renames A (To_Index (Father)); - loop - exit Outer when not (Lo < Pivot); + begin + if Father_Elem < Temp then -- Lt (Father, 0) + A (To_Index (C)) := Father_Elem; -- Move (Father, C) + C := Father; - if Is_Less (Lo, Pivot) then - Lo := Index_Type'Succ (Lo); else - Swap (Lo, Pivot); - Pivot := Lo; - Hi := Index_Type'Pred (Hi); exit; end if; - end loop; - end loop Outer; - - Sort (First, Index_Type'Pred (Pivot)); - Sort (Index_Type'Succ (Pivot), Last); - end Sort; + end; + end loop; - ---------- - -- Swap -- - ---------- - - procedure Swap (I, J : Index_Type) is - EI : constant Element_Type := Container (I); - begin - Container (I) := Container (J); - Container (J) := EI; - end Swap; + A (To_Index (C)) := Temp; -- Move (0, C); + end Sift; -- Start of processing for Generic_Constrained_Array_Sort begin - Sort (Container'First, Container'Last); + for J in reverse 1 .. Max / 2 loop + Temp := Container (To_Index (J)); -- Move (J, 0); + Sift (J); + end loop; + + while Max > 1 loop + declare + Max_Elem : Element_Type renames A (To_Index (Max)); + begin + Temp := Max_Elem; -- Move (Max, 0); + Max_Elem := A (A'First); -- Move (1, Max); + end; + + Max := Max - 1; + Sift (1); + end loop; end Ada.Containers.Generic_Constrained_Array_Sort; -- 2.30.2