1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- A D A . C O N T A I N E R S . M U L T I W A Y _ T R E E 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) return Boolean is <>; 44 45package Ada.Containers.Multiway_Trees is 46 pragma Annotate (CodePeer, Skip_Analysis); 47 pragma Preelaborate; 48 pragma Remote_Types; 49 50 type Tree is tagged private 51 with Constant_Indexing => Constant_Reference, 52 Variable_Indexing => Reference, 53 Default_Iterator => Iterate, 54 Iterator_Element => Element_Type; 55 pragma Preelaborable_Initialization (Tree); 56 57 type Cursor is private; 58 pragma Preelaborable_Initialization (Cursor); 59 60 Empty_Tree : constant Tree; 61 62 No_Element : constant Cursor; 63 function Has_Element (Position : Cursor) return Boolean; 64 65 package Tree_Iterator_Interfaces is new 66 Ada.Iterator_Interfaces (Cursor, Has_Element); 67 68 function Equal_Subtree 69 (Left_Position : Cursor; 70 Right_Position : Cursor) return Boolean; 71 72 function "=" (Left, Right : Tree) return Boolean; 73 74 function Is_Empty (Container : Tree) return Boolean; 75 76 function Node_Count (Container : Tree) return Count_Type; 77 78 function Subtree_Node_Count (Position : Cursor) return Count_Type; 79 80 function Depth (Position : Cursor) return Count_Type; 81 82 function Is_Root (Position : Cursor) return Boolean; 83 84 function Is_Leaf (Position : Cursor) return Boolean; 85 86 function Root (Container : Tree) return Cursor; 87 88 procedure Clear (Container : in out Tree); 89 90 function Element (Position : Cursor) return Element_Type; 91 92 procedure Replace_Element 93 (Container : in out Tree; 94 Position : Cursor; 95 New_Item : Element_Type); 96 97 procedure Query_Element 98 (Position : Cursor; 99 Process : not null access procedure (Element : Element_Type)); 100 101 procedure Update_Element 102 (Container : in out Tree; 103 Position : Cursor; 104 Process : not null access procedure (Element : in out Element_Type)); 105 106 type Constant_Reference_Type 107 (Element : not null access constant Element_Type) is private 108 with Implicit_Dereference => Element; 109 110 type Reference_Type 111 (Element : not null access Element_Type) is private 112 with Implicit_Dereference => Element; 113 114 function Constant_Reference 115 (Container : aliased Tree; 116 Position : Cursor) return Constant_Reference_Type; 117 pragma Inline (Constant_Reference); 118 119 function Reference 120 (Container : aliased in out Tree; 121 Position : Cursor) return Reference_Type; 122 pragma Inline (Reference); 123 124 procedure Assign (Target : in out Tree; Source : Tree); 125 126 function Copy (Source : Tree) return Tree; 127 128 procedure Move (Target : in out Tree; Source : in out Tree); 129 130 procedure Delete_Leaf 131 (Container : in out Tree; 132 Position : in out Cursor); 133 134 procedure Delete_Subtree 135 (Container : in out Tree; 136 Position : in out Cursor); 137 138 procedure Swap 139 (Container : in out Tree; 140 I, J : Cursor); 141 142 function Find 143 (Container : Tree; 144 Item : Element_Type) return Cursor; 145 146 -- This version of the AI: 147 -- 10-06-02 AI05-0136-1/07 148 -- declares Find_In_Subtree this way: 149 -- 150 -- function Find_In_Subtree 151 -- (Container : Tree; 152 -- Item : Element_Type; 153 -- Position : Cursor) return Cursor; 154 -- 155 -- It seems that the Container parameter is there by mistake, but we need 156 -- an official ruling from the ARG. ??? 157 158 function Find_In_Subtree 159 (Position : Cursor; 160 Item : Element_Type) return Cursor; 161 162 -- This version of the AI: 163 -- 10-06-02 AI05-0136-1/07 164 -- declares Ancestor_Find this way: 165 -- 166 -- function Ancestor_Find 167 -- (Container : Tree; 168 -- Item : Element_Type; 169 -- Position : Cursor) return Cursor; 170 -- 171 -- It seems that the Container parameter is there by mistake, but we need 172 -- an official ruling from the ARG. ??? 173 174 function Ancestor_Find 175 (Position : Cursor; 176 Item : Element_Type) return Cursor; 177 178 function Contains 179 (Container : Tree; 180 Item : Element_Type) return Boolean; 181 182 procedure Iterate 183 (Container : Tree; 184 Process : not null access procedure (Position : Cursor)); 185 186 procedure Iterate_Subtree 187 (Position : Cursor; 188 Process : not null access procedure (Position : Cursor)); 189 190 function Iterate (Container : Tree) 191 return Tree_Iterator_Interfaces.Forward_Iterator'Class; 192 193 function Iterate_Subtree (Position : Cursor) 194 return Tree_Iterator_Interfaces.Forward_Iterator'Class; 195 196 function Iterate_Children 197 (Container : Tree; 198 Parent : Cursor) 199 return Tree_Iterator_Interfaces.Reversible_Iterator'Class; 200 201 function Child_Count (Parent : Cursor) return Count_Type; 202 203 function Child_Depth (Parent, Child : Cursor) return Count_Type; 204 205 procedure Insert_Child 206 (Container : in out Tree; 207 Parent : Cursor; 208 Before : Cursor; 209 New_Item : Element_Type; 210 Count : Count_Type := 1); 211 212 procedure Insert_Child 213 (Container : in out Tree; 214 Parent : Cursor; 215 Before : Cursor; 216 New_Item : Element_Type; 217 Position : out Cursor; 218 Count : Count_Type := 1); 219 220 procedure Insert_Child 221 (Container : in out Tree; 222 Parent : Cursor; 223 Before : Cursor; 224 Position : out Cursor; 225 Count : Count_Type := 1); 226 227 procedure Prepend_Child 228 (Container : in out Tree; 229 Parent : Cursor; 230 New_Item : Element_Type; 231 Count : Count_Type := 1); 232 233 procedure Append_Child 234 (Container : in out Tree; 235 Parent : Cursor; 236 New_Item : Element_Type; 237 Count : Count_Type := 1); 238 239 procedure Delete_Children 240 (Container : in out Tree; 241 Parent : Cursor); 242 243 procedure Copy_Subtree 244 (Target : in out Tree; 245 Parent : Cursor; 246 Before : Cursor; 247 Source : Cursor); 248 249 procedure Splice_Subtree 250 (Target : in out Tree; 251 Parent : Cursor; 252 Before : Cursor; 253 Source : in out Tree; 254 Position : in out Cursor); 255 256 procedure Splice_Subtree 257 (Container : in out Tree; 258 Parent : Cursor; 259 Before : Cursor; 260 Position : Cursor); 261 262 procedure Splice_Children 263 (Target : in out Tree; 264 Target_Parent : Cursor; 265 Before : Cursor; 266 Source : in out Tree; 267 Source_Parent : Cursor); 268 269 procedure Splice_Children 270 (Container : in out Tree; 271 Target_Parent : Cursor; 272 Before : Cursor; 273 Source_Parent : Cursor); 274 275 function Parent (Position : Cursor) return Cursor; 276 277 function First_Child (Parent : Cursor) return Cursor; 278 279 function First_Child_Element (Parent : Cursor) return Element_Type; 280 281 function Last_Child (Parent : Cursor) return Cursor; 282 283 function Last_Child_Element (Parent : Cursor) return Element_Type; 284 285 function Next_Sibling (Position : Cursor) return Cursor; 286 287 function Previous_Sibling (Position : Cursor) return Cursor; 288 289 procedure Next_Sibling (Position : in out Cursor); 290 291 procedure Previous_Sibling (Position : in out Cursor); 292 293 -- This version of the AI: 294 -- 10-06-02 AI05-0136-1/07 295 -- declares Iterate_Children this way: 296 -- 297 -- procedure Iterate_Children 298 -- (Container : Tree; 299 -- Parent : Cursor; 300 -- Process : not null access procedure (Position : Cursor)); 301 -- 302 -- It seems that the Container parameter is there by mistake, but we need 303 -- an official ruling from the ARG. ??? 304 305 procedure Iterate_Children 306 (Parent : Cursor; 307 Process : not null access procedure (Position : Cursor)); 308 309 procedure Reverse_Iterate_Children 310 (Parent : Cursor; 311 Process : not null access procedure (Position : Cursor)); 312 313private 314 -- A node of this multiway tree comprises an element and a list of children 315 -- (that are themselves trees). The root node is distinguished because it 316 -- contains only children: it does not have an element itself. 317 318 -- This design feature puts two design goals in tension with one another: 319 -- (1) treat the root node the same as any other node 320 -- (2) not declare any objects of type Element_Type unnecessarily 321 322 -- To satisfy (1), we could simply declare the Root node of the tree 323 -- using the normal Tree_Node_Type, but that would mean that (2) is not 324 -- satisfied. To resolve the tension (in favor of (2)), we declare the 325 -- component Root as having a different node type, without an Element 326 -- component (thus satisfying goal (2)) but otherwise identical to a normal 327 -- node, and then use Unchecked_Conversion to convert an access object 328 -- designating the Root node component to the access type designating a 329 -- normal, non-root node (thus satisfying goal (1)). We make an explicit 330 -- check for Root when there is any attempt to manipulate the Element 331 -- component of the node (a check required by the RM anyway). 332 333 -- In order to be explicit about node (and pointer) representation, we 334 -- specify that the respective node types have convention C, to ensure 335 -- that the layout of the components of the node records is the same, 336 -- thus guaranteeing that (unchecked) conversions between access types 337 -- designating each kind of node type is a meaningful conversion. 338 339 use Ada.Containers.Helpers; 340 package Implementation is new Generic_Implementation; 341 use Implementation; 342 343 type Tree_Node_Type; 344 type Tree_Node_Access is access all Tree_Node_Type; 345 pragma Convention (C, Tree_Node_Access); 346 pragma No_Strict_Aliasing (Tree_Node_Access); 347 -- The above-mentioned Unchecked_Conversion is a violation of the normal 348 -- aliasing rules. 349 350 type Children_Type is record 351 First : Tree_Node_Access; 352 Last : Tree_Node_Access; 353 end record; 354 355 -- See the comment above. This declaration must exactly match the 356 -- declaration of Root_Node_Type (except for the Element component). 357 358 type Tree_Node_Type is record 359 Parent : Tree_Node_Access; 360 Prev : Tree_Node_Access; 361 Next : Tree_Node_Access; 362 Children : Children_Type; 363 Element : aliased Element_Type; 364 end record; 365 pragma Convention (C, Tree_Node_Type); 366 367 -- See the comment above. This declaration must match the declaration of 368 -- Tree_Node_Type (except for the Element component). 369 370 type Root_Node_Type is record 371 Parent : Tree_Node_Access; 372 Prev : Tree_Node_Access; 373 Next : Tree_Node_Access; 374 Children : Children_Type; 375 end record; 376 pragma Convention (C, Root_Node_Type); 377 378 for Root_Node_Type'Alignment use Standard'Maximum_Alignment; 379 -- The alignment has to be large enough to allow Root_Node to Tree_Node 380 -- access value conversions, and Tree_Node_Type's alignment may be bumped 381 -- up by the Element component. 382 383 use Ada.Finalization; 384 385 -- The Count component of type Tree represents the number of nodes that 386 -- have been (dynamically) allocated. It does not include the root node 387 -- itself. As implementors, we decide to cache this value, so that the 388 -- selector function Node_Count can execute in O(1) time, in order to be 389 -- consistent with the behavior of the Length selector function for other 390 -- standard container library units. This does mean, however, that the 391 -- two-container forms for Splice_XXX (that move subtrees across tree 392 -- containers) will execute in O(n) time, because we must count the number 393 -- of nodes in the subtree(s) that get moved. (We resolve the tension 394 -- between Node_Count and Splice_XXX in favor of Node_Count, under the 395 -- assumption that Node_Count is the more common operation). 396 397 type Tree is new Controlled with record 398 Root : aliased Root_Node_Type; 399 TC : aliased Tamper_Counts; 400 Count : Count_Type := 0; 401 end record; 402 403 overriding procedure Adjust (Container : in out Tree); 404 405 overriding procedure Finalize (Container : in out Tree) renames Clear; 406 407 use Ada.Streams; 408 409 procedure Write 410 (Stream : not null access Root_Stream_Type'Class; 411 Container : Tree); 412 413 for Tree'Write use Write; 414 415 procedure Read 416 (Stream : not null access Root_Stream_Type'Class; 417 Container : out Tree); 418 419 for Tree'Read use Read; 420 421 type Tree_Access is access all Tree; 422 for Tree_Access'Storage_Size use 0; 423 424 type Cursor is record 425 Container : Tree_Access; 426 Node : Tree_Node_Access; 427 end record; 428 429 procedure Write 430 (Stream : not null access Root_Stream_Type'Class; 431 Position : Cursor); 432 433 for Cursor'Write use Write; 434 435 procedure Read 436 (Stream : not null access Root_Stream_Type'Class; 437 Position : out Cursor); 438 439 for Cursor'Read use Read; 440 441 subtype Reference_Control_Type is Implementation.Reference_Control_Type; 442 -- It is necessary to rename this here, so that the compiler can find it 443 444 type Constant_Reference_Type 445 (Element : not null access constant Element_Type) is 446 record 447 Control : Reference_Control_Type := 448 raise Program_Error with "uninitialized reference"; 449 -- The RM says, "The default initialization of an object of 450 -- type Constant_Reference_Type or Reference_Type propagates 451 -- Program_Error." 452 end record; 453 454 procedure Read 455 (Stream : not null access Root_Stream_Type'Class; 456 Item : out Constant_Reference_Type); 457 458 for Constant_Reference_Type'Read use Read; 459 460 procedure Write 461 (Stream : not null access Root_Stream_Type'Class; 462 Item : Constant_Reference_Type); 463 464 for Constant_Reference_Type'Write use Write; 465 466 type Reference_Type 467 (Element : not null access 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 Reference_Type); 479 480 for Reference_Type'Read use Read; 481 482 procedure Write 483 (Stream : not null access Root_Stream_Type'Class; 484 Item : Reference_Type); 485 486 for Reference_Type'Write use Write; 487 488 -- Three operations are used to optimize in the expansion of "for ... of" 489 -- loops: the Next(Cursor) procedure in the visible part, and the following 490 -- Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for 491 -- details. 492 493 function Pseudo_Reference 494 (Container : aliased Tree'Class) return Reference_Control_Type; 495 pragma Inline (Pseudo_Reference); 496 -- Creates an object of type Reference_Control_Type pointing to the 497 -- container, and increments the Lock. Finalization of this object will 498 -- decrement the Lock. 499 500 type Element_Access is access all Element_Type with 501 Storage_Size => 0; 502 503 function Get_Element_Access 504 (Position : Cursor) return not null Element_Access; 505 -- Returns a pointer to the element designated by Position. 506 507 Empty_Tree : constant Tree := (Controlled with others => <>); 508 509 No_Element : constant Cursor := (others => <>); 510 511end Ada.Containers.Multiway_Trees; 512