1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- A D A . C O N T A I N E R S . D O U B L Y _ L I N K E D _ L I S T S -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 2004-2015, Free Software Foundation, Inc. -- 10-- -- 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. -- 14-- -- 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 3, 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. -- 21-- -- 22-- As a special exception under Section 7 of GPL version 3, you are granted -- 23-- additional permissions described in the GCC Runtime Library Exception, -- 24-- version 3.1, as published by the Free Software Foundation. -- 25-- -- 26-- You should have received a copy of the GNU General Public License and -- 27-- a copy of the GCC Runtime Library Exception along with this program; -- 28-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 29-- <http://www.gnu.org/licenses/>. -- 30-- -- 31-- This unit was originally developed by Matthew J Heaney. -- 32------------------------------------------------------------------------------ 33 34with Ada.Iterator_Interfaces; 35 36with Ada.Containers.Helpers; 37private with Ada.Finalization; 38private with Ada.Streams; 39 40generic 41 type Element_Type is private; 42 43 with function "=" (Left, Right : Element_Type) 44 return Boolean is <>; 45 46package Ada.Containers.Doubly_Linked_Lists is 47 pragma Annotate (CodePeer, Skip_Analysis); 48 pragma Preelaborate; 49 pragma Remote_Types; 50 51 type List is tagged private 52 with 53 Constant_Indexing => Constant_Reference, 54 Variable_Indexing => Reference, 55 Default_Iterator => Iterate, 56 Iterator_Element => Element_Type; 57 58 pragma Preelaborable_Initialization (List); 59 60 type Cursor is private; 61 pragma Preelaborable_Initialization (Cursor); 62 63 Empty_List : constant List; 64 65 No_Element : constant Cursor; 66 67 function Has_Element (Position : Cursor) return Boolean; 68 69 package List_Iterator_Interfaces is new 70 Ada.Iterator_Interfaces (Cursor, Has_Element); 71 72 function "=" (Left, Right : List) return Boolean; 73 74 function Length (Container : List) return Count_Type; 75 76 function Is_Empty (Container : List) return Boolean; 77 78 procedure Clear (Container : in out List); 79 80 function Element (Position : Cursor) return Element_Type; 81 82 procedure Replace_Element 83 (Container : in out List; 84 Position : Cursor; 85 New_Item : Element_Type); 86 87 procedure Query_Element 88 (Position : Cursor; 89 Process : not null access procedure (Element : Element_Type)); 90 91 procedure Update_Element 92 (Container : in out List; 93 Position : Cursor; 94 Process : not null access procedure (Element : in out Element_Type)); 95 96 type Constant_Reference_Type 97 (Element : not null access constant Element_Type) is private 98 with 99 Implicit_Dereference => Element; 100 101 type Reference_Type 102 (Element : not null access Element_Type) is private 103 with 104 Implicit_Dereference => Element; 105 106 function Constant_Reference 107 (Container : aliased List; 108 Position : Cursor) return Constant_Reference_Type; 109 pragma Inline (Constant_Reference); 110 111 function Reference 112 (Container : aliased in out List; 113 Position : Cursor) return Reference_Type; 114 pragma Inline (Reference); 115 116 procedure Assign (Target : in out List; Source : List); 117 118 function Copy (Source : List) return List; 119 120 procedure Move 121 (Target : in out List; 122 Source : in out List); 123 124 procedure Insert 125 (Container : in out List; 126 Before : Cursor; 127 New_Item : Element_Type; 128 Count : Count_Type := 1); 129 130 procedure Insert 131 (Container : in out List; 132 Before : Cursor; 133 New_Item : Element_Type; 134 Position : out Cursor; 135 Count : Count_Type := 1); 136 137 procedure Insert 138 (Container : in out List; 139 Before : Cursor; 140 Position : out Cursor; 141 Count : Count_Type := 1); 142 143 procedure Prepend 144 (Container : in out List; 145 New_Item : Element_Type; 146 Count : Count_Type := 1); 147 148 procedure Append 149 (Container : in out List; 150 New_Item : Element_Type; 151 Count : Count_Type := 1); 152 153 procedure Delete 154 (Container : in out List; 155 Position : in out Cursor; 156 Count : Count_Type := 1); 157 158 procedure Delete_First 159 (Container : in out List; 160 Count : Count_Type := 1); 161 162 procedure Delete_Last 163 (Container : in out List; 164 Count : Count_Type := 1); 165 166 procedure Reverse_Elements (Container : in out List); 167 168 function Iterate (Container : List) 169 return List_Iterator_Interfaces.Reversible_Iterator'Class; 170 171 function Iterate (Container : List; Start : Cursor) 172 return List_Iterator_Interfaces.Reversible_Iterator'Class; 173 174 procedure Swap 175 (Container : in out List; 176 I, J : Cursor); 177 178 procedure Swap_Links 179 (Container : in out List; 180 I, J : Cursor); 181 182 procedure Splice 183 (Target : in out List; 184 Before : Cursor; 185 Source : in out List); 186 187 procedure Splice 188 (Target : in out List; 189 Before : Cursor; 190 Source : in out List; 191 Position : in out Cursor); 192 193 procedure Splice 194 (Container : in out List; 195 Before : Cursor; 196 Position : Cursor); 197 198 function First (Container : List) return Cursor; 199 200 function First_Element (Container : List) return Element_Type; 201 202 function Last (Container : List) return Cursor; 203 204 function Last_Element (Container : List) return Element_Type; 205 206 function Next (Position : Cursor) return Cursor; 207 208 procedure Next (Position : in out Cursor); 209 210 function Previous (Position : Cursor) return Cursor; 211 212 procedure Previous (Position : in out Cursor); 213 214 function Find 215 (Container : List; 216 Item : Element_Type; 217 Position : Cursor := No_Element) return Cursor; 218 219 function Reverse_Find 220 (Container : List; 221 Item : Element_Type; 222 Position : Cursor := No_Element) return Cursor; 223 224 function Contains 225 (Container : List; 226 Item : Element_Type) return Boolean; 227 228 procedure Iterate 229 (Container : List; 230 Process : not null access procedure (Position : Cursor)); 231 232 procedure Reverse_Iterate 233 (Container : List; 234 Process : not null access procedure (Position : Cursor)); 235 236 generic 237 with function "<" (Left, Right : Element_Type) return Boolean is <>; 238 package Generic_Sorting is 239 240 function Is_Sorted (Container : List) return Boolean; 241 242 procedure Sort (Container : in out List); 243 244 procedure Merge (Target, Source : in out List); 245 246 end Generic_Sorting; 247 248private 249 250 pragma Inline (Next); 251 pragma Inline (Previous); 252 253 use Ada.Containers.Helpers; 254 package Implementation is new Generic_Implementation; 255 use Implementation; 256 257 type Node_Type; 258 type Node_Access is access Node_Type; 259 260 type Node_Type is 261 limited record 262 Element : aliased Element_Type; 263 Next : Node_Access; 264 Prev : Node_Access; 265 end record; 266 267 use Ada.Finalization; 268 use Ada.Streams; 269 270 type List is 271 new Controlled with record 272 First : Node_Access := null; 273 Last : Node_Access := null; 274 Length : Count_Type := 0; 275 TC : aliased Tamper_Counts; 276 end record; 277 278 overriding procedure Adjust (Container : in out List); 279 280 overriding procedure Finalize (Container : in out List) renames Clear; 281 282 procedure Read 283 (Stream : not null access Root_Stream_Type'Class; 284 Item : out List); 285 286 for List'Read use Read; 287 288 procedure Write 289 (Stream : not null access Root_Stream_Type'Class; 290 Item : List); 291 292 for List'Write use Write; 293 294 type List_Access is access all List; 295 for List_Access'Storage_Size use 0; 296 297 type Cursor is 298 record 299 Container : List_Access; 300 Node : Node_Access; 301 end record; 302 303 procedure Read 304 (Stream : not null access Root_Stream_Type'Class; 305 Item : out Cursor); 306 307 for Cursor'Read use Read; 308 309 procedure Write 310 (Stream : not null access Root_Stream_Type'Class; 311 Item : Cursor); 312 313 for Cursor'Write use Write; 314 315 subtype Reference_Control_Type is Implementation.Reference_Control_Type; 316 -- It is necessary to rename this here, so that the compiler can find it 317 318 type Constant_Reference_Type 319 (Element : not null access constant Element_Type) is 320 record 321 Control : Reference_Control_Type := 322 raise Program_Error with "uninitialized reference"; 323 -- The RM says, "The default initialization of an object of 324 -- type Constant_Reference_Type or Reference_Type propagates 325 -- Program_Error." 326 end record; 327 328 procedure Write 329 (Stream : not null access Root_Stream_Type'Class; 330 Item : Constant_Reference_Type); 331 332 for Constant_Reference_Type'Write use Write; 333 334 procedure Read 335 (Stream : not null access Root_Stream_Type'Class; 336 Item : out Constant_Reference_Type); 337 338 for Constant_Reference_Type'Read use Read; 339 340 type Reference_Type 341 (Element : not null access Element_Type) is 342 record 343 Control : Reference_Control_Type := 344 raise Program_Error with "uninitialized reference"; 345 -- The RM says, "The default initialization of an object of 346 -- type Constant_Reference_Type or Reference_Type propagates 347 -- Program_Error." 348 end record; 349 350 procedure Write 351 (Stream : not null access Root_Stream_Type'Class; 352 Item : Reference_Type); 353 354 for Reference_Type'Write use Write; 355 356 procedure Read 357 (Stream : not null access Root_Stream_Type'Class; 358 Item : out Reference_Type); 359 360 for Reference_Type'Read use Read; 361 362 -- Three operations are used to optimize in the expansion of "for ... of" 363 -- loops: the Next(Cursor) procedure in the visible part, and the following 364 -- Pseudo_Reference and Get_Element_Access functions. See Sem_Ch5 for 365 -- details. 366 367 function Pseudo_Reference 368 (Container : aliased List'Class) return Reference_Control_Type; 369 pragma Inline (Pseudo_Reference); 370 -- Creates an object of type Reference_Control_Type pointing to the 371 -- container, and increments the Lock. Finalization of this object will 372 -- decrement the Lock. 373 374 type Element_Access is access all Element_Type with 375 Storage_Size => 0; 376 377 function Get_Element_Access 378 (Position : Cursor) return not null Element_Access; 379 -- Returns a pointer to the element designated by Position. 380 381 Empty_List : constant List := (Controlled with others => <>); 382 383 No_Element : constant Cursor := Cursor'(null, null); 384 385 type Iterator is new Limited_Controlled and 386 List_Iterator_Interfaces.Reversible_Iterator with 387 record 388 Container : List_Access; 389 Node : Node_Access; 390 end record 391 with Disable_Controlled => not T_Check; 392 393 overriding procedure Finalize (Object : in out Iterator); 394 395 overriding function First (Object : Iterator) return Cursor; 396 overriding function Last (Object : Iterator) return Cursor; 397 398 overriding function Next 399 (Object : Iterator; 400 Position : Cursor) return Cursor; 401 402 overriding function Previous 403 (Object : Iterator; 404 Position : Cursor) return Cursor; 405 406end Ada.Containers.Doubly_Linked_Lists; 407