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