1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- A D A . C O N T A I N E R S . V E C T O R S -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 2004-2019, 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 40-- The language-defined generic package Containers.Vectors provides private 41-- types Vector and Cursor, and a set of operations for each type. A vector 42-- container allows insertion and deletion at any position, but it is 43-- specifically optimized for insertion and deletion at the high end (the end 44-- with the higher index) of the container. A vector container also provides 45-- random access to its elements. 46-- 47-- A vector container behaves conceptually as an array that expands as 48-- necessary as items are inserted. The length of a vector is the number of 49-- elements that the vector contains. The capacity of a vector is the maximum 50-- number of elements that can be inserted into the vector prior to it being 51-- automatically expanded. 52-- 53-- Elements in a vector container can be referred to by an index value of a 54-- generic formal type. The first element of a vector always has its index 55-- value equal to the lower bound of the formal type. 56-- 57-- A vector container may contain empty elements. Empty elements do not have a 58-- specified value. 59 60generic 61 type Index_Type is range <>; 62 type Element_Type is private; 63 64 with function "=" (Left, Right : Element_Type) return Boolean is <>; 65 -- The actual function for the generic formal function "=" on Element_Type 66 -- values is expected to define a reflexive and symmetric relationship and 67 -- return the same result value each time it is called with a particular 68 -- pair of values. If it behaves in some other manner, the functions 69 -- defined to use it return an unspecified value. The exact arguments and 70 -- number of calls of this generic formal function by the functions defined 71 -- to use it are unspecified. 72 73package Ada.Containers.Vectors is 74 pragma Annotate (CodePeer, Skip_Analysis); 75 pragma Preelaborate; 76 pragma Remote_Types; 77 78 subtype Extended_Index is Index_Type'Base 79 range Index_Type'First - 1 .. 80 Index_Type'Min (Index_Type'Base'Last - 1, Index_Type'Last) + 1; 81 -- The subtype Extended_Index includes the indices covered by Index_Type 82 -- plus the value No_Index and, if it exists, the successor to the 83 -- Index_Type'Last. 84 85 No_Index : constant Extended_Index := Extended_Index'First; 86 -- No_Index represents a position that does not correspond to any element. 87 88 type Vector is tagged private 89 with 90 Constant_Indexing => Constant_Reference, 91 Variable_Indexing => Reference, 92 Default_Iterator => Iterate, 93 Iterator_Element => Element_Type; 94 pragma Preelaborable_Initialization (Vector); 95 -- Vector type, to be instantiated by users of this package. If an object 96 -- of type Vector is not otherwise initialized, it is initialized to 97 -- Empty_Vector. 98 99 type Cursor is private; 100 pragma Preelaborable_Initialization (Cursor); 101 -- Cursor pointing into an instance of vector. If an object of type Cursor 102 -- is not otherwise initialized, it is initialized to No_Element 103 104 No_Element : constant Cursor; 105 -- No_Element represents a cursor that designates no element. 106 107 function Has_Element (Position : Cursor) return Boolean; 108 -- Returns True if Position designates an element, and returns False 109 -- otherwise. 110 111 package Vector_Iterator_Interfaces is new 112 Ada.Iterator_Interfaces (Cursor, Has_Element); 113 114 Empty_Vector : constant Vector; 115 -- Empty_Vector represents the empty vector object. It has a length of 0. 116 117 overriding function "=" (Left, Right : Vector) return Boolean; 118 -- If Left and Right denote the same vector object, then the function 119 -- returns True. If Left and Right have different lengths, then the 120 -- function returns False. Otherwise, it compares each element in Left to 121 -- the corresponding element in Right using the generic formal equality 122 -- operator. If any such comparison returns False, the function returns 123 -- False; otherwise it returns True. Any exception raised during evaluation 124 -- of element equality is propagated. 125 126 function To_Vector (Length : Count_Type) return Vector; 127 -- Returns a vector with a length of Length, filled with empty elements. 128 129 function To_Vector 130 (New_Item : Element_Type; 131 Length : Count_Type) return Vector; 132 -- Returns a vector with a length of Length, filled with elements 133 -- initialized to the value New_Item. 134 135 function "&" (Left, Right : Vector) return Vector; 136 -- Returns a vector comprising the elements of Left followed by the 137 -- elements of Right. 138 139 function "&" (Left : Vector; Right : Element_Type) return Vector; 140 -- Returns a vector comprising the elements of Left followed by the element 141 -- Right. 142 143 function "&" (Left : Element_Type; Right : Vector) return Vector; 144 -- Returns a vector comprising the element Left followed by the elements of 145 -- Right. 146 147 function "&" (Left, Right : Element_Type) return Vector; 148 -- Returns a vector comprising the element Left followed by the element 149 -- Right. 150 151 function Capacity (Container : Vector) return Count_Type; 152 -- Returns the capacity of Container. 153 154 procedure Reserve_Capacity 155 (Container : in out Vector; 156 Capacity : Count_Type); 157 -- Reserve_Capacity allocates new internal data structures such that the 158 -- length of the resulting vector can become at least the value Capacity 159 -- without requiring an additional call to Reserve_Capacity, and is large 160 -- enough to hold the current length of Container. Reserve_Capacity then 161 -- copies the elements into the new data structures and deallocates the old 162 -- data structures. Any exception raised during allocation is propagated 163 -- and Container is not modified. 164 165 function Length (Container : Vector) return Count_Type; 166 -- Returns the number of elements in Container. 167 168 procedure Set_Length 169 (Container : in out Vector; 170 Length : Count_Type); 171 -- If Length is larger than the capacity of Container, Set_Length calls 172 -- Reserve_Capacity (Container, Length), then sets the length of the 173 -- Container to Length. If Length is greater than the original length of 174 -- Container, empty elements are added to Container; otherwise elements are 175 -- removed from Container. 176 177 function Is_Empty (Container : Vector) return Boolean; 178 -- Equivalent to Length (Container) = 0. 179 180 procedure Clear (Container : in out Vector); 181 -- Removes all the elements from Container. The capacity of Container does 182 -- not change. 183 184 function To_Cursor 185 (Container : Vector; 186 Index : Extended_Index) return Cursor; 187 -- If Index is not in the range First_Index (Container) .. Last_Index 188 -- (Container), then No_Element is returned. Otherwise, a cursor 189 -- designating the element at position Index in Container is returned. 190 191 function To_Index (Position : Cursor) return Extended_Index; 192 -- If Position is No_Element, No_Index is returned. Otherwise, the index 193 -- (within its containing vector) of the element designated by Position is 194 -- returned. 195 196 function Element 197 (Container : Vector; 198 Index : Index_Type) return Element_Type; 199 -- If Index is not in the range First_Index (Container) .. Last_Index 200 -- (Container), then Constraint_Error is propagated. Otherwise, Element 201 -- returns the element at position Index. 202 203 function Element (Position : Cursor) return Element_Type; 204 -- If Position equals No_Element, then Constraint_Error is propagated. 205 -- Otherwise, Element returns the element designated by Position. 206 207 procedure Replace_Element 208 (Container : in out Vector; 209 Index : Index_Type; 210 New_Item : Element_Type); 211 -- If Index is not in the range First_Index (Container) .. Last_Index 212 -- (Container), then Constraint_Error is propagated. Otherwise 213 -- Replace_Element assigns the value New_Item to the element at position 214 -- Index. Any exception raised during the assignment is propagated. The 215 -- element at position Index is not an empty element after successful call 216 -- to Replace_Element. 217 218 procedure Replace_Element 219 (Container : in out Vector; 220 Position : Cursor; 221 New_Item : Element_Type); 222 -- If Position equals No_Element, then Constraint_Error is propagated; if 223 -- Position does not designate an element in Container, then Program_Error 224 -- is propagated. Otherwise Replace_Element assigns New_Item to the element 225 -- designated by Position. Any exception raised during the assignment is 226 -- propagated. The element at Position is not an empty element after 227 -- successful call to Replace_Element. 228 229 procedure Query_Element 230 (Container : Vector; 231 Index : Index_Type; 232 Process : not null access procedure (Element : Element_Type)); 233 -- If Index is not in the range First_Index (Container) .. Last_Index 234 -- (Container), then Constraint_Error is propagated. Otherwise, 235 -- Query_Element calls Process.all with the element at position Index as 236 -- the argument. Program_Error is propagated if Process.all tampers with 237 -- the elements of Container. Any exception raised by Process.all is 238 -- propagated. 239 240 procedure Query_Element 241 (Position : Cursor; 242 Process : not null access procedure (Element : Element_Type)); 243 -- If Position equals No_Element, then Constraint_Error is propagated. 244 -- Otherwise, Query_Element calls Process.all with the element designated 245 -- by Position as the argument. Program_Error is propagated if Process.all 246 -- tampers with the elements of Container. Any exception raised by 247 -- Process.all is propagated. 248 249 procedure Update_Element 250 (Container : in out Vector; 251 Index : Index_Type; 252 Process : not null access procedure (Element : in out Element_Type)); 253 -- If Index is not in the range First_Index (Container) .. Last_Index 254 -- (Container), then Constraint_Error is propagated. Otherwise, 255 -- Update_Element calls Process.all with the element at position Index as 256 -- the argument. Program_Error is propagated if Process.all tampers with 257 -- the elements of Container. Any exception raised by Process.all is 258 -- propagated. 259 -- 260 -- If Element_Type is unconstrained and definite, then the actual Element 261 -- parameter of Process.all shall be unconstrained. 262 -- 263 -- The element at position Index is not an empty element after successful 264 -- completion of this operation. 265 266 procedure Update_Element 267 (Container : in out Vector; 268 Position : Cursor; 269 Process : not null access procedure (Element : in out Element_Type)); 270 -- If Position equals No_Element, then Constraint_Error is propagated; if 271 -- Position does not designate an element in Container, then Program_Error 272 -- is propagated. Otherwise Update_Element calls Process.all with the 273 -- element designated by Position as the argument. Program_Error is 274 -- propagated if Process.all tampers with the elements of Container. Any 275 -- exception raised by Process.all is propagated. 276 -- 277 -- If Element_Type is unconstrained and definite, then the actual Element 278 -- parameter of Process.all shall be unconstrained. 279 -- 280 -- The element designated by Position is not an empty element after 281 -- successful completion of this operation. 282 283 type Constant_Reference_Type 284 (Element : not null access constant Element_Type) is 285 private 286 with 287 Implicit_Dereference => Element; 288 289 type Reference_Type (Element : not null access Element_Type) is private 290 with 291 Implicit_Dereference => Element; 292 293 function Constant_Reference 294 (Container : aliased Vector; 295 Position : Cursor) return Constant_Reference_Type; 296 pragma Inline (Constant_Reference); 297 298 function Reference 299 (Container : aliased in out Vector; 300 Position : Cursor) return Reference_Type; 301 pragma Inline (Reference); 302 303 function Constant_Reference 304 (Container : aliased Vector; 305 Index : Index_Type) return Constant_Reference_Type; 306 pragma Inline (Constant_Reference); 307 308 function Reference 309 (Container : aliased in out Vector; 310 Index : Index_Type) return Reference_Type; 311 pragma Inline (Reference); 312 313 procedure Assign (Target : in out Vector; Source : Vector); 314 315 function Copy (Source : Vector; Capacity : Count_Type := 0) return Vector; 316 317 procedure Move (Target : in out Vector; Source : in out Vector); 318 -- If Target denotes the same object as Source, then Move has no effect. 319 -- Otherwise, Move first calls Clear (Target); then, each element from 320 -- Source is removed from Source and inserted into Target in the original 321 -- order. The length of Source is 0 after a successful call to Move. 322 323 procedure Insert 324 (Container : in out Vector; 325 Before : Extended_Index; 326 New_Item : Vector); 327 -- If Before is not in the range First_Index (Container) .. Last_Index 328 -- (Container) + 1, then Constraint_Error is propagated. If 329 -- Length(New_Item) is 0, then Insert does nothing. Otherwise, it computes 330 -- the new length NL as the sum of the current length and Length 331 -- (New_Item); if the value of Last appropriate for length NL would be 332 -- greater than Index_Type'Last then Constraint_Error is propagated. 333 -- 334 -- If the current vector capacity is less than NL, Reserve_Capacity 335 -- (Container, NL) is called to increase the vector capacity. Then Insert 336 -- slides the elements in the range Before .. Last_Index (Container) up by 337 -- Length(New_Item) positions, and then copies the elements of New_Item to 338 -- the positions starting at Before. Any exception raised during the 339 -- copying is propagated. 340 341 procedure Insert 342 (Container : in out Vector; 343 Before : Cursor; 344 New_Item : Vector); 345 -- If Before is not No_Element, and does not designate an element in 346 -- Container, then Program_Error is propagated. Otherwise, if 347 -- Length(New_Item) is 0, then Insert does nothing. If Before is 348 -- No_Element, then the call is equivalent to Insert (Container, Last_Index 349 -- (Container) + 1, New_Item); otherwise the call is equivalent to Insert 350 -- (Container, To_Index (Before), New_Item); 351 352 procedure Insert 353 (Container : in out Vector; 354 Before : Cursor; 355 New_Item : Vector; 356 Position : out Cursor); 357 -- If Before is not No_Element, and does not designate an element in 358 -- Container, then Program_Error is propagated. If Before equals 359 -- No_Element, then let T be Last_Index (Container) + 1; otherwise, let T 360 -- be To_Index (Before). Insert (Container, T, New_Item) is called, and 361 -- then Position is set to To_Cursor (Container, T). 362 363 procedure Insert 364 (Container : in out Vector; 365 Before : Extended_Index; 366 New_Item : Element_Type; 367 Count : Count_Type := 1); 368 -- Equivalent to Insert (Container, Before, To_Vector (New_Item, Count)); 369 370 procedure Insert 371 (Container : in out Vector; 372 Before : Cursor; 373 New_Item : Element_Type; 374 Count : Count_Type := 1); 375 -- Equivalent to Insert (Container, Before, To_Vector (New_Item, Count)); 376 377 procedure Insert 378 (Container : in out Vector; 379 Before : Cursor; 380 New_Item : Element_Type; 381 Position : out Cursor; 382 Count : Count_Type := 1); 383 -- Equivalent to 384 -- Insert (Container, Before, To_Vector (New_Item, Count), Position); 385 386 procedure Insert 387 (Container : in out Vector; 388 Before : Extended_Index; 389 Count : Count_Type := 1); 390 -- If Before is not in the range First_Index (Container) .. Last_Index 391 -- (Container) + 1, then Constraint_Error is propagated. If Count is 0, 392 -- then Insert does nothing. Otherwise, it computes the new length NL as 393 -- the sum of the current length and Count; if the value of Last 394 -- appropriate for length NL would be greater than Index_Type'Last then 395 -- Constraint_Error is propagated. 396 -- 397 -- If the current vector capacity is less than NL, Reserve_Capacity 398 -- (Container, NL) is called to increase the vector capacity. Then Insert 399 -- slides the elements in the range Before .. Last_Index (Container) up by 400 -- Count positions, and then inserts elements that are initialized by 401 -- default (see 3.3.1) in the positions starting at Before. 402 403 procedure Insert 404 (Container : in out Vector; 405 Before : Cursor; 406 Position : out Cursor; 407 Count : Count_Type := 1); 408 -- If Before is not No_Element, and does not designate an element in 409 -- Container, then Program_Error is propagated. If Before equals 410 -- No_Element, then let T be Last_Index (Container) + 1; otherwise, let T 411 -- be To_Index (Before). Insert (Container, T, Count) is called, and then 412 -- Position is set to To_Cursor (Container, T). 413 414 procedure Prepend 415 (Container : in out Vector; 416 New_Item : Vector); 417 -- Equivalent to Insert (Container, First_Index (Container), New_Item). 418 419 procedure Prepend 420 (Container : in out Vector; 421 New_Item : Element_Type; 422 Count : Count_Type := 1); 423 -- Equivalent to Insert (Container, First_Index (Container), New_Item, 424 -- Count). 425 426 procedure Append 427 (Container : in out Vector; 428 New_Item : Vector); 429 -- Equivalent to Insert (Container, Last_Index (Container) + 1, New_Item). 430 431 procedure Append 432 (Container : in out Vector; 433 New_Item : Element_Type; 434 Count : Count_Type := 1); 435 -- Equivalent to Insert (Container, Last_Index (Container) + 1, New_Item, 436 -- Count). 437 438 procedure Insert_Space 439 (Container : in out Vector; 440 Before : Extended_Index; 441 Count : Count_Type := 1); 442 -- If Before is not in the range First_Index (Container) .. Last_Index 443 -- (Container) + 1, then Constraint_Error is propagated. If Count is 0, 444 -- then Insert_Space does nothing. Otherwise, it computes the new length NL 445 -- as the sum of the current length and Count; if the value of Last 446 -- appropriate for length NL would be greater than Index_Type'Last then 447 -- Constraint_Error is propagated. 448 -- 449 -- If the current vector capacity is less than NL, Reserve_Capacity 450 -- (Container, NL) is called to increase the vector capacity. Then 451 -- Insert_Space slides the elements in the range Before .. Last_Index 452 -- (Container) up by Count positions, and then inserts empty elements in 453 -- the positions starting at Before. 454 455 procedure Insert_Space 456 (Container : in out Vector; 457 Before : Cursor; 458 Position : out Cursor; 459 Count : Count_Type := 1); 460 -- If Before is not No_Element, and does not designate an element in 461 -- Container, then Program_Error is propagated. If Before equals 462 -- No_Element, then let T be Last_Index (Container) + 1; otherwise, let T 463 -- be To_Index (Before). Insert_Space (Container, T, Count) is called, and 464 -- then Position is set to To_Cursor (Container, T). 465 466 procedure Delete 467 (Container : in out Vector; 468 Index : Extended_Index; 469 Count : Count_Type := 1); 470 -- If Index is not in the range First_Index (Container) .. Last_Index 471 -- (Container) + 1, then Constraint_Error is propagated. If Count is 0, 472 -- Delete has no effect. Otherwise Delete slides the elements (if any) 473 -- starting at position Index + Count down to Index. Any exception raised 474 -- during element assignment is propagated. 475 476 procedure Delete 477 (Container : in out Vector; 478 Position : in out Cursor; 479 Count : Count_Type := 1); 480 -- If Position equals No_Element, then Constraint_Error is propagated. If 481 -- Position does not designate an element in Container, then Program_Error 482 -- is propagated. Otherwise, Delete (Container, To_Index (Position), Count) 483 -- is called, and then Position is set to No_Element. 484 485 procedure Delete_First 486 (Container : in out Vector; 487 Count : Count_Type := 1); 488 -- Equivalent to Delete (Container, First_Index (Container), Count). 489 490 procedure Delete_Last 491 (Container : in out Vector; 492 Count : Count_Type := 1); 493 -- If Length (Container) <= Count then Delete_Last is equivalent to Clear 494 -- (Container). Otherwise it is equivalent to Delete (Container, 495 -- Index_Type'Val(Index_Type'Pos(Last_Index (Container)) - Count + 1), 496 -- Count). 497 498 procedure Reverse_Elements (Container : in out Vector); 499 -- Reorders the elements of Container in reverse order. 500 501 procedure Swap (Container : in out Vector; I, J : Index_Type); 502 -- If either I or J is not in the range First_Index (Container) .. 503 -- Last_Index (Container), then Constraint_Error is propagated. Otherwise, 504 -- Swap exchanges the values of the elements at positions I and J. 505 506 procedure Swap (Container : in out Vector; I, J : Cursor); 507 -- If either I or J is No_Element, then Constraint_Error is propagated. If 508 -- either I or J do not designate an element in Container, then 509 -- Program_Error is propagated. Otherwise, Swap exchanges the values of the 510 -- elements designated by I and J. 511 512 function First_Index (Container : Vector) return Index_Type; 513 -- Returns the value Index_Type'First. 514 515 function First (Container : Vector) return Cursor; 516 -- If Container is empty, First returns No_Element. Otherwise, it returns a 517 -- cursor that designates the first element in Container. 518 519 function First_Element (Container : Vector) return Element_Type; 520 -- Equivalent to Element (Container, First_Index (Container)). 521 522 function Last_Index (Container : Vector) return Extended_Index; 523 -- If Container is empty, Last_Index returns No_Index. Otherwise, it 524 -- returns the position of the last element in Container. 525 526 function Last (Container : Vector) return Cursor; 527 -- If Container is empty, Last returns No_Element. Otherwise, it returns a 528 -- cursor that designates the last element in Container. 529 530 function Last_Element (Container : Vector) return Element_Type; 531 -- Equivalent to Element (Container, Last_Index (Container)). 532 533 function Next (Position : Cursor) return Cursor; 534 -- If Position equals No_Element or designates the last element of the 535 -- container, then Next returns the value No_Element. Otherwise, it returns 536 -- a cursor that designates the element with index To_Index (Position) + 1 537 -- in the same vector as Position. 538 539 procedure Next (Position : in out Cursor); 540 -- Equivalent to Position := Next (Position). 541 542 function Previous (Position : Cursor) return Cursor; 543 -- If Position equals No_Element or designates the first element of the 544 -- container, then Previous returns the value No_Element. Otherwise, it 545 -- returns a cursor that designates the element with index To_Index 546 -- (Position) - 1 in the same vector as Position. 547 548 procedure Previous (Position : in out Cursor); 549 -- Equivalent to Position := Previous (Position). 550 551 function Find_Index 552 (Container : Vector; 553 Item : Element_Type; 554 Index : Index_Type := Index_Type'First) return Extended_Index; 555 -- Searches the elements of Container for an element equal to Item (using 556 -- the generic formal equality operator). The search starts at position 557 -- Index and proceeds towards Last_Index (Container). If no equal 558 -- element is found, then Find_Index returns No_Index. Otherwise, it 559 -- returns the index of the first equal element encountered. 560 561 function Find 562 (Container : Vector; 563 Item : Element_Type; 564 Position : Cursor := No_Element) return Cursor; 565 -- If Position is not No_Element, and does not designate an element in 566 -- Container, then Program_Error is propagated. Otherwise Find searches 567 -- the elements of Container for an element equal to Item (using the 568 -- generic formal equality operator). The search starts at the first 569 -- element if Position equals No_Element, and at the element designated 570 -- by Position otherwise. It proceeds towards the last element of 571 -- Container. If no equal element is found, then Find returns 572 -- No_Element. Otherwise, it returns a cursor designating the first 573 -- equal element encountered. 574 575 function Reverse_Find_Index 576 (Container : Vector; 577 Item : Element_Type; 578 Index : Index_Type := Index_Type'Last) return Extended_Index; 579 -- Searches the elements of Container for an element equal to Item (using 580 -- the generic formal equality operator). The search starts at position 581 -- Index or, if Index is greater than Last_Index (Container), at 582 -- position Last_Index (Container). It proceeds towards First_Index 583 -- (Container). If no equal element is found, then Reverse_Find_Index 584 -- returns No_Index. Otherwise, it returns the index of the first equal 585 -- element encountered. 586 587 function Reverse_Find 588 (Container : Vector; 589 Item : Element_Type; 590 Position : Cursor := No_Element) return Cursor; 591 -- If Position is not No_Element, and does not designate an element in 592 -- Container, then Program_Error is propagated. Otherwise Reverse_Find 593 -- searches the elements of Container for an element equal to Item 594 -- (using the generic formal equality operator). The search starts at 595 -- the last element if Position equals No_Element, and at the element 596 -- designated by Position otherwise. It proceeds towards the first 597 -- element of Container. If no equal element is found, then Reverse_Find 598 -- returns No_Element. Otherwise, it returns a cursor designating the 599 -- first equal element encountered. 600 601 function Contains 602 (Container : Vector; 603 Item : Element_Type) return Boolean; 604 -- Equivalent to Has_Element (Find (Container, Item)). 605 606 procedure Iterate 607 (Container : Vector; 608 Process : not null access procedure (Position : Cursor)); 609 -- Invokes Process.all with a cursor that designates each element in 610 -- Container, in index order. Program_Error is propagated if Process.all 611 -- tampers with the cursors of Container. Any exception raised by Process 612 -- is propagated. 613 614 procedure Reverse_Iterate 615 (Container : Vector; 616 Process : not null access procedure (Position : Cursor)); 617 -- Iterates over the elements in Container as per Iterate, except that 618 -- elements are traversed in reverse index order. 619 -- 620 621 function Iterate (Container : Vector) 622 return Vector_Iterator_Interfaces.Reversible_Iterator'Class; 623 624 function Iterate (Container : Vector; Start : Cursor) 625 return Vector_Iterator_Interfaces.Reversible_Iterator'Class; 626 627 generic 628 with function "<" (Left, Right : Element_Type) return Boolean is <>; 629 -- The actual function for the generic formal function "<" of 630 -- Generic_Sorting is expected to return the same value each time it is 631 -- called with a particular pair of element values. It should define a 632 -- strict ordering relationship, that is, be irreflexive, asymmetric, 633 -- and transitive; it should not modify Container. If the actual for "<" 634 -- behaves in some other manner, the behavior of the subprograms of 635 -- Generic_Sorting are unspecified. How many times the subprograms of 636 -- Generic_Sorting call "<" is unspecified. 637 package Generic_Sorting is 638 639 function Is_Sorted (Container : Vector) return Boolean; 640 -- Returns True if the elements are sorted smallest first as determined 641 -- by the generic formal "<" operator; otherwise, Is_Sorted returns 642 -- False. Any exception raised during evaluation of "<" is propagated. 643 644 procedure Sort (Container : in out Vector); 645 -- Reorders the elements of Container such that the elements are sorted 646 -- smallest first as determined by the generic formal "<" operator 647 -- provided. Any exception raised during evaluation of "<" is 648 -- propagated. 649 650 procedure Merge (Target : in out Vector; Source : in out Vector); 651 -- Merge removes elements from Source and inserts them into Target; 652 -- afterwards, Target contains the union of the elements that were 653 -- initially in Source and Target; Source is left empty. If Target and 654 -- Source are initially sorted smallest first, then Target is ordered 655 -- smallest first as determined by the generic formal "<" operator; 656 -- otherwise, the order of elements in Target is unspecified. Any 657 -- exception raised during evaluation of "<" is propagated. 658 659 end Generic_Sorting; 660 661private 662 663 pragma Inline (Append); 664 pragma Inline (First_Index); 665 pragma Inline (Last_Index); 666 pragma Inline (Element); 667 pragma Inline (First_Element); 668 pragma Inline (Last_Element); 669 pragma Inline (Query_Element); 670 pragma Inline (Update_Element); 671 pragma Inline (Replace_Element); 672 pragma Inline (Is_Empty); 673 pragma Inline (Contains); 674 pragma Inline (Next); 675 pragma Inline (Previous); 676 677 use Ada.Containers.Helpers; 678 package Implementation is new Generic_Implementation; 679 use Implementation; 680 681 type Elements_Array is array (Index_Type range <>) of aliased Element_Type; 682 function "=" (L, R : Elements_Array) return Boolean is abstract; 683 684 type Elements_Type (Last : Extended_Index) is limited record 685 EA : Elements_Array (Index_Type'First .. Last); 686 end record; 687 688 type Elements_Access is access all Elements_Type; 689 690 use Finalization; 691 use Streams; 692 693 type Vector is new Controlled with record 694 Elements : Elements_Access := null; 695 Last : Extended_Index := No_Index; 696 TC : aliased Tamper_Counts; 697 end record; 698 699 overriding procedure Adjust (Container : in out Vector); 700 overriding procedure Finalize (Container : in out Vector); 701 702 procedure Write 703 (Stream : not null access Root_Stream_Type'Class; 704 Container : Vector); 705 706 for Vector'Write use Write; 707 708 procedure Read 709 (Stream : not null access Root_Stream_Type'Class; 710 Container : out Vector); 711 712 for Vector'Read use Read; 713 714 type Vector_Access is access all Vector; 715 for Vector_Access'Storage_Size use 0; 716 717 type Cursor is record 718 Container : Vector_Access; 719 Index : Index_Type := Index_Type'First; 720 end record; 721 722 procedure Read 723 (Stream : not null access Root_Stream_Type'Class; 724 Position : out Cursor); 725 726 for Cursor'Read use Read; 727 728 procedure Write 729 (Stream : not null access Root_Stream_Type'Class; 730 Position : Cursor); 731 732 for Cursor'Write use Write; 733 734 subtype Reference_Control_Type is Implementation.Reference_Control_Type; 735 -- It is necessary to rename this here, so that the compiler can find it 736 737 type Constant_Reference_Type 738 (Element : not null access constant Element_Type) is 739 record 740 Control : Reference_Control_Type := 741 raise Program_Error with "uninitialized reference"; 742 -- The RM says, "The default initialization of an object of 743 -- type Constant_Reference_Type or Reference_Type propagates 744 -- Program_Error." 745 end record; 746 747 procedure Write 748 (Stream : not null access Root_Stream_Type'Class; 749 Item : Constant_Reference_Type); 750 751 for Constant_Reference_Type'Write use Write; 752 753 procedure Read 754 (Stream : not null access Root_Stream_Type'Class; 755 Item : out Constant_Reference_Type); 756 757 for Constant_Reference_Type'Read use Read; 758 759 type Reference_Type 760 (Element : not null access Element_Type) is 761 record 762 Control : Reference_Control_Type := 763 raise Program_Error with "uninitialized reference"; 764 -- The RM says, "The default initialization of an object of 765 -- type Constant_Reference_Type or Reference_Type propagates 766 -- Program_Error." 767 end record; 768 769 procedure Write 770 (Stream : not null access Root_Stream_Type'Class; 771 Item : Reference_Type); 772 773 for Reference_Type'Write use Write; 774 775 procedure Read 776 (Stream : not null access Root_Stream_Type'Class; 777 Item : out Reference_Type); 778 779 for Reference_Type'Read use Read; 780 781 -- Three operations are used to optimize in the expansion of "for ... of" 782 -- loops: the Next(Cursor) procedure in the visible part, and the following 783 -- Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for 784 -- details. 785 786 function Pseudo_Reference 787 (Container : aliased Vector'Class) return Reference_Control_Type; 788 pragma Inline (Pseudo_Reference); 789 -- Creates an object of type Reference_Control_Type pointing to the 790 -- container, and increments the Lock. Finalization of this object will 791 -- decrement the Lock. 792 793 type Element_Access is access all Element_Type; 794 795 function Get_Element_Access 796 (Position : Cursor) return not null Element_Access; 797 -- Returns a pointer to the element designated by Position. 798 799 No_Element : constant Cursor := Cursor'(null, Index_Type'First); 800 801 Empty_Vector : constant Vector := (Controlled with others => <>); 802 803 type Iterator is new Limited_Controlled and 804 Vector_Iterator_Interfaces.Reversible_Iterator with 805 record 806 Container : Vector_Access; 807 Index : Index_Type'Base; 808 end record 809 with Disable_Controlled => not T_Check; 810 811 overriding procedure Finalize (Object : in out Iterator); 812 813 overriding function First (Object : Iterator) return Cursor; 814 overriding function Last (Object : Iterator) return Cursor; 815 816 overriding function Next 817 (Object : Iterator; 818 Position : Cursor) return Cursor; 819 820 overriding function Previous 821 (Object : Iterator; 822 Position : Cursor) return Cursor; 823 824end Ada.Containers.Vectors; 825