@@ -675,68 +675,152 @@ is
procedure Sort (Container : in out List) is
- procedure Partition (Pivot : Node_Access; Back : Node_Access);
-
- procedure Sort (Front, Back : Node_Access);
-
- ---------------
- -- Partition --
- ---------------
+ type List_Descriptor is
+ record
+ First, Last : Node_Access;
+ Length : Count_Type;
+ end record;
+
+ function Merge_Sort (Arg : List_Descriptor) return List_Descriptor;
+ -- Sort list of given length using MergeSort; length must be >= 2.
+ -- As required by RM, the sort is stable.
+
+ ----------------
+ -- Merge_Sort --
+ ----------------
+
+ function Merge_Sort (Arg : List_Descriptor) return List_Descriptor
+ is
+ procedure Split_List
+ (Unsplit : List_Descriptor; Part1, Part2 : out List_Descriptor);
+ -- Split list into two parts for divide-and-conquer.
+ -- Unsplit.Length must be >= 2.
+
+ function Merge_Parts
+ (Part1, Part2 : List_Descriptor) return List_Descriptor;
+ -- Merge two sorted lists, preserving sorted property.
+
+ ----------------
+ -- Split_List --
+ ----------------
+
+ procedure Split_List
+ (Unsplit : List_Descriptor; Part1, Part2 : out List_Descriptor)
+ is
+ Rover : Node_Access := Unsplit.First;
+ Bump_Count : constant Count_Type := (Unsplit.Length - 1) / 2;
+ begin
+ for Iter in 1 .. Bump_Count loop
+ Rover := Rover.Next;
+ end loop;
+
+ Part1 := (First => Unsplit.First,
+ Last => Rover,
+ Length => Bump_Count + 1);
+
+ Part2 := (First => Rover.Next,
+ Last => Unsplit.Last,
+ Length => Unsplit.Length - Part1.Length);
+
+ -- Detach
+ Part1.Last.Next := null;
+ Part2.First.Prev := null;
+ end Split_List;
+
+ -----------------
+ -- Merge_Parts --
+ -----------------
+
+ function Merge_Parts
+ (Part1, Part2 : List_Descriptor) return List_Descriptor
+ is
+ Empty : constant List_Descriptor := (null, null, 0);
+
+ procedure Detach_First (Source : in out List_Descriptor;
+ Detached : out Node_Access);
+ -- Detach the first element from a non-empty list and
+ -- return the detached node via the Detached parameter.
+
+ ------------------
+ -- Detach_First --
+ ------------------
+
+ procedure Detach_First (Source : in out List_Descriptor;
+ Detached : out Node_Access) is
+ begin
+ Detached := Source.First;
+
+ if Source.Length = 1 then
+ Source := Empty;
+ else
+ Source := (Source.First.Next,
+ Source.Last,
+ Source.Length - 1);
+
+ Detached.Next.Prev := null;
+ Detached.Next := null;
+ end if;
+ end Detach_First;
+
+ P1 : List_Descriptor := Part1;
+ P2 : List_Descriptor := Part2;
+ Merged : List_Descriptor := Empty;
+
+ Take_From_P2 : Boolean;
+ Detached : Node_Access;
+
+ -- Start of processing for Merge_Parts
- procedure Partition (Pivot : Node_Access; Back : Node_Access) is
- Node : Node_Access;
+ begin
+ while (P1.Length /= 0) or (P2.Length /= 0) loop
+ if P1.Length = 0 then
+ Take_From_P2 := True;
+ elsif P2.Length = 0 then
+ Take_From_P2 := False;
+ else
+ -- If the compared elements are equal then Take_From_P2
+ -- must be False in order to ensure stability.
+
+ Take_From_P2 := P2.First.Element < P1.First.Element;
+ end if;
+
+ if Take_From_P2 then
+ Detach_First (P2, Detached);
+ else
+ Detach_First (P1, Detached);
+ end if;
+
+ if Merged.Length = 0 then
+ Merged := (First | Last => Detached, Length => 1);
+ else
+ Detached.Prev := Merged.Last;
+ Merged.Last.Next := Detached;
+ Merged.Last := Detached;
+ Merged.Length := Merged.Length + 1;
+ end if;
+ end loop;
+ return Merged;
+ end Merge_Parts;
+
+ -- Start of processing for Merge_Sort
begin
- Node := Pivot.Next;
- while Node /= Back loop
- if Node.Element < Pivot.Element 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;
+ if Arg.Length < 2 then
+ -- already sorted
+ return Arg;
+ end if;
- else
- Node := Node.Next;
- end if;
- end loop;
- end Partition;
+ declare
+ Part1, Part2 : List_Descriptor;
+ begin
+ Split_List (Unsplit => Arg, Part1 => Part1, Part2 => Part2);
- ----------
- -- Sort --
- ----------
+ Part1 := Merge_Sort (Part1);
+ Part2 := Merge_Sort (Part2);
- 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;
+ return Merge_Parts (Part1, Part2);
+ end;
+ end Merge_Sort;
-- Start of processing for Sort
@@ -754,9 +838,28 @@ is
-- element tampering by a generic actual subprogram.
declare
- Lock : With_Lock (Container.TC'Unchecked_Access);
+ Lock : With_Lock (Container.TC'Unchecked_Access);
+
+ Unsorted : constant List_Descriptor :=
+ (First => Container.First,
+ Last => Container.Last,
+ Length => Container.Length);
+
+ Sorted : List_Descriptor;
begin
- Sort (Front => null, Back => null);
+ -- If a call to the formal < operator references the container
+ -- during sorting, seeing an empty container seems preferable
+ -- to seeing an internally inconsistent container.
+ --
+ Container.First := null;
+ Container.Last := null;
+ Container.Length := 0;
+
+ Sorted := Merge_Sort (Unsorted);
+
+ Container.First := Sorted.First;
+ Container.Last := Sorted.Last;
+ Container.Length := Sorted.Length;
end;
pragma Assert (Container.First.Prev = null);