1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- ADA.CONTAINERS.INDEFINITE_MULTIWAY_TREES -- 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.Indefinite_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 56 pragma Preelaborable_Initialization (Tree); 57 58 type Cursor is private; 59 pragma Preelaborable_Initialization (Cursor); 60 61 Empty_Tree : constant Tree; 62 63 No_Element : constant Cursor; 64 function Has_Element (Position : Cursor) return Boolean; 65 66 package Tree_Iterator_Interfaces is new 67 Ada.Iterator_Interfaces (Cursor, Has_Element); 68 69 function Equal_Subtree 70 (Left_Position : Cursor; 71 Right_Position : Cursor) return Boolean; 72 73 function "=" (Left, Right : Tree) return Boolean; 74 75 function Is_Empty (Container : Tree) return Boolean; 76 77 function Node_Count (Container : Tree) return Count_Type; 78 79 function Subtree_Node_Count (Position : Cursor) return Count_Type; 80 81 function Depth (Position : Cursor) return Count_Type; 82 83 function Is_Root (Position : Cursor) return Boolean; 84 85 function Is_Leaf (Position : Cursor) return Boolean; 86 87 function Root (Container : Tree) return Cursor; 88 89 procedure Clear (Container : in out Tree); 90 91 function Element (Position : Cursor) return Element_Type; 92 93 procedure Replace_Element 94 (Container : in out Tree; 95 Position : Cursor; 96 New_Item : Element_Type); 97 98 procedure Query_Element 99 (Position : Cursor; 100 Process : not null access procedure (Element : Element_Type)); 101 102 procedure Update_Element 103 (Container : in out Tree; 104 Position : Cursor; 105 Process : not null access procedure (Element : in out Element_Type)); 106 107 type Constant_Reference_Type 108 (Element : not null access constant Element_Type) is private 109 with Implicit_Dereference => Element; 110 111 type Reference_Type 112 (Element : not null access Element_Type) is private 113 with Implicit_Dereference => Element; 114 115 function Constant_Reference 116 (Container : aliased Tree; 117 Position : Cursor) return Constant_Reference_Type; 118 pragma Inline (Constant_Reference); 119 120 function Reference 121 (Container : aliased in out Tree; 122 Position : Cursor) return Reference_Type; 123 pragma Inline (Reference); 124 125 procedure Assign (Target : in out Tree; Source : Tree); 126 127 function Copy (Source : Tree) return Tree; 128 129 procedure Move (Target : in out Tree; Source : in out Tree); 130 131 procedure Delete_Leaf 132 (Container : in out Tree; 133 Position : in out Cursor); 134 135 procedure Delete_Subtree 136 (Container : in out Tree; 137 Position : in out Cursor); 138 139 procedure Swap 140 (Container : in out Tree; 141 I, J : Cursor); 142 143 function Find 144 (Container : Tree; 145 Item : Element_Type) return Cursor; 146 147 -- This version of the AI: 148 -- 10-06-02 AI05-0136-1/07 149 -- declares Find_In_Subtree this way: 150 -- 151 -- function Find_In_Subtree 152 -- (Container : Tree; 153 -- Item : Element_Type; 154 -- Position : Cursor) return Cursor; 155 -- 156 -- It seems that the Container parameter is there by mistake, but we need 157 -- an official ruling from the ARG. ??? 158 159 function Find_In_Subtree 160 (Position : Cursor; 161 Item : Element_Type) return Cursor; 162 163 -- This version of the AI: 164 -- 10-06-02 AI05-0136-1/07 165 -- declares Ancestor_Find this way: 166 -- 167 -- function Ancestor_Find 168 -- (Container : Tree; 169 -- Item : Element_Type; 170 -- Position : Cursor) return Cursor; 171 -- 172 -- It seems that the Container parameter is there by mistake, but we need 173 -- an official ruling from the ARG. ??? 174 175 function Ancestor_Find 176 (Position : Cursor; 177 Item : Element_Type) return Cursor; 178 179 function Contains 180 (Container : Tree; 181 Item : Element_Type) return Boolean; 182 183 procedure Iterate 184 (Container : Tree; 185 Process : not null access procedure (Position : Cursor)); 186 187 procedure Iterate_Subtree 188 (Position : Cursor; 189 Process : not null access procedure (Position : Cursor)); 190 191 function Iterate (Container : Tree) 192 return Tree_Iterator_Interfaces.Forward_Iterator'Class; 193 194 function Iterate_Subtree (Position : Cursor) 195 return Tree_Iterator_Interfaces.Forward_Iterator'Class; 196 197 function Iterate_Children 198 (Container : Tree; 199 Parent : Cursor) 200 return Tree_Iterator_Interfaces.Reversible_Iterator'Class; 201 202 function Child_Count (Parent : Cursor) return Count_Type; 203 204 function Child_Depth (Parent, Child : Cursor) return Count_Type; 205 206 procedure Insert_Child 207 (Container : in out Tree; 208 Parent : Cursor; 209 Before : Cursor; 210 New_Item : Element_Type; 211 Count : Count_Type := 1); 212 213 procedure Insert_Child 214 (Container : in out Tree; 215 Parent : Cursor; 216 Before : Cursor; 217 New_Item : Element_Type; 218 Position : out Cursor; 219 Count : Count_Type := 1); 220 221 procedure Prepend_Child 222 (Container : in out Tree; 223 Parent : Cursor; 224 New_Item : Element_Type; 225 Count : Count_Type := 1); 226 227 procedure Append_Child 228 (Container : in out Tree; 229 Parent : Cursor; 230 New_Item : Element_Type; 231 Count : Count_Type := 1); 232 233 procedure Delete_Children 234 (Container : in out Tree; 235 Parent : Cursor); 236 237 procedure Copy_Subtree 238 (Target : in out Tree; 239 Parent : Cursor; 240 Before : Cursor; 241 Source : Cursor); 242 243 procedure Splice_Subtree 244 (Target : in out Tree; 245 Parent : Cursor; 246 Before : Cursor; 247 Source : in out Tree; 248 Position : in out Cursor); 249 250 procedure Splice_Subtree 251 (Container : in out Tree; 252 Parent : Cursor; 253 Before : Cursor; 254 Position : Cursor); 255 256 procedure Splice_Children 257 (Target : in out Tree; 258 Target_Parent : Cursor; 259 Before : Cursor; 260 Source : in out Tree; 261 Source_Parent : Cursor); 262 263 procedure Splice_Children 264 (Container : in out Tree; 265 Target_Parent : Cursor; 266 Before : Cursor; 267 Source_Parent : Cursor); 268 269 function Parent (Position : Cursor) return Cursor; 270 271 function First_Child (Parent : Cursor) return Cursor; 272 273 function First_Child_Element (Parent : Cursor) return Element_Type; 274 275 function Last_Child (Parent : Cursor) return Cursor; 276 277 function Last_Child_Element (Parent : Cursor) return Element_Type; 278 279 function Next_Sibling (Position : Cursor) return Cursor; 280 281 function Previous_Sibling (Position : Cursor) return Cursor; 282 283 procedure Next_Sibling (Position : in out Cursor); 284 285 procedure Previous_Sibling (Position : in out Cursor); 286 287 -- This version of the AI: 288 -- 10-06-02 AI05-0136-1/07 289 -- declares Iterate_Children this way: 290 -- 291 -- procedure Iterate_Children 292 -- (Container : Tree; 293 -- Parent : Cursor; 294 -- Process : not null access procedure (Position : Cursor)); 295 -- 296 -- It seems that the Container parameter is there by mistake, but we need 297 -- an official ruling from the ARG. ??? 298 299 procedure Iterate_Children 300 (Parent : Cursor; 301 Process : not null access procedure (Position : Cursor)); 302 303 procedure Reverse_Iterate_Children 304 (Parent : Cursor; 305 Process : not null access procedure (Position : Cursor)); 306 307private 308 309 use Ada.Containers.Helpers; 310 package Implementation is new Generic_Implementation; 311 use Implementation; 312 313 type Tree_Node_Type; 314 type Tree_Node_Access is access all Tree_Node_Type; 315 316 type Children_Type is record 317 First : Tree_Node_Access; 318 Last : Tree_Node_Access; 319 end record; 320 321 type Element_Access is access all Element_Type; 322 323 type Tree_Node_Type is record 324 Parent : Tree_Node_Access; 325 Prev : Tree_Node_Access; 326 Next : Tree_Node_Access; 327 Children : Children_Type; 328 Element : Element_Access; 329 end record; 330 331 use Ada.Finalization; 332 333 -- The Count component of type Tree represents the number of nodes that 334 -- have been (dynamically) allocated. It does not include the root node 335 -- itself. As implementors, we decide to cache this value, so that the 336 -- selector function Node_Count can execute in O(1) time, in order to be 337 -- consistent with the behavior of the Length selector function for other 338 -- standard container library units. This does mean, however, that the 339 -- two-container forms for Splice_XXX (that move subtrees across tree 340 -- containers) will execute in O(n) time, because we must count the number 341 -- of nodes in the subtree(s) that get moved. (We resolve the tension 342 -- between Node_Count and Splice_XXX in favor of Node_Count, under the 343 -- assumption that Node_Count is the more common operation). 344 345 type Tree is new Controlled with record 346 Root : aliased Tree_Node_Type; 347 TC : aliased Tamper_Counts; 348 Count : Count_Type := 0; 349 end record; 350 351 overriding procedure Adjust (Container : in out Tree); 352 353 overriding procedure Finalize (Container : in out Tree) renames Clear; 354 355 use Ada.Streams; 356 357 procedure Write 358 (Stream : not null access Root_Stream_Type'Class; 359 Container : Tree); 360 361 for Tree'Write use Write; 362 363 procedure Read 364 (Stream : not null access Root_Stream_Type'Class; 365 Container : out Tree); 366 367 for Tree'Read use Read; 368 369 type Tree_Access is access all Tree; 370 for Tree_Access'Storage_Size use 0; 371 372 type Cursor is record 373 Container : Tree_Access; 374 Node : Tree_Node_Access; 375 end record; 376 377 procedure Write 378 (Stream : not null access Root_Stream_Type'Class; 379 Position : Cursor); 380 381 for Cursor'Write use Write; 382 383 procedure Read 384 (Stream : not null access Root_Stream_Type'Class; 385 Position : out Cursor); 386 387 for Cursor'Read use Read; 388 389 subtype Reference_Control_Type is Implementation.Reference_Control_Type; 390 -- It is necessary to rename this here, so that the compiler can find it 391 392 type Constant_Reference_Type 393 (Element : not null access constant Element_Type) is 394 record 395 Control : Reference_Control_Type := 396 raise Program_Error with "uninitialized reference"; 397 -- The RM says, "The default initialization of an object of 398 -- type Constant_Reference_Type or Reference_Type propagates 399 -- Program_Error." 400 end record; 401 402 procedure Read 403 (Stream : not null access Root_Stream_Type'Class; 404 Item : out Constant_Reference_Type); 405 406 for Constant_Reference_Type'Read use Read; 407 408 procedure Write 409 (Stream : not null access Root_Stream_Type'Class; 410 Item : Constant_Reference_Type); 411 412 for Constant_Reference_Type'Write use Write; 413 414 type Reference_Type 415 (Element : not null access Element_Type) is 416 record 417 Control : Reference_Control_Type := 418 raise Program_Error with "uninitialized reference"; 419 -- The RM says, "The default initialization of an object of 420 -- type Constant_Reference_Type or Reference_Type propagates 421 -- Program_Error." 422 end record; 423 424 procedure Read 425 (Stream : not null access Root_Stream_Type'Class; 426 Item : out Reference_Type); 427 428 for Reference_Type'Read use Read; 429 430 procedure Write 431 (Stream : not null access Root_Stream_Type'Class; 432 Item : Reference_Type); 433 434 for Reference_Type'Write use Write; 435 436 -- Three operations are used to optimize in the expansion of "for ... of" 437 -- loops: the Next(Cursor) procedure in the visible part, and the following 438 -- Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for 439 -- details. 440 441 function Pseudo_Reference 442 (Container : aliased Tree'Class) return Reference_Control_Type; 443 pragma Inline (Pseudo_Reference); 444 -- Creates an object of type Reference_Control_Type pointing to the 445 -- container, and increments the Lock. Finalization of this object will 446 -- decrement the Lock. 447 448 function Get_Element_Access 449 (Position : Cursor) return not null Element_Access; 450 -- Returns a pointer to the element designated by Position. 451 452 Empty_Tree : constant Tree := (Controlled with others => <>); 453 454 No_Element : constant Cursor := (others => <>); 455 456end Ada.Containers.Indefinite_Multiway_Trees; 457