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