gcc/ada/a-cbmutr.ads

   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
  34 with Ada.Iterator_Interfaces;
  35 private with Ada.Streams;
  36 private with Ada.Finalization;
  37
  38 generic
  39    type Element_Type is private;
  40
  41    with function "=" (Left, Right : Element_Type) return Boolean is <>;
  42
  43 package 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
 272 private
 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            raise Program_Error with "uninitialized reference";
 351          --  The RM says, "The default initialization of an object of
 352          --  type Constant_Reference_Type or Reference_Type propagates
 353          --  Program_Error."
 354       end record;
 355
 356    procedure Write
 357      (Stream : not null access Root_Stream_Type'Class;
 358       Item   : Constant_Reference_Type);
 359    for Constant_Reference_Type'Write use Write;
 360
 361    procedure Read
 362      (Stream : not null access Root_Stream_Type'Class;
 363       Item   : out Constant_Reference_Type);
 364    for Constant_Reference_Type'Read use Read;
 365
 366    type Reference_Type
 367      (Element : not null access Element_Type) is
 368       record
 369          Control : Reference_Control_Type :=
 370            raise Program_Error with "uninitialized reference";
 371          --  The RM says, "The default initialization of an object of
 372          --  type Constant_Reference_Type or Reference_Type propagates
 373          --  Program_Error."
 374       end record;
 375
 376    procedure Write
 377      (Stream : not null access Root_Stream_Type'Class;
 378       Item   : Reference_Type);
 379    for Reference_Type'Write use Write;
 380
 381    procedure Read
 382      (Stream : not null access Root_Stream_Type'Class;
 383       Item   : out Reference_Type);
 384    for Reference_Type'Read use Read;
 385
 386    Empty_Tree : constant Tree := (Capacity => 0, others => <>);
 387
 388    No_Element : constant Cursor := Cursor'(others => <>);
 389
 390 end Ada.Containers.Bounded_Multiway_Trees;