1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- ADA.CONTAINERS.BOUNDED_MULTIWAY_TREES -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 2014, 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.Streams; 36private with Ada.Finalization; 37 38generic 39 type Element_Type is private; 40 41 with function "=" (Left, Right : Element_Type) return Boolean is <>; 42 43package Ada.Containers.Bounded_Multiway_Trees is 44 pragma Pure; 45 pragma Remote_Types; 46 47 type Tree (Capacity : Count_Type) 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 115 function Reference 116 (Container : aliased in out Tree; 117 Position : Cursor) return Reference_Type; 118 119 procedure Assign (Target : in out Tree; Source : Tree); 120 121 function Copy (Source : Tree; Capacity : Count_Type := 0) return Tree; 122 123 procedure Move (Target : in out Tree; Source : in out Tree); 124 125 procedure Delete_Leaf 126 (Container : in out Tree; 127 Position : in out Cursor); 128 129 procedure Delete_Subtree 130 (Container : in out Tree; 131 Position : in out Cursor); 132 133 procedure Swap 134 (Container : in out Tree; 135 I, J : Cursor); 136 137 function Find 138 (Container : Tree; 139 Item : Element_Type) return Cursor; 140 141 function Find_In_Subtree 142 (Position : Cursor; 143 Item : Element_Type) return Cursor; 144 145 function Ancestor_Find 146 (Position : Cursor; 147 Item : Element_Type) return Cursor; 148 149 function Contains 150 (Container : Tree; 151 Item : Element_Type) return Boolean; 152 153 procedure Iterate 154 (Container : Tree; 155 Process : not null access procedure (Position : Cursor)); 156 157 procedure Iterate_Subtree 158 (Position : Cursor; 159 Process : not null access procedure (Position : Cursor)); 160 161 function Iterate (Container : Tree) 162 return Tree_Iterator_Interfaces.Forward_Iterator'Class; 163 164 function Iterate_Subtree (Position : Cursor) 165 return Tree_Iterator_Interfaces.Forward_Iterator'Class; 166 167 function Iterate_Children 168 (Container : Tree; 169 Parent : Cursor) 170 return Tree_Iterator_Interfaces.Reversible_Iterator'Class; 171 172 function Child_Count (Parent : Cursor) return Count_Type; 173 174 function Child_Depth (Parent, Child : Cursor) return Count_Type; 175 176 procedure Insert_Child 177 (Container : in out Tree; 178 Parent : Cursor; 179 Before : Cursor; 180 New_Item : Element_Type; 181 Count : Count_Type := 1); 182 183 procedure Insert_Child 184 (Container : in out Tree; 185 Parent : Cursor; 186 Before : Cursor; 187 New_Item : Element_Type; 188 Position : out Cursor; 189 Count : Count_Type := 1); 190 191 procedure Insert_Child 192 (Container : in out Tree; 193 Parent : Cursor; 194 Before : Cursor; 195 Position : out Cursor; 196 Count : Count_Type := 1); 197 198 procedure Prepend_Child 199 (Container : in out Tree; 200 Parent : Cursor; 201 New_Item : Element_Type; 202 Count : Count_Type := 1); 203 204 procedure Append_Child 205 (Container : in out Tree; 206 Parent : Cursor; 207 New_Item : Element_Type; 208 Count : Count_Type := 1); 209 210 procedure Delete_Children 211 (Container : in out Tree; 212 Parent : Cursor); 213 214 procedure Copy_Subtree 215 (Target : in out Tree; 216 Parent : Cursor; 217 Before : Cursor; 218 Source : Cursor); 219 220 procedure Splice_Subtree 221 (Target : in out Tree; 222 Parent : Cursor; 223 Before : Cursor; 224 Source : in out Tree; 225 Position : in out Cursor); 226 227 procedure Splice_Subtree 228 (Container : in out Tree; 229 Parent : Cursor; 230 Before : Cursor; 231 Position : Cursor); 232 233 procedure Splice_Children 234 (Target : in out Tree; 235 Target_Parent : Cursor; 236 Before : Cursor; 237 Source : in out Tree; 238 Source_Parent : Cursor); 239 240 procedure Splice_Children 241 (Container : in out Tree; 242 Target_Parent : Cursor; 243 Before : Cursor; 244 Source_Parent : Cursor); 245 246 function Parent (Position : Cursor) return Cursor; 247 248 function First_Child (Parent : Cursor) return Cursor; 249 250 function First_Child_Element (Parent : Cursor) return Element_Type; 251 252 function Last_Child (Parent : Cursor) return Cursor; 253 254 function Last_Child_Element (Parent : Cursor) return Element_Type; 255 256 function Next_Sibling (Position : Cursor) return Cursor; 257 258 function Previous_Sibling (Position : Cursor) return Cursor; 259 260 procedure Next_Sibling (Position : in out Cursor); 261 262 procedure Previous_Sibling (Position : in out Cursor); 263 264 procedure Iterate_Children 265 (Parent : Cursor; 266 Process : not null access procedure (Position : Cursor)); 267 268 procedure Reverse_Iterate_Children 269 (Parent : Cursor; 270 Process : not null access procedure (Position : Cursor)); 271 272private 273 use Ada.Streams; 274 use Ada.Finalization; 275 276 No_Node : constant Count_Type'Base := -1; 277 -- Need to document all global declarations such as this ??? 278 279 -- Following decls also need much more documentation ??? 280 281 type Children_Type is record 282 First : Count_Type'Base; 283 Last : Count_Type'Base; 284 end record; 285 286 type Tree_Node_Type is record 287 Parent : Count_Type'Base; 288 Prev : Count_Type'Base; 289 Next : Count_Type'Base; 290 Children : Children_Type; 291 end record; 292 293 type Tree_Node_Array is array (Count_Type range <>) of Tree_Node_Type; 294 type Element_Array is array (Count_Type range <>) of aliased Element_Type; 295 296 type Tree (Capacity : Count_Type) is tagged record 297 Nodes : Tree_Node_Array (0 .. Capacity) := (others => <>); 298 Elements : Element_Array (1 .. Capacity) := (others => <>); 299 Free : Count_Type'Base := No_Node; 300 Busy : Integer := 0; 301 Lock : Integer := 0; 302 Count : Count_Type := 0; 303 end record; 304 305 procedure Write 306 (Stream : not null access Root_Stream_Type'Class; 307 Container : Tree); 308 309 for Tree'Write use Write; 310 311 procedure Read 312 (Stream : not null access Root_Stream_Type'Class; 313 Container : out Tree); 314 315 for Tree'Read use Read; 316 317 type Tree_Access is access all Tree; 318 for Tree_Access'Storage_Size use 0; 319 320 type Cursor is record 321 Container : Tree_Access; 322 Node : Count_Type'Base := No_Node; 323 end record; 324 325 procedure Read 326 (Stream : not null access Root_Stream_Type'Class; 327 Position : out Cursor); 328 for Cursor'Read use Read; 329 330 procedure Write 331 (Stream : not null access Root_Stream_Type'Class; 332 Position : Cursor); 333 for Cursor'Write use Write; 334 335 type Reference_Control_Type is 336 new Controlled with record 337 Container : Tree_Access; 338 end record; 339 340 overriding procedure Adjust (Control : in out Reference_Control_Type); 341 pragma Inline (Adjust); 342 343 overriding procedure Finalize (Control : in out Reference_Control_Type); 344 pragma Inline (Finalize); 345 346 type Constant_Reference_Type 347 (Element : not null access constant Element_Type) is 348 record 349 Control : Reference_Control_Type; 350 end record; 351 352 procedure Write 353 (Stream : not null access Root_Stream_Type'Class; 354 Item : Constant_Reference_Type); 355 for Constant_Reference_Type'Write use Write; 356 357 procedure Read 358 (Stream : not null access Root_Stream_Type'Class; 359 Item : out Constant_Reference_Type); 360 for Constant_Reference_Type'Read use Read; 361 362 type Reference_Type 363 (Element : not null access Element_Type) is 364 record 365 Control : Reference_Control_Type; 366 end record; 367 368 procedure Write 369 (Stream : not null access Root_Stream_Type'Class; 370 Item : Reference_Type); 371 for Reference_Type'Write use Write; 372 373 procedure Read 374 (Stream : not null access Root_Stream_Type'Class; 375 Item : out Reference_Type); 376 for Reference_Type'Read use Read; 377 378 Empty_Tree : constant Tree := (Capacity => 0, others => <>); 379 380 No_Element : constant Cursor := Cursor'(others => <>); 381 382end Ada.Containers.Bounded_Multiway_Trees; 383