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