From 3598c8db4045d17705f845561517f74bf877a2e4 Mon Sep 17 00:00:00 2001
From: Steve Baird <baird@adacore.com>
Date: Wed, 30 Jun 2021 16:42:54 -0700
Subject: [Ada] Refactor sort procedures of doubly linked list containers

gcc/ada/

	* libgnat/a-costso.ads, libgnat/a-costso.adb: A new library
	unit, Ada.Containers.Stable_Sorting, which exports a pair of
	generics (one within the other) which are instantiated by each
	of the 5 doubly-linked list container generics to implement
	their respective Sort procedures. We use a pair of generics,
	rather than a single generic, in order to further reduce code
	duplication. The outer generic takes a formal private Node_Ref
	type representing a reference to a linked list element. For some
	instances, the corresponding actual parameter will be an access
	type; for others, it will be the index type for an array.
	* Makefile.rtl: Include new Ada.Containers.Stable_Sorting unit.
	* libgnat/a-cbdlli.adb, libgnat/a-cdlili.adb,
	libgnat/a-cfdlli.adb, libgnat/a-cidlli.adb, libgnat/a-crdlli.adb
	(Sort): Replace existing Sort implementation with a call to an
	instance of
	Ada.Containers.Stable_Sorting.Doubly_Linked_List_Sort. Declare
	the (trivial) actual parameters needed to declare that instance.
	* libgnat/a-cfdlli.ads: Fix a bug encountered during testing in
	the postcondition for M_Elements_Sorted. With a partial
	ordering, it is possible for all three of (X < Y), (Y < X),
	and (X = Y) to be simultaneously false, so that case needs to
	handled correctly.
---
 gcc/ada/libgnat/a-cidlli.adb | 105 +++++++++++++++----------------------------
 1 file changed, 37 insertions(+), 68 deletions(-)

(limited to 'gcc/ada/libgnat/a-cidlli.adb')

diff --git a/gcc/ada/libgnat/a-cidlli.adb b/gcc/ada/libgnat/a-cidlli.adb
index 3fc57da..1cf9401 100644
--- a/gcc/ada/libgnat/a-cidlli.adb
+++ b/gcc/ada/libgnat/a-cidlli.adb
@@ -29,6 +29,8 @@
 
 with Ada.Unchecked_Deallocation;
 
+with Ada.Containers.Stable_Sorting; use Ada.Containers.Stable_Sorting;
+
 with System; use type System.Address;
 with System.Put_Images;
 
@@ -731,73 +733,6 @@ is
       ----------
 
       procedure Sort (Container : in out List) is
-         procedure Partition (Pivot : Node_Access; Back  : Node_Access);
-         --  Comment ???
-
-         procedure Sort (Front, Back : Node_Access);
-         --  Comment??? Confusing name??? change name???
-
-         ---------------
-         -- Partition --
-         ---------------
-
-         procedure Partition (Pivot : Node_Access; Back : Node_Access) is
-            Node : Node_Access;
-
-         begin
-            Node := Pivot.Next;
-            while Node /= Back loop
-               if Node.Element.all < Pivot.Element.all then
-                  declare
-                     Prev : constant Node_Access := Node.Prev;
-                     Next : constant Node_Access := Node.Next;
-
-                  begin
-                     Prev.Next := Next;
-
-                     if Next = null then
-                        Container.Last := Prev;
-                     else
-                        Next.Prev := Prev;
-                     end if;
-
-                     Node.Next := Pivot;
-                     Node.Prev := Pivot.Prev;
-
-                     Pivot.Prev := Node;
-
-                     if Node.Prev = null then
-                        Container.First := Node;
-                     else
-                        Node.Prev.Next := Node;
-                     end if;
-
-                     Node := Next;
-                  end;
-
-               else
-                  Node := Node.Next;
-               end if;
-            end loop;
-         end Partition;
-
-         ----------
-         -- Sort --
-         ----------
-
-         procedure Sort (Front, Back : Node_Access) is
-            Pivot : constant Node_Access :=
-              (if Front = null then Container.First else Front.Next);
-         begin
-            if Pivot /= Back then
-               Partition (Pivot, Back);
-               Sort (Front, Pivot);
-               Sort (Pivot, Back);
-            end if;
-         end Sort;
-
-      --  Start of processing for Sort
-
       begin
          if Container.Length <= 1 then
             return;
@@ -813,8 +748,42 @@ is
 
          declare
             Lock : With_Lock (Container.TC'Unchecked_Access);
+
+            package Descriptors is new List_Descriptors
+              (Node_Ref => Node_Access, Nil => null);
+            use Descriptors;
+
+            function Next (N : Node_Access) return Node_Access is (N.Next);
+            procedure Set_Next (N : Node_Access; Next : Node_Access)
+              with Inline;
+            procedure Set_Prev (N : Node_Access; Prev : Node_Access)
+              with Inline;
+            function "<" (L, R : Node_Access) return Boolean is
+              (L.Element.all < R.Element.all);
+            procedure Update_Container (List : List_Descriptor) with Inline;
+
+            procedure Set_Next (N : Node_Access; Next : Node_Access) is
+            begin
+               N.Next := Next;
+            end Set_Next;
+
+            procedure Set_Prev (N : Node_Access; Prev : Node_Access) is
+            begin
+               N.Prev := Prev;
+            end Set_Prev;
+
+            procedure Update_Container (List : List_Descriptor) is
+            begin
+               Container.First  := List.First;
+               Container.Last   := List.Last;
+               Container.Length := List.Length;
+            end Update_Container;
+
+            procedure Sort_List is new Doubly_Linked_List_Sort;
          begin
-            Sort (Front => null, Back => null);
+            Sort_List (List_Descriptor'(First  => Container.First,
+                                        Last   => Container.Last,
+                                        Length => Container.Length));
          end;
 
          pragma Assert (Container.First.Prev = null);
-- 
cgit v1.1