gcc/ada/a-comutr.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --         A D A . C O N T A I N E R S . M U L T I W A Y _ T R E E S        --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2004-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.Finalization;
  36 private with Ada.Streams;
  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.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    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    pragma Inline (Constant_Reference);
 115
 116    function Reference
 117      (Container : aliased in out Tree;
 118       Position  : Cursor) return Reference_Type;
 119    pragma Inline (Reference);
 120
 121    procedure Assign (Target : in out Tree; Source : Tree);
 122
 123    function Copy (Source : Tree) 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    --  This version of the AI:
 144    --   10-06-02  AI05-0136-1/07
 145    --  declares Find_In_Subtree this way:
 146    --
 147    --  function Find_In_Subtree
 148    --    (Container : Tree;
 149    --     Item      : Element_Type;
 150    --     Position  : Cursor) return Cursor;
 151    --
 152    --  It seems that the Container parameter is there by mistake, but we need
 153    --  an official ruling from the ARG. ???
 154
 155    function Find_In_Subtree
 156      (Position : Cursor;
 157       Item     : Element_Type) return Cursor;
 158
 159    --  This version of the AI:
 160    --   10-06-02  AI05-0136-1/07
 161    --  declares Ancestor_Find this way:
 162    --
 163    --  function Ancestor_Find
 164    --    (Container : Tree;
 165    --     Item      : Element_Type;
 166    --     Position  : Cursor) return Cursor;
 167    --
 168    --  It seems that the Container parameter is there by mistake, but we need
 169    --  an official ruling from the ARG. ???
 170
 171    function Ancestor_Find
 172      (Position : Cursor;
 173       Item     : Element_Type) return Cursor;
 174
 175    function Contains
 176      (Container : Tree;
 177       Item      : Element_Type) return Boolean;
 178
 179    procedure Iterate
 180      (Container : Tree;
 181       Process   : not null access procedure (Position : Cursor));
 182
 183    procedure Iterate_Subtree
 184      (Position : Cursor;
 185       Process  : not null access procedure (Position : Cursor));
 186
 187    function Iterate (Container : Tree)
 188      return Tree_Iterator_Interfaces.Forward_Iterator'Class;
 189
 190    function Iterate_Subtree (Position : Cursor)
 191      return Tree_Iterator_Interfaces.Forward_Iterator'Class;
 192
 193    function Iterate_Children
 194      (Container : Tree;
 195       Parent    : Cursor)
 196       return Tree_Iterator_Interfaces.Reversible_Iterator'Class;
 197
 198    function Child_Count (Parent : Cursor) return Count_Type;
 199
 200    function Child_Depth (Parent, Child : Cursor) return Count_Type;
 201
 202    procedure Insert_Child
 203      (Container : in out Tree;
 204       Parent    : Cursor;
 205       Before    : Cursor;
 206       New_Item  : Element_Type;
 207       Count     : Count_Type := 1);
 208
 209    procedure Insert_Child
 210      (Container : in out Tree;
 211       Parent    : Cursor;
 212       Before    : Cursor;
 213       New_Item  : Element_Type;
 214       Position  : out Cursor;
 215       Count     : Count_Type := 1);
 216
 217    procedure Insert_Child
 218      (Container : in out Tree;
 219       Parent    : Cursor;
 220       Before    : Cursor;
 221       Position  : out Cursor;
 222       Count     : Count_Type := 1);
 223
 224    procedure Prepend_Child
 225      (Container : in out Tree;
 226       Parent    : Cursor;
 227       New_Item  : Element_Type;
 228       Count     : Count_Type := 1);
 229
 230    procedure Append_Child
 231      (Container : in out Tree;
 232       Parent    : Cursor;
 233       New_Item  : Element_Type;
 234       Count     : Count_Type := 1);
 235
 236    procedure Delete_Children
 237      (Container : in out Tree;
 238       Parent    : Cursor);
 239
 240    procedure Copy_Subtree
 241      (Target   : in out Tree;
 242       Parent   : Cursor;
 243       Before   : Cursor;
 244       Source   : Cursor);
 245
 246    procedure Splice_Subtree
 247      (Target   : in out Tree;
 248       Parent   : Cursor;
 249       Before   : Cursor;
 250       Source   : in out Tree;
 251       Position : in out Cursor);
 252
 253    procedure Splice_Subtree
 254      (Container : in out Tree;
 255       Parent    : Cursor;
 256       Before    : Cursor;
 257       Position  : Cursor);
 258
 259    procedure Splice_Children
 260      (Target          : in out Tree;
 261       Target_Parent   : Cursor;
 262       Before          : Cursor;
 263       Source          : in out Tree;
 264       Source_Parent   : Cursor);
 265
 266    procedure Splice_Children
 267      (Container       : in out Tree;
 268       Target_Parent   : Cursor;
 269       Before          : Cursor;
 270       Source_Parent   : Cursor);
 271
 272    function Parent (Position : Cursor) return Cursor;
 273
 274    function First_Child (Parent : Cursor) return Cursor;
 275
 276    function First_Child_Element (Parent : Cursor) return Element_Type;
 277
 278    function Last_Child (Parent : Cursor) return Cursor;
 279
 280    function Last_Child_Element (Parent : Cursor) return Element_Type;
 281
 282    function Next_Sibling (Position : Cursor) return Cursor;
 283
 284    function Previous_Sibling (Position : Cursor) return Cursor;
 285
 286    procedure Next_Sibling (Position : in out Cursor);
 287
 288    procedure Previous_Sibling (Position : in out Cursor);
 289
 290    --  This version of the AI:
 291    --   10-06-02  AI05-0136-1/07
 292    --  declares Iterate_Children this way:
 293    --
 294    --  procedure Iterate_Children
 295    --    (Container : Tree;
 296    --     Parent    : Cursor;
 297    --     Process   : not null access procedure (Position : Cursor));
 298    --
 299    --  It seems that the Container parameter is there by mistake, but we need
 300    --  an official ruling from the ARG. ???
 301
 302    procedure Iterate_Children
 303      (Parent  : Cursor;
 304       Process : not null access procedure (Position : Cursor));
 305
 306    procedure Reverse_Iterate_Children
 307      (Parent  : Cursor;
 308       Process : not null access procedure (Position : Cursor));
 309
 310 private
 311    --  A node of this multiway tree comprises an element and a list of children
 312    --  (that are themselves trees). The root node is distinguished because it
 313    --  contains only children: it does not have an element itself.
 314
 315    --  This design feature puts two design goals in tension with one another:
 316    --   (1) treat the root node the same as any other node
 317    --   (2) not declare any objects of type Element_Type unnecessarily
 318
 319    --  To satisfy (1), we could simply declare the Root node of the tree
 320    --  using the normal Tree_Node_Type, but that would mean that (2) is not
 321    --  satisfied. To resolve the tension (in favor of (2)), we declare the
 322    --  component Root as having a different node type, without an Element
 323    --  component (thus satisfying goal (2)) but otherwise identical to a normal
 324    --  node, and then use Unchecked_Conversion to convert an access object
 325    --  designating the Root node component to the access type designating a
 326    --  normal, non-root node (thus satisfying goal (1)). We make an explicit
 327    --  check for Root when there is any attempt to manipulate the Element
 328    --  component of the node (a check required by the RM anyway).
 329
 330    --  In order to be explicit about node (and pointer) representation, we
 331    --  specify that the respective node types have convention C, to ensure
 332    --  that the layout of the components of the node records is the same,
 333    --  thus guaranteeing that (unchecked) conversions between access types
 334    --  designating each kind of node type is a meaningful conversion.
 335
 336    type Tree_Node_Type;
 337    type Tree_Node_Access is access all Tree_Node_Type;
 338    pragma Convention (C, Tree_Node_Access);
 339
 340    type Children_Type is record
 341       First : Tree_Node_Access;
 342       Last  : Tree_Node_Access;
 343    end record;
 344
 345    --  See the comment above. This declaration must exactly match the
 346    --  declaration of Root_Node_Type (except for the Element component).
 347
 348    type Tree_Node_Type is record
 349       Parent   : Tree_Node_Access;
 350       Prev     : Tree_Node_Access;
 351       Next     : Tree_Node_Access;
 352       Children : Children_Type;
 353       Element  : aliased Element_Type;
 354    end record;
 355    pragma Convention (C, Tree_Node_Type);
 356
 357    --  See the comment above. This declaration must match the declaration of
 358    --  Tree_Node_Type (except for the Element component).
 359
 360    type Root_Node_Type is record
 361       Parent   : Tree_Node_Access;
 362       Prev     : Tree_Node_Access;
 363       Next     : Tree_Node_Access;
 364       Children : Children_Type;
 365    end record;
 366    pragma Convention (C, Root_Node_Type);
 367
 368    for Root_Node_Type'Alignment use Standard'Maximum_Alignment;
 369    --  The alignment has to be large enough to allow Root_Node to Tree_Node
 370    --  access value conversions, and Tree_Node_Type's alignment may be bumped
 371    --  up by the Element component.
 372
 373    use Ada.Finalization;
 374
 375    --  The Count component of type Tree represents the number of nodes that
 376    --  have been (dynamically) allocated. It does not include the root node
 377    --  itself. As implementors, we decide to cache this value, so that the
 378    --  selector function Node_Count can execute in O(1) time, in order to be
 379    --  consistent with the behavior of the Length selector function for other
 380    --  standard container library units. This does mean, however, that the
 381    --  two-container forms for Splice_XXX (that move subtrees across tree
 382    --  containers) will execute in O(n) time, because we must count the number
 383    --  of nodes in the subtree(s) that get moved. (We resolve the tension
 384    --  between Node_Count and Splice_XXX in favor of Node_Count, under the
 385    --  assumption that Node_Count is the more common operation).
 386
 387    type Tree is new Controlled with record
 388       Root  : aliased Root_Node_Type;
 389       Busy  : Natural := 0;
 390       Lock  : Natural := 0;
 391       Count : Count_Type := 0;
 392    end record;
 393
 394    overriding procedure Adjust (Container : in out Tree);
 395
 396    overriding procedure Finalize (Container : in out Tree) renames Clear;
 397
 398    use Ada.Streams;
 399
 400    procedure Write
 401      (Stream    : not null access Root_Stream_Type'Class;
 402       Container : Tree);
 403
 404    for Tree'Write use Write;
 405
 406    procedure Read
 407      (Stream    : not null access Root_Stream_Type'Class;
 408       Container : out Tree);
 409
 410    for Tree'Read use Read;
 411
 412    type Tree_Access is access all Tree;
 413    for Tree_Access'Storage_Size use 0;
 414
 415    type Cursor is record
 416       Container : Tree_Access;
 417       Node      : Tree_Node_Access;
 418    end record;
 419
 420    procedure Write
 421      (Stream   : not null access Root_Stream_Type'Class;
 422       Position : Cursor);
 423
 424    for Cursor'Write use Write;
 425
 426    procedure Read
 427      (Stream   : not null access Root_Stream_Type'Class;
 428       Position : out Cursor);
 429
 430    for Cursor'Read use Read;
 431
 432    type Reference_Control_Type is
 433       new Controlled with record
 434          Container : Tree_Access;
 435       end record;
 436
 437    overriding procedure Adjust (Control : in out Reference_Control_Type);
 438    pragma Inline (Adjust);
 439
 440    overriding procedure Finalize (Control : in out Reference_Control_Type);
 441    pragma Inline (Finalize);
 442
 443    type Constant_Reference_Type
 444      (Element : not null access constant Element_Type) is
 445       record
 446          Control : Reference_Control_Type :=
 447            raise Program_Error with "uninitialized reference";
 448          --  The RM says, "The default initialization of an object of
 449          --  type Constant_Reference_Type or Reference_Type propagates
 450          --  Program_Error."
 451       end record;
 452
 453    procedure Read
 454      (Stream : not null access Root_Stream_Type'Class;
 455       Item   : out Constant_Reference_Type);
 456
 457    for Constant_Reference_Type'Read use Read;
 458
 459    procedure Write
 460      (Stream : not null access Root_Stream_Type'Class;
 461       Item   : Constant_Reference_Type);
 462
 463    for Constant_Reference_Type'Write use Write;
 464
 465    type Reference_Type
 466      (Element : not null access Element_Type) is
 467       record
 468          Control : Reference_Control_Type :=
 469            raise Program_Error with "uninitialized reference";
 470          --  The RM says, "The default initialization of an object of
 471          --  type Constant_Reference_Type or Reference_Type propagates
 472          --  Program_Error."
 473       end record;
 474
 475    procedure Read
 476      (Stream : not null access Root_Stream_Type'Class;
 477       Item   : out Reference_Type);
 478
 479    for Reference_Type'Read use Read;
 480
 481    procedure Write
 482      (Stream : not null access Root_Stream_Type'Class;
 483       Item   : Reference_Type);
 484
 485    for Reference_Type'Write use Write;
 486
 487    Empty_Tree : constant Tree := (Controlled with others => <>);
 488
 489    No_Element : constant Cursor := (others => <>);
 490
 491 end Ada.Containers.Multiway_Trees;