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
  36 with Ada.Containers.Helpers;
  37 private with Ada.Streams;
  38
  39 generic
  40    type Element_Type is private;
  41
  42    with function "=" (Left, Right : Element_Type) return Boolean is <>;
  43
  44 package 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
 274 private
 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
 406 end Ada.Containers.Bounded_Multiway_Trees;