1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- A D A . C O N T A I N E R S . I N D E F I N I T E _ V E C T O R S -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 2004-2020, 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; 39private with Ada.Strings.Text_Output; 40 41generic 42 type Index_Type is range <>; 43 type Element_Type (<>) is private; 44 45 with function "=" (Left, Right : Element_Type) return Boolean is <>; 46 47package Ada.Containers.Indefinite_Vectors with 48 SPARK_Mode => Off 49is 50 pragma Annotate (CodePeer, Skip_Analysis); 51 pragma Preelaborate; 52 pragma Remote_Types; 53 54 subtype Extended_Index is Index_Type'Base 55 range Index_Type'First - 1 .. 56 Index_Type'Min (Index_Type'Base'Last - 1, Index_Type'Last) + 1; 57 58 No_Index : constant Extended_Index := Extended_Index'First; 59 60 type Vector is tagged private 61 with 62 Constant_Indexing => Constant_Reference, 63 Variable_Indexing => Reference, 64 Default_Iterator => Iterate, 65 Iterator_Element => Element_Type, 66 Aggregate => (Empty => Empty_Vector, 67 Add_Unnamed => Append, 68 New_Indexed => New_Vector, 69 Assign_Indexed => Replace_Element); 70 71 pragma Preelaborable_Initialization (Vector); 72 73 type Cursor is private; 74 pragma Preelaborable_Initialization (Cursor); 75 76 Empty_Vector : constant Vector; 77 78 No_Element : constant Cursor; 79 80 function Empty (Capacity : Count_Type := 10) return Vector; 81 82 function Has_Element (Position : Cursor) return Boolean; 83 84 package Vector_Iterator_Interfaces is new 85 Ada.Iterator_Interfaces (Cursor, Has_Element); 86 87 overriding function "=" (Left, Right : Vector) return Boolean; 88 89 function New_Vector (First, Last : Index_Type) return Vector 90 with Pre => First = Index_Type'First; 91 92 function To_Vector (Length : Count_Type) return Vector; 93 94 function To_Vector 95 (New_Item : Element_Type; 96 Length : Count_Type) return Vector; 97 98 function "&" (Left, Right : Vector) return Vector; 99 100 function "&" (Left : Vector; Right : Element_Type) return Vector; 101 102 function "&" (Left : Element_Type; Right : Vector) return Vector; 103 104 function "&" (Left, Right : Element_Type) return Vector; 105 106 function Capacity (Container : Vector) return Count_Type; 107 108 procedure Reserve_Capacity 109 (Container : in out Vector; 110 Capacity : Count_Type); 111 112 function Length (Container : Vector) return Count_Type; 113 114 procedure Set_Length 115 (Container : in out Vector; 116 Length : Count_Type); 117 118 function Is_Empty (Container : Vector) return Boolean; 119 120 procedure Clear (Container : in out Vector); 121 122 type Constant_Reference_Type 123 (Element : not null access constant Element_Type) is private 124 with 125 Implicit_Dereference => Element; 126 127 type Reference_Type (Element : not null access Element_Type) is private 128 with 129 Implicit_Dereference => Element; 130 131 function Constant_Reference 132 (Container : aliased Vector; 133 Position : Cursor) return Constant_Reference_Type; 134 pragma Inline (Constant_Reference); 135 136 function Reference 137 (Container : aliased in out Vector; 138 Position : Cursor) return Reference_Type; 139 pragma Inline (Reference); 140 141 function Constant_Reference 142 (Container : aliased Vector; 143 Index : Index_Type) return Constant_Reference_Type; 144 pragma Inline (Constant_Reference); 145 146 function Reference 147 (Container : aliased in out Vector; 148 Index : Index_Type) return Reference_Type; 149 pragma Inline (Reference); 150 151 function To_Cursor 152 (Container : Vector; 153 Index : Extended_Index) return Cursor; 154 155 function To_Index (Position : Cursor) return Extended_Index; 156 157 function Element 158 (Container : Vector; 159 Index : Index_Type) return Element_Type; 160 161 function Element (Position : Cursor) return Element_Type; 162 163 procedure Replace_Element 164 (Container : in out Vector; 165 Index : Index_Type; 166 New_Item : Element_Type); 167 168 procedure Replace_Element 169 (Container : in out Vector; 170 Position : Cursor; 171 New_Item : Element_Type); 172 173 procedure Query_Element 174 (Container : Vector; 175 Index : Index_Type; 176 Process : not null access procedure (Element : Element_Type)); 177 178 procedure Query_Element 179 (Position : Cursor; 180 Process : not null access procedure (Element : Element_Type)); 181 182 procedure Update_Element 183 (Container : in out Vector; 184 Index : Index_Type; 185 Process : not null access procedure (Element : in out Element_Type)); 186 187 procedure Update_Element 188 (Container : in out Vector; 189 Position : Cursor; 190 Process : not null access procedure (Element : in out Element_Type)); 191 192 procedure Assign (Target : in out Vector; Source : Vector); 193 194 function Copy (Source : Vector; Capacity : Count_Type := 0) return Vector; 195 196 procedure Move (Target : in out Vector; Source : in out Vector); 197 198 procedure Insert_Vector 199 (Container : in out Vector; 200 Before : Extended_Index; 201 New_Item : Vector); 202 203 procedure Insert 204 (Container : in out Vector; 205 Before : Extended_Index; 206 New_Item : Vector) renames Insert_Vector; 207 -- Retained for now for compatibility; AI12-0400 will remove this. 208 209 procedure Insert_Vector 210 (Container : in out Vector; 211 Before : Cursor; 212 New_Item : Vector); 213 214 procedure Insert 215 (Container : in out Vector; 216 Before : Cursor; 217 New_Item : Vector) renames Insert_Vector; 218 -- Retained for now for compatibility; AI12-0400 will remove this. 219 220 procedure Insert_Vector 221 (Container : in out Vector; 222 Before : Cursor; 223 New_Item : Vector; 224 Position : out Cursor); 225 226 procedure Insert 227 (Container : in out Vector; 228 Before : Cursor; 229 New_Item : Vector; 230 Position : out Cursor) renames Insert_Vector; 231 -- Retained for now for compatibility; AI12-0400 will remove this. 232 233 procedure Insert 234 (Container : in out Vector; 235 Before : Extended_Index; 236 New_Item : Element_Type; 237 Count : Count_Type := 1); 238 239 procedure Insert 240 (Container : in out Vector; 241 Before : Cursor; 242 New_Item : Element_Type; 243 Count : Count_Type := 1); 244 245 procedure Insert 246 (Container : in out Vector; 247 Before : Cursor; 248 New_Item : Element_Type; 249 Position : out Cursor; 250 Count : Count_Type := 1); 251 252 procedure Prepend_Vector 253 (Container : in out Vector; 254 New_Item : Vector); 255 256 procedure Prepend 257 (Container : in out Vector; 258 New_Item : Vector) renames Prepend_Vector; 259 -- Retained for now for compatibility; AI12-0400 will remove this. 260 261 procedure Prepend 262 (Container : in out Vector; 263 New_Item : Element_Type; 264 Count : Count_Type := 1); 265 266 procedure Append_Vector 267 (Container : in out Vector; 268 New_Item : Vector); 269 270 procedure Append 271 (Container : in out Vector; 272 New_Item : Vector) renames Append_Vector; 273 -- Retained for now for compatibility; AI12-0400 will remove this. 274 275 procedure Append 276 (Container : in out Vector; 277 New_Item : Element_Type; 278 Count : Count_Type); 279 280 procedure Append (Container : in out Vector; 281 New_Item : Element_Type); 282 283 procedure Insert_Space 284 (Container : in out Vector; 285 Before : Extended_Index; 286 Count : Count_Type := 1); 287 288 procedure Insert_Space 289 (Container : in out Vector; 290 Before : Cursor; 291 Position : out Cursor; 292 Count : Count_Type := 1); 293 294 procedure Delete 295 (Container : in out Vector; 296 Index : Extended_Index; 297 Count : Count_Type := 1); 298 299 procedure Delete 300 (Container : in out Vector; 301 Position : in out Cursor; 302 Count : Count_Type := 1); 303 304 procedure Delete_First 305 (Container : in out Vector; 306 Count : Count_Type := 1); 307 308 procedure Delete_Last 309 (Container : in out Vector; 310 Count : Count_Type := 1); 311 312 procedure Reverse_Elements (Container : in out Vector); 313 314 procedure Swap (Container : in out Vector; I, J : Index_Type); 315 316 procedure Swap (Container : in out Vector; I, J : Cursor); 317 318 function First_Index (Container : Vector) return Index_Type; 319 320 function First (Container : Vector) return Cursor; 321 322 function First_Element (Container : Vector) return Element_Type; 323 324 function Last_Index (Container : Vector) return Extended_Index; 325 326 function Last (Container : Vector) return Cursor; 327 328 function Last_Element (Container : Vector) return Element_Type; 329 330 function Next (Position : Cursor) return Cursor; 331 332 procedure Next (Position : in out Cursor); 333 334 function Previous (Position : Cursor) return Cursor; 335 336 procedure Previous (Position : in out Cursor); 337 338 function Find_Index 339 (Container : Vector; 340 Item : Element_Type; 341 Index : Index_Type := Index_Type'First) return Extended_Index; 342 343 function Find 344 (Container : Vector; 345 Item : Element_Type; 346 Position : Cursor := No_Element) return Cursor; 347 348 function Reverse_Find_Index 349 (Container : Vector; 350 Item : Element_Type; 351 Index : Index_Type := Index_Type'Last) return Extended_Index; 352 353 function Reverse_Find 354 (Container : Vector; 355 Item : Element_Type; 356 Position : Cursor := No_Element) return Cursor; 357 358 function Contains 359 (Container : Vector; 360 Item : Element_Type) return Boolean; 361 362 procedure Iterate 363 (Container : Vector; 364 Process : not null access procedure (Position : Cursor)); 365 366 function Iterate (Container : Vector) 367 return Vector_Iterator_Interfaces.Reversible_Iterator'class; 368 369 function Iterate 370 (Container : Vector; 371 Start : Cursor) 372 return Vector_Iterator_Interfaces.Reversible_Iterator'class; 373 374 procedure Reverse_Iterate 375 (Container : Vector; 376 Process : not null access procedure (Position : Cursor)); 377 378 generic 379 with function "<" (Left, Right : Element_Type) return Boolean is <>; 380 package Generic_Sorting is 381 382 function Is_Sorted (Container : Vector) return Boolean; 383 384 procedure Sort (Container : in out Vector); 385 386 procedure Merge (Target : in out Vector; Source : in out Vector); 387 388 end Generic_Sorting; 389 390private 391 392 pragma Inline (Append); 393 pragma Inline (First_Index); 394 pragma Inline (Last_Index); 395 pragma Inline (Element); 396 pragma Inline (First_Element); 397 pragma Inline (Last_Element); 398 pragma Inline (Query_Element); 399 pragma Inline (Update_Element); 400 pragma Inline (Replace_Element); 401 pragma Inline (Is_Empty); 402 pragma Inline (Contains); 403 pragma Inline (Next); 404 pragma Inline (Previous); 405 406 use Ada.Containers.Helpers; 407 package Implementation is new Generic_Implementation; 408 use Implementation; 409 410 type Element_Access is access Element_Type; 411 412 type Elements_Array is array (Index_Type range <>) of Element_Access; 413 function "=" (L, R : Elements_Array) return Boolean is abstract; 414 415 type Elements_Type (Last : Extended_Index) is limited record 416 EA : Elements_Array (Index_Type'First .. Last); 417 end record; 418 419 type Elements_Access is access all Elements_Type; 420 421 use Finalization; 422 use Streams; 423 424 type Vector is new Controlled with record 425 Elements : Elements_Access := null; 426 Last : Extended_Index := No_Index; 427 TC : aliased Tamper_Counts; 428 end record with Put_Image => Put_Image; 429 430 procedure Put_Image 431 (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector); 432 433 overriding procedure Adjust (Container : in out Vector); 434 overriding procedure Finalize (Container : in out Vector); 435 436 procedure Write 437 (Stream : not null access Root_Stream_Type'Class; 438 Container : Vector); 439 440 for Vector'Write use Write; 441 442 procedure Read 443 (Stream : not null access Root_Stream_Type'Class; 444 Container : out Vector); 445 446 for Vector'Read use Read; 447 448 type Vector_Access is access all Vector; 449 for Vector_Access'Storage_Size use 0; 450 451 type Cursor is record 452 Container : Vector_Access; 453 Index : Index_Type := Index_Type'First; 454 end record; 455 456 procedure Read 457 (Stream : not null access Root_Stream_Type'Class; 458 Position : out Cursor); 459 460 for Cursor'Read use Read; 461 462 procedure Write 463 (Stream : not null access Root_Stream_Type'Class; 464 Position : Cursor); 465 466 for Cursor'Write use Write; 467 468 subtype Reference_Control_Type is Implementation.Reference_Control_Type; 469 -- It is necessary to rename this here, so that the compiler can find it 470 471 type Constant_Reference_Type 472 (Element : not null access constant Element_Type) is 473 record 474 Control : Reference_Control_Type := 475 raise Program_Error with "uninitialized reference"; 476 -- The RM says, "The default initialization of an object of 477 -- type Constant_Reference_Type or Reference_Type propagates 478 -- Program_Error." 479 end record; 480 481 procedure Write 482 (Stream : not null access Root_Stream_Type'Class; 483 Item : Constant_Reference_Type); 484 485 for Constant_Reference_Type'Write use Write; 486 487 procedure Read 488 (Stream : not null access Root_Stream_Type'Class; 489 Item : out Constant_Reference_Type); 490 491 for Constant_Reference_Type'Read use Read; 492 493 type Reference_Type 494 (Element : not null access Element_Type) is 495 record 496 Control : Reference_Control_Type := 497 raise Program_Error with "uninitialized reference"; 498 -- The RM says, "The default initialization of an object of 499 -- type Constant_Reference_Type or Reference_Type propagates 500 -- Program_Error." 501 end record; 502 503 procedure Write 504 (Stream : not null access Root_Stream_Type'Class; 505 Item : Reference_Type); 506 507 for Reference_Type'Write use Write; 508 509 procedure Read 510 (Stream : not null access Root_Stream_Type'Class; 511 Item : out Reference_Type); 512 513 for Reference_Type'Read use Read; 514 515 -- Three operations are used to optimize in the expansion of "for ... of" 516 -- loops: the Next(Cursor) procedure in the visible part, and the following 517 -- Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for 518 -- details. 519 520 function Pseudo_Reference 521 (Container : aliased Vector'Class) return Reference_Control_Type; 522 pragma Inline (Pseudo_Reference); 523 -- Creates an object of type Reference_Control_Type pointing to the 524 -- container, and increments the Lock. Finalization of this object will 525 -- decrement the Lock. 526 527 function Get_Element_Access 528 (Position : Cursor) return not null Element_Access; 529 -- Returns a pointer to the element designated by Position. 530 531 No_Element : constant Cursor := Cursor'(null, Index_Type'First); 532 533 Empty_Vector : constant Vector := (Controlled with others => <>); 534 535 type Iterator is new Limited_Controlled and 536 Vector_Iterator_Interfaces.Reversible_Iterator with 537 record 538 Container : Vector_Access; 539 Index : Index_Type'Base; 540 end record 541 with Disable_Controlled => not T_Check; 542 543 overriding procedure Finalize (Object : in out Iterator); 544 545 overriding function First (Object : Iterator) return Cursor; 546 overriding function Last (Object : Iterator) return Cursor; 547 548 overriding function Next 549 (Object : Iterator; 550 Position : Cursor) return Cursor; 551 552 overriding function Previous 553 (Object : Iterator; 554 Position : Cursor) return Cursor; 555 556end Ada.Containers.Indefinite_Vectors; 557