1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.INDEFINITE_DOUBLY_LINKED_LISTS --
9 -- Copyright (C) 2004 Free Software Foundation, Inc. --
11 -- This specification is derived from the Ada Reference Manual for use with --
12 -- GNAT. The copyright notice above, and the license provisions that follow --
13 -- apply solely to the contents of the part following the private keyword. --
15 -- GNAT is free software; you can redistribute it and/or modify it under --
16 -- terms of the GNU General Public License as published by the Free Soft- --
17 -- ware Foundation; either version 2, or (at your option) any later ver- --
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
20 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
21 -- for more details. You should have received a copy of the GNU General --
22 -- Public License distributed with GNAT; see file COPYING. If not, write --
23 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
24 -- MA 02111-1307, USA. --
26 -- As a special exception, if other files instantiate generics from this --
27 -- unit, or you link this unit with other files to produce an executable, --
28 -- this unit does not by itself cause the resulting executable to be --
29 -- covered by the GNU General Public License. This exception does not --
30 -- however invalidate any other reasons why the executable file might be --
31 -- covered by the GNU Public License. --
33 -- This unit was originally developed by Matthew J Heaney. --
34 ------------------------------------------------------------------------------
36 with System; use type System.Address;
37 with Ada.Unchecked_Deallocation;
39 package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
42 new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
45 new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
47 -----------------------
48 -- Local Subprograms --
49 -----------------------
52 (Container : in out List;
53 Node : in out Node_Access);
55 procedure Insert_Internal
56 (Container : in out List;
58 New_Node : Node_Access);
64 function "=" (Left, Right : List) return Boolean is
69 if Left'Address = Right'Address then
73 if Left.Length /= Right.Length then
79 for J in 1 .. Left.Length loop
80 if L.Element = null then
81 if R.Element /= null then
85 elsif R.Element = null then
88 elsif L.Element.all /= R.Element.all then
103 procedure Adjust (Container : in out List) is
104 Src : Node_Access := Container.First;
109 pragma Assert (Container.Last = null);
110 pragma Assert (Container.Length = 0);
114 pragma Assert (Container.First.Prev = null);
115 pragma Assert (Container.Last.Next = null);
116 pragma Assert (Container.Length > 0);
118 Container.First := null;
119 Container.Last := null;
120 Container.Length := 0;
122 Dst := new Node_Type'(null, null, null);
124 if Src.Element /= null then
126 Dst.Element := new Element_Type'(Src.Element.all);
134 Container.First := Dst;
136 Container.Last := Dst;
138 Container.Length := Container.Length + 1;
140 exit when Src = null;
142 Dst := new Node_Type'(null, Prev => Container.Last, Next => null);
144 if Src.Element /= null then
146 Dst.Element := new Element_Type'(Src.Element.all);
154 Container.Last.Next := Dst;
155 Container.Last := Dst;
164 (Container : in out List;
165 New_Item : Element_Type;
166 Count : Count_Type := 1)
169 Insert (Container, No_Element, New_Item, Count);
176 procedure Clear (Container : in out List) is
178 Delete_Last (Container, Count => Container.Length);
187 Item : Element_Type) return Boolean is
189 return Find (Container, Item) /= No_Element;
197 (Container : in out List;
198 Position : in out Cursor;
199 Count : Count_Type := 1)
202 if Position = No_Element then
206 if Position.Container /= List_Access'(Container'Unchecked_Access) then
210 for Index in 1 .. Count loop
211 Delete_Node (Container, Position.Node);
213 if Position.Node = null then
214 Position.Container := null;
224 procedure Delete_First
225 (Container : in out List;
226 Count : Count_Type := 1)
228 Node : Node_Access := Container.First;
230 for J in 1 .. Count_Type'Min (Count, Container.Length) loop
231 Delete_Node (Container, Node);
239 procedure Delete_Last
240 (Container : in out List;
241 Count : Count_Type := 1)
245 for J in 1 .. Count_Type'Min (Count, Container.Length) loop
246 Node := Container.Last;
247 Delete_Node (Container, Node);
255 procedure Delete_Node
256 (Container : in out List;
257 Node : in out Node_Access)
259 X : Node_Access := Node;
263 Container.Length := Container.Length - 1;
265 if X = Container.First then
266 Container.First := X.Next;
268 if X = Container.Last then
269 pragma Assert (Container.First = null);
270 pragma Assert (Container.Length = 0);
271 Container.Last := null;
273 pragma Assert (Container.Length > 0);
274 Container.First.Prev := null;
277 elsif X = Container.Last then
278 pragma Assert (Container.Length > 0);
280 Container.Last := X.Prev;
281 Container.Last.Next := null;
284 pragma Assert (Container.Length > 0);
286 X.Next.Prev := X.Prev;
287 X.Prev.Next := X.Next;
299 function Element (Position : Cursor) return Element_Type is
301 return Position.Node.Element.all;
311 Position : Cursor := No_Element) return Cursor
313 Node : Node_Access := Position.Node;
317 Node := Container.First;
318 elsif Position.Container /= List_Access'(Container'Unchecked_Access) then
322 while Node /= null loop
323 if Node.Element /= null
324 and then Node.Element.all = Item
326 return Cursor'(Container'Unchecked_Access, Node);
339 function First (Container : List) return Cursor is
341 if Container.First = null then
345 return Cursor'(Container'Unchecked_Access, Container.First);
352 function First_Element (Container : List) return Element_Type is
354 return Container.First.Element.all;
361 procedure Generic_Merge
362 (Target : in out List;
363 Source : in out List)
369 if Target'Address = Source'Address then
373 LI := First (Target);
374 RI := First (Source);
375 while RI.Node /= null loop
376 if LI.Node = null then
377 Splice (Target, No_Element, Source);
381 if LI.Node.Element = null then
382 LI.Node := LI.Node.Next;
384 elsif RI.Node.Element = null
385 or else RI.Node.Element.all < LI.Node.Element.all
388 RJ : constant Cursor := RI;
390 RI.Node := RI.Node.Next;
391 Splice (Target, LI, Source, RJ);
395 LI.Node := LI.Node.Next;
404 procedure Generic_Sort (Container : in out List) is
405 procedure Partition (Pivot : Node_Access; Back : Node_Access);
407 procedure Sort (Front, Back : Node_Access);
413 procedure Partition (Pivot : Node_Access; Back : Node_Access) is
414 Node : Node_Access := Pivot.Next;
417 while Node /= Back loop
418 if Pivot.Element = null then
421 elsif Node.Element = null
422 or else Node.Element.all < Pivot.Element.all
425 Prev : constant Node_Access := Node.Prev;
426 Next : constant Node_Access := Node.Next;
431 Container.Last := Prev;
437 Node.Prev := Pivot.Prev;
441 if Node.Prev = null then
442 Container.First := Node;
444 Node.Prev.Next := Node;
460 procedure Sort (Front, Back : Node_Access) is
465 Pivot := Container.First;
470 if Pivot /= Back then
471 Partition (Pivot, Back);
477 -- Start of processing for Generic_Sort
480 Sort (Front => null, Back => null);
482 pragma Assert (Container.Length = 0
483 or else (Container.First.Prev = null
484 and Container.Last.Next = null));
491 function Has_Element (Position : Cursor) return Boolean is
493 return Position.Container /= null and then Position.Node /= null;
501 (Container : in out List;
503 New_Item : Element_Type;
504 Position : out Cursor;
505 Count : Count_Type := 1)
507 New_Node : Node_Access;
510 if Before.Container /= null
511 and then Before.Container /= List_Access'(Container'Unchecked_Access)
522 Element : Element_Access := new Element_Type'(New_Item);
524 New_Node := new Node_Type'(Element, null, null);
531 Insert_Internal (Container, Before.Node, New_Node);
532 Position := Cursor'(Before.Container, New_Node);
534 for J in Count_Type'(2) .. Count loop
537 Element : Element_Access := new Element_Type'(New_Item);
539 New_Node := new Node_Type'(Element, null, null);
546 Insert_Internal (Container, Before.Node, New_Node);
551 (Container : in out List;
553 New_Item : Element_Type;
554 Count : Count_Type := 1)
558 Insert (Container, Before, New_Item, Position, Count);
561 ---------------------
562 -- Insert_Internal --
563 ---------------------
565 procedure Insert_Internal
566 (Container : in out List;
567 Before : Node_Access;
568 New_Node : Node_Access)
571 if Container.Length = 0 then
572 pragma Assert (Before = null);
573 pragma Assert (Container.First = null);
574 pragma Assert (Container.Last = null);
576 Container.First := New_Node;
577 Container.Last := New_Node;
579 elsif Before = null then
580 pragma Assert (Container.Last.Next = null);
582 Container.Last.Next := New_Node;
583 New_Node.Prev := Container.Last;
585 Container.Last := New_Node;
587 elsif Before = Container.First then
588 pragma Assert (Container.First.Prev = null);
590 Container.First.Prev := New_Node;
591 New_Node.Next := Container.First;
593 Container.First := New_Node;
596 pragma Assert (Container.First.Prev = null);
597 pragma Assert (Container.Last.Next = null);
599 New_Node.Next := Before;
600 New_Node.Prev := Before.Prev;
602 Before.Prev.Next := New_Node;
603 Before.Prev := New_Node;
606 Container.Length := Container.Length + 1;
613 function Is_Empty (Container : List) return Boolean is
615 return Container.Length = 0;
624 Process : not null access procedure (Position : in Cursor))
626 Node : Node_Access := Container.First;
628 while Node /= null loop
629 Process (Cursor'(Container'Unchecked_Access, Node));
638 procedure Move (Target : in out List; Source : in out List) is
640 if Target'Address = Source'Address then
644 if Target.Length > 0 then
645 raise Constraint_Error;
648 Target.First := Source.First;
649 Source.First := null;
651 Target.Last := Source.Last;
654 Target.Length := Source.Length;
662 function Last (Container : List) return Cursor is
664 if Container.Last = null then
668 return Cursor'(Container'Unchecked_Access, Container.Last);
675 function Last_Element (Container : List) return Element_Type is
677 return Container.Last.Element.all;
684 function Length (Container : List) return Count_Type is
686 return Container.Length;
693 procedure Next (Position : in out Cursor) is
695 if Position.Node = null then
699 Position.Node := Position.Node.Next;
701 if Position.Node = null then
702 Position.Container := null;
706 function Next (Position : Cursor) return Cursor is
708 if Position.Node = null then
713 Next_Node : constant Node_Access := Position.Node.Next;
715 if Next_Node = null then
719 return Cursor'(Position.Container, Next_Node);
728 (Container : in out List;
729 New_Item : Element_Type;
730 Count : Count_Type := 1)
733 Insert (Container, First (Container), New_Item, Count);
740 procedure Previous (Position : in out Cursor) is
742 if Position.Node = null then
746 Position.Node := Position.Node.Prev;
748 if Position.Node = null then
749 Position.Container := null;
753 function Previous (Position : Cursor) return Cursor is
755 if Position.Node = null then
760 Prev_Node : constant Node_Access := Position.Node.Prev;
762 if Prev_Node = null then
766 return Cursor'(Position.Container, Prev_Node);
774 procedure Query_Element
776 Process : not null access procedure (Element : in Element_Type))
779 Process (Position.Node.Element.all);
787 (Stream : access Root_Stream_Type'Class;
796 Count_Type'Base'Read (Stream, N);
805 X.Element := new Element_Type'(Element_Type'Input (Stream));
816 Item.Length := Item.Length + 1;
817 exit when Item.Length = N;
822 X.Element := new Element_Type'(Element_Type'Input (Stream));
835 ---------------------
836 -- Replace_Element --
837 ---------------------
839 procedure Replace_Element
843 X : Element_Access := Position.Node.Element;
845 Position.Node.Element := new Element_Type'(By);
853 function Reverse_Find
856 Position : Cursor := No_Element) return Cursor
858 Node : Node_Access := Position.Node;
862 Node := Container.Last;
863 elsif Position.Container /= List_Access'(Container'Unchecked_Access) then
867 while Node /= null loop
868 if Node.Element /= null
869 and then Node.Element.all = Item
871 return Cursor'(Container'Unchecked_Access, Node);
880 ---------------------
881 -- Reverse_Iterate --
882 ---------------------
884 procedure Reverse_Iterate
886 Process : not null access procedure (Position : in Cursor))
888 Node : Node_Access := Container.Last;
891 while Node /= null loop
892 Process (Cursor'(Container'Unchecked_Access, Node));
901 procedure Reverse_List (Container : in out List) is
902 I : Node_Access := Container.First;
903 J : Node_Access := Container.Last;
905 procedure Swap (L, R : Node_Access);
911 procedure Swap (L, R : Node_Access) is
912 LN : constant Node_Access := L.Next;
913 LP : constant Node_Access := L.Prev;
915 RN : constant Node_Access := R.Next;
916 RP : constant Node_Access := R.Prev;
931 pragma Assert (RP = L);
945 -- Start of processing for Reverse_List
948 if Container.Length <= 1 then
952 Container.First := J;
955 Swap (L => I, R => J);
963 Swap (L => J, R => I);
972 pragma Assert (Container.First.Prev = null);
973 pragma Assert (Container.Last.Next = null);
981 (Target : in out List;
983 Source : in out List)
986 if Before.Container /= null
987 and then Before.Container /= List_Access'(Target'Unchecked_Access)
992 if Target'Address = Source'Address
993 or else Source.Length = 0
998 if Target.Length = 0 then
999 pragma Assert (Before = No_Element);
1001 Target.First := Source.First;
1002 Target.Last := Source.Last;
1004 elsif Before.Node = null then
1005 pragma Assert (Target.Last.Next = null);
1007 Target.Last.Next := Source.First;
1008 Source.First.Prev := Target.Last;
1010 Target.Last := Source.Last;
1012 elsif Before.Node = Target.First then
1013 pragma Assert (Target.First.Prev = null);
1015 Source.Last.Next := Target.First;
1016 Target.First.Prev := Source.Last;
1018 Target.First := Source.First;
1021 Before.Node.Prev.Next := Source.First;
1022 Source.First.Prev := Before.Node.Prev;
1024 Before.Node.Prev := Source.Last;
1025 Source.Last.Next := Before.Node;
1028 Source.First := null;
1029 Source.Last := null;
1031 Target.Length := Target.Length + Source.Length;
1036 (Target : in out List;
1040 X : Node_Access := Position.Node;
1043 if Before.Container /= null
1044 and then Before.Container /= List_Access'(Target'Unchecked_Access)
1046 raise Program_Error;
1049 if Position.Container /= null
1050 and then Position.Container /= List_Access'(Target'Unchecked_Access)
1052 raise Program_Error;
1056 or else X = Before.Node
1057 or else X.Next = Before.Node
1062 pragma Assert (Target.Length > 0);
1064 if Before.Node = null then
1065 pragma Assert (X /= Target.Last);
1067 if X = Target.First then
1068 Target.First := X.Next;
1069 Target.First.Prev := null;
1071 X.Prev.Next := X.Next;
1072 X.Next.Prev := X.Prev;
1075 Target.Last.Next := X;
1076 X.Prev := Target.Last;
1079 Target.Last.Next := null;
1084 if Before.Node = Target.First then
1085 pragma Assert (X /= Target.First);
1087 if X = Target.Last then
1088 Target.Last := X.Prev;
1089 Target.Last.Next := null;
1091 X.Prev.Next := X.Next;
1092 X.Next.Prev := X.Prev;
1095 Target.First.Prev := X;
1096 X.Next := Target.First;
1099 Target.First.Prev := null;
1104 if X = Target.First then
1105 Target.First := X.Next;
1106 Target.First.Prev := null;
1108 elsif X = Target.Last then
1109 Target.Last := X.Prev;
1110 Target.Last.Next := null;
1113 X.Prev.Next := X.Next;
1114 X.Next.Prev := X.Prev;
1117 Before.Node.Prev.Next := X;
1118 X.Prev := Before.Node.Prev;
1120 Before.Node.Prev := X;
1121 X.Next := Before.Node;
1125 (Target : in out List;
1127 Source : in out List;
1130 X : Node_Access := Position.Node;
1133 if Target'Address = Source'Address then
1134 Splice (Target, Before, Position);
1138 if Before.Container /= null
1139 and then Before.Container /= List_Access'(Target'Unchecked_Access)
1141 raise Program_Error;
1144 if Position.Container /= null
1145 and then Position.Container /= List_Access'(Source'Unchecked_Access)
1147 raise Program_Error;
1154 pragma Assert (Source.Length > 0);
1155 pragma Assert (Source.First.Prev = null);
1156 pragma Assert (Source.Last.Next = null);
1158 if X = Source.First then
1159 Source.First := X.Next;
1160 Source.First.Prev := null;
1162 if X = Source.Last then
1163 pragma Assert (Source.First = null);
1164 pragma Assert (Source.Length = 1);
1165 Source.Last := null;
1168 elsif X = Source.Last then
1169 Source.Last := X.Prev;
1170 Source.Last.Next := null;
1173 X.Prev.Next := X.Next;
1174 X.Next.Prev := X.Prev;
1177 if Target.Length = 0 then
1178 pragma Assert (Before = No_Element);
1179 pragma Assert (Target.First = null);
1180 pragma Assert (Target.Last = null);
1185 elsif Before.Node = null then
1186 Target.Last.Next := X;
1187 X.Next := Target.Last;
1190 Target.Last.Next := null;
1192 elsif Before.Node = Target.First then
1193 Target.First.Prev := X;
1194 X.Next := Target.First;
1197 Target.First.Prev := null;
1200 Before.Node.Prev.Next := X;
1201 X.Prev := Before.Node.Prev;
1203 Before.Node.Prev := X;
1204 X.Next := Before.Node;
1207 Target.Length := Target.Length + 1;
1208 Source.Length := Source.Length - 1;
1215 procedure Swap (I, J : Cursor) is
1217 -- Is this op legal when I and J designate elements in different
1218 -- containers, or should it raise an exception (e.g. Program_Error).
1220 EI : constant Element_Access := I.Node.Element;
1223 I.Node.Element := J.Node.Element;
1224 J.Node.Element := EI;
1231 procedure Swap_Links
1232 (Container : in out List;
1237 or else J = No_Element
1239 raise Constraint_Error;
1242 if I.Container /= List_Access'(Container'Unchecked_Access) then
1243 raise Program_Error;
1246 if J.Container /= I.Container then
1247 raise Program_Error;
1250 pragma Assert (Container.Length >= 1);
1252 if I.Node = J.Node then
1256 pragma Assert (Container.Length >= 2);
1259 I_Next : constant Cursor := Next (I);
1263 Splice (Container, Before => I, Position => J);
1267 J_Next : constant Cursor := Next (J);
1270 Splice (Container, Before => J, Position => I);
1273 pragma Assert (Container.Length >= 3);
1275 Splice (Container, Before => I_Next, Position => J);
1276 Splice (Container, Before => J_Next, Position => I);
1283 --------------------
1284 -- Update_Element --
1285 --------------------
1287 procedure Update_Element
1289 Process : not null access procedure (Element : in out Element_Type))
1292 Process (Position.Node.Element.all);
1300 (Stream : access Root_Stream_Type'Class;
1303 Node : Node_Access := Item.First;
1305 Count_Type'Base'Write (Stream, Item.Length);
1306 while Node /= null loop
1307 Element_Type'Output (Stream, Node.Element.all); -- X.all
1312 end Ada.Containers.Indefinite_Doubly_Linked_Lists;