1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- ADA.CONTAINERS.BOUNDED_MULTIWAY_TREES -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 2014-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.Streams; 38 39generic 40 type Element_Type is private; 41 42 with function "=" (Left, Right : Element_Type) return Boolean is <>; 43 44package Ada.Containers.Bounded_Multiway_Trees is 45 pragma Annotate (CodePeer, Skip_Analysis); 46 pragma Pure; 47 pragma Remote_Types; 48 49 type Tree (Capacity : Count_Type) is tagged private 50 with Constant_Indexing => Constant_Reference, 51 Variable_Indexing => Reference, 52 Default_Iterator => Iterate, 53 Iterator_Element => Element_Type; 54 pragma Preelaborable_Initialization (Tree); 55 56 type Cursor is private; 57 pragma Preelaborable_Initialization (Cursor); 58 59 Empty_Tree : constant Tree; 60 61 No_Element : constant Cursor; 62 function Has_Element (Position : Cursor) return Boolean; 63 64 package Tree_Iterator_Interfaces is new 65 Ada.Iterator_Interfaces (Cursor, Has_Element); 66 67 function Equal_Subtree 68 (Left_Position : Cursor; 69 Right_Position : Cursor) return Boolean; 70 71 function "=" (Left, Right : Tree) return Boolean; 72 73 function Is_Empty (Container : Tree) return Boolean; 74 75 function Node_Count (Container : Tree) return Count_Type; 76 77 function Subtree_Node_Count (Position : Cursor) return Count_Type; 78 79 function Depth (Position : Cursor) return Count_Type; 80 81 function Is_Root (Position : Cursor) return Boolean; 82 83 function Is_Leaf (Position : Cursor) return Boolean; 84 85 function Root (Container : Tree) return Cursor; 86 87 procedure Clear (Container : in out Tree); 88 89 function Element (Position : Cursor) return Element_Type; 90 91 procedure Replace_Element 92 (Container : in out Tree; 93 Position : Cursor; 94 New_Item : Element_Type); 95 96 procedure Query_Element 97 (Position : Cursor; 98 Process : not null access procedure (Element : Element_Type)); 99 100 procedure Update_Element 101 (Container : in out Tree; 102 Position : Cursor; 103 Process : not null access procedure (Element : in out Element_Type)); 104 105 type Constant_Reference_Type 106 (Element : not null access constant Element_Type) is private 107 with Implicit_Dereference => Element; 108 109 type Reference_Type 110 (Element : not null access Element_Type) is private 111 with Implicit_Dereference => Element; 112 113 function Constant_Reference 114 (Container : aliased Tree; 115 Position : Cursor) return Constant_Reference_Type; 116 117 function Reference 118 (Container : aliased in out Tree; 119 Position : Cursor) return Reference_Type; 120 121 procedure Assign (Target : in out Tree; Source : Tree); 122 123 function Copy (Source : Tree; Capacity : Count_Type := 0) 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 function Find_In_Subtree 144 (Position : Cursor; 145 Item : Element_Type) return Cursor; 146 147 function Ancestor_Find 148 (Position : Cursor; 149 Item : Element_Type) return Cursor; 150 151 function Contains 152 (Container : Tree; 153 Item : Element_Type) return Boolean; 154 155 procedure Iterate 156 (Container : Tree; 157 Process : not null access procedure (Position : Cursor)); 158 159 procedure Iterate_Subtree 160 (Position : Cursor; 161 Process : not null access procedure (Position : Cursor)); 162 163 function Iterate (Container : Tree) 164 return Tree_Iterator_Interfaces.Forward_Iterator'Class; 165 166 function Iterate_Subtree (Position : Cursor) 167 return Tree_Iterator_Interfaces.Forward_Iterator'Class; 168 169 function Iterate_Children 170 (Container : Tree; 171 Parent : Cursor) 172 return Tree_Iterator_Interfaces.Reversible_Iterator'Class; 173 174 function Child_Count (Parent : Cursor) return Count_Type; 175 176 function Child_Depth (Parent, Child : Cursor) return Count_Type; 177 178 procedure Insert_Child 179 (Container : in out Tree; 180 Parent : Cursor; 181 Before : Cursor; 182 New_Item : Element_Type; 183 Count : Count_Type := 1); 184 185 procedure Insert_Child 186 (Container : in out Tree; 187 Parent : Cursor; 188 Before : Cursor; 189 New_Item : Element_Type; 190 Position : out Cursor; 191 Count : Count_Type := 1); 192 193 procedure Insert_Child 194 (Container : in out Tree; 195 Parent : Cursor; 196 Before : Cursor; 197 Position : out Cursor; 198 Count : Count_Type := 1); 199 200 procedure Prepend_Child 201 (Container : in out Tree; 202 Parent : Cursor; 203 New_Item : Element_Type; 204 Count : Count_Type := 1); 205 206 procedure Append_Child 207 (Container : in out Tree; 208 Parent : Cursor; 209 New_Item : Element_Type; 210 Count : Count_Type := 1); 211 212 procedure Delete_Children 213 (Container : in out Tree; 214 Parent : Cursor); 215 216 procedure Copy_Subtree 217 (Target : in out Tree; 218 Parent : Cursor; 219 Before : Cursor; 220 Source : Cursor); 221 222 procedure Splice_Subtree 223 (Target : in out Tree; 224 Parent : Cursor; 225 Before : Cursor; 226 Source : in out Tree; 227 Position : in out Cursor); 228 229 procedure Splice_Subtree 230 (Container : in out Tree; 231 Parent : Cursor; 232 Before : Cursor; 233 Position : Cursor); 234 235 procedure Splice_Children 236 (Target : in out Tree; 237 Target_Parent : Cursor; 238 Before : Cursor; 239 Source : in out Tree; 240 Source_Parent : Cursor); 241 242 procedure Splice_Children 243 (Container : in out Tree; 244 Target_Parent : Cursor; 245 Before : Cursor; 246 Source_Parent : Cursor); 247 248 function Parent (Position : Cursor) return Cursor; 249 250 function First_Child (Parent : Cursor) return Cursor; 251 252 function First_Child_Element (Parent : Cursor) return Element_Type; 253 254 function Last_Child (Parent : Cursor) return Cursor; 255 256 function Last_Child_Element (Parent : Cursor) return Element_Type; 257 258 function Next_Sibling (Position : Cursor) return Cursor; 259 260 function Previous_Sibling (Position : Cursor) return Cursor; 261 262 procedure Next_Sibling (Position : in out Cursor); 263 264 procedure Previous_Sibling (Position : in out Cursor); 265 266 procedure Iterate_Children 267 (Parent : Cursor; 268 Process : not null access procedure (Position : Cursor)); 269 270 procedure Reverse_Iterate_Children 271 (Parent : Cursor; 272 Process : not null access procedure (Position : Cursor)); 273 274private 275 276 use Ada.Containers.Helpers; 277 package Implementation is new Generic_Implementation; 278 use Implementation; 279 280 use Ada.Streams; 281 282 No_Node : constant Count_Type'Base := -1; 283 -- Need to document all global declarations such as this ??? 284 285 -- Following decls also need much more documentation ??? 286 287 type Children_Type is record 288 First : Count_Type'Base; 289 Last : Count_Type'Base; 290 end record; 291 292 type Tree_Node_Type is record 293 Parent : Count_Type'Base; 294 Prev : Count_Type'Base; 295 Next : Count_Type'Base; 296 Children : Children_Type; 297 end record; 298 299 type Tree_Node_Array is array (Count_Type range <>) of Tree_Node_Type; 300 type Element_Array is array (Count_Type range <>) of aliased Element_Type; 301 302 type Tree (Capacity : Count_Type) is tagged record 303 Nodes : Tree_Node_Array (0 .. Capacity) := (others => <>); 304 Elements : Element_Array (1 .. Capacity) := (others => <>); 305 Free : Count_Type'Base := No_Node; 306 TC : aliased Tamper_Counts; 307 Count : Count_Type := 0; 308 end record; 309 310 procedure Write 311 (Stream : not null access Root_Stream_Type'Class; 312 Container : Tree); 313 314 for Tree'Write use Write; 315 316 procedure Read 317 (Stream : not null access Root_Stream_Type'Class; 318 Container : out Tree); 319 320 for Tree'Read use Read; 321 322 type Tree_Access is access all Tree; 323 for Tree_Access'Storage_Size use 0; 324 325 type Cursor is record 326 Container : Tree_Access; 327 Node : Count_Type'Base := No_Node; 328 end record; 329 330 procedure Read 331 (Stream : not null access Root_Stream_Type'Class; 332 Position : out Cursor); 333 for Cursor'Read use Read; 334 335 procedure Write 336 (Stream : not null access Root_Stream_Type'Class; 337 Position : Cursor); 338 for Cursor'Write use Write; 339 340 subtype Reference_Control_Type is Implementation.Reference_Control_Type; 341 -- It is necessary to rename this here, so that the compiler can find it 342 343 type Constant_Reference_Type 344 (Element : not null access constant Element_Type) is 345 record 346 Control : Reference_Control_Type := 347 raise Program_Error with "uninitialized reference"; 348 -- The RM says, "The default initialization of an object of 349 -- type Constant_Reference_Type or Reference_Type propagates 350 -- Program_Error." 351 end record; 352 353 procedure Write 354 (Stream : not null access Root_Stream_Type'Class; 355 Item : Constant_Reference_Type); 356 for Constant_Reference_Type'Write use Write; 357 358 procedure Read 359 (Stream : not null access Root_Stream_Type'Class; 360 Item : out Constant_Reference_Type); 361 for Constant_Reference_Type'Read use Read; 362 363 type Reference_Type 364 (Element : not null access Element_Type) is 365 record 366 Control : Reference_Control_Type := 367 raise Program_Error with "uninitialized reference"; 368 -- The RM says, "The default initialization of an object of 369 -- type Constant_Reference_Type or Reference_Type propagates 370 -- Program_Error." 371 end record; 372 373 procedure Write 374 (Stream : not null access Root_Stream_Type'Class; 375 Item : Reference_Type); 376 for Reference_Type'Write use Write; 377 378 procedure Read 379 (Stream : not null access Root_Stream_Type'Class; 380 Item : out Reference_Type); 381 for Reference_Type'Read use Read; 382 383 -- Three operations are used to optimize in the expansion of "for ... of" 384 -- loops: the Next(Cursor) procedure in the visible part, and the following 385 -- Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for 386 -- details. 387 388 function Pseudo_Reference 389 (Container : aliased Tree'Class) return Reference_Control_Type; 390 pragma Inline (Pseudo_Reference); 391 -- Creates an object of type Reference_Control_Type pointing to the 392 -- container, and increments the Lock. Finalization of this object will 393 -- decrement the Lock. 394 395 type Element_Access is access all Element_Type with 396 Storage_Size => 0; 397 398 function Get_Element_Access 399 (Position : Cursor) return not null Element_Access; 400 -- Returns a pointer to the element designated by Position. 401 402 Empty_Tree : constant Tree := (Capacity => 0, others => <>); 403 404 No_Element : constant Cursor := Cursor'(others => <>); 405 406end Ada.Containers.Bounded_Multiway_Trees; 407