File : 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 --                                                                          --
  23 --                                                                          --
  24 --                                                                          --
  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.Finalization;
  38 private with Ada.Streams;
  39 
  40 generic
  41    type Element_Type is private;
  42 
  43    with function "=" (Left, Right : Element_Type) return Boolean is <>;
  44 
  45 package Ada.Containers.Multiway_Trees is
  46    pragma Annotate (CodePeer, Skip_Analysis);
  47    pragma Preelaborate;
  48    pragma Remote_Types;
  49 
  50    type Tree is tagged private
  51      with Constant_Indexing => Constant_Reference,
  52           Variable_Indexing => Reference,
  53           Default_Iterator  => Iterate,
  54           Iterator_Element  => Element_Type;
  55    pragma Preelaborable_Initialization (Tree);
  56 
  57    type Cursor is private;
  58    pragma Preelaborable_Initialization (Cursor);
  59 
  60    Empty_Tree : constant Tree;
  61 
  62    No_Element : constant Cursor;
  63    function Has_Element (Position : Cursor) return Boolean;
  64 
  65    package Tree_Iterator_Interfaces is new
  66      Ada.Iterator_Interfaces (Cursor, Has_Element);
  67 
  68    function Equal_Subtree
  69      (Left_Position  : Cursor;
  70       Right_Position : Cursor) return Boolean;
  71 
  72    function "=" (Left, Right : Tree) return Boolean;
  73 
  74    function Is_Empty (Container : Tree) return Boolean;
  75 
  76    function Node_Count (Container : Tree) return Count_Type;
  77 
  78    function Subtree_Node_Count (Position : Cursor) return Count_Type;
  79 
  80    function Depth (Position : Cursor) return Count_Type;
  81 
  82    function Is_Root (Position : Cursor) return Boolean;
  83 
  84    function Is_Leaf (Position : Cursor) return Boolean;
  85 
  86    function Root (Container : Tree) return Cursor;
  87 
  88    procedure Clear (Container : in out Tree);
  89 
  90    function Element (Position : Cursor) return Element_Type;
  91 
  92    procedure Replace_Element
  93      (Container : in out Tree;
  94       Position  : Cursor;
  95       New_Item  : Element_Type);
  96 
  97    procedure Query_Element
  98      (Position : Cursor;
  99       Process  : not null access procedure (Element : Element_Type));
 100 
 101    procedure Update_Element
 102      (Container : in out Tree;
 103       Position  : Cursor;
 104       Process   : not null access procedure (Element : in out Element_Type));
 105 
 106    type Constant_Reference_Type
 107      (Element : not null access constant Element_Type) is private
 108         with Implicit_Dereference => Element;
 109 
 110    type Reference_Type
 111      (Element : not null access Element_Type) is private
 112         with Implicit_Dereference => Element;
 113 
 114    function Constant_Reference
 115      (Container : aliased Tree;
 116       Position  : Cursor) return Constant_Reference_Type;
 117    pragma Inline (Constant_Reference);
 118 
 119    function Reference
 120      (Container : aliased in out Tree;
 121       Position  : Cursor) return Reference_Type;
 122    pragma Inline (Reference);
 123 
 124    procedure Assign (Target : in out Tree; Source : Tree);
 125 
 126    function Copy (Source : Tree) return Tree;
 127 
 128    procedure Move (Target : in out Tree; Source : in out Tree);
 129 
 130    procedure Delete_Leaf
 131      (Container : in out Tree;
 132       Position  : in out Cursor);
 133 
 134    procedure Delete_Subtree
 135      (Container : in out Tree;
 136       Position  : in out Cursor);
 137 
 138    procedure Swap
 139      (Container : in out Tree;
 140       I, J      : Cursor);
 141 
 142    function Find
 143      (Container : Tree;
 144       Item      : Element_Type) return Cursor;
 145 
 146    --  This version of the AI:
 147    --   10-06-02  AI05-0136-1/07
 148    --  declares Find_In_Subtree this way:
 149    --
 150    --  function Find_In_Subtree
 151    --    (Container : Tree;
 152    --     Item      : Element_Type;
 153    --     Position  : Cursor) return Cursor;
 154    --
 155    --  It seems that the Container parameter is there by mistake, but we need
 156    --  an official ruling from the ARG. ???
 157 
 158    function Find_In_Subtree
 159      (Position : Cursor;
 160       Item     : Element_Type) return Cursor;
 161 
 162    --  This version of the AI:
 163    --   10-06-02  AI05-0136-1/07
 164    --  declares Ancestor_Find this way:
 165    --
 166    --  function Ancestor_Find
 167    --    (Container : Tree;
 168    --     Item      : Element_Type;
 169    --     Position  : Cursor) return Cursor;
 170    --
 171    --  It seems that the Container parameter is there by mistake, but we need
 172    --  an official ruling from the ARG. ???
 173 
 174    function Ancestor_Find
 175      (Position : Cursor;
 176       Item     : Element_Type) return Cursor;
 177 
 178    function Contains
 179      (Container : Tree;
 180       Item      : Element_Type) return Boolean;
 181 
 182    procedure Iterate
 183      (Container : Tree;
 184       Process   : not null access procedure (Position : Cursor));
 185 
 186    procedure Iterate_Subtree
 187      (Position : Cursor;
 188       Process  : not null access procedure (Position : Cursor));
 189 
 190    function Iterate (Container : Tree)
 191      return Tree_Iterator_Interfaces.Forward_Iterator'Class;
 192 
 193    function Iterate_Subtree (Position : Cursor)
 194      return Tree_Iterator_Interfaces.Forward_Iterator'Class;
 195 
 196    function Iterate_Children
 197      (Container : Tree;
 198       Parent    : Cursor)
 199       return Tree_Iterator_Interfaces.Reversible_Iterator'Class;
 200 
 201    function Child_Count (Parent : Cursor) return Count_Type;
 202 
 203    function Child_Depth (Parent, Child : Cursor) return Count_Type;
 204 
 205    procedure Insert_Child
 206      (Container : in out Tree;
 207       Parent    : Cursor;
 208       Before    : Cursor;
 209       New_Item  : Element_Type;
 210       Count     : Count_Type := 1);
 211 
 212    procedure Insert_Child
 213      (Container : in out Tree;
 214       Parent    : Cursor;
 215       Before    : Cursor;
 216       New_Item  : Element_Type;
 217       Position  : out Cursor;
 218       Count     : Count_Type := 1);
 219 
 220    procedure Insert_Child
 221      (Container : in out Tree;
 222       Parent    : Cursor;
 223       Before    : Cursor;
 224       Position  : out Cursor;
 225       Count     : Count_Type := 1);
 226 
 227    procedure Prepend_Child
 228      (Container : in out Tree;
 229       Parent    : Cursor;
 230       New_Item  : Element_Type;
 231       Count     : Count_Type := 1);
 232 
 233    procedure Append_Child
 234      (Container : in out Tree;
 235       Parent    : Cursor;
 236       New_Item  : Element_Type;
 237       Count     : Count_Type := 1);
 238 
 239    procedure Delete_Children
 240      (Container : in out Tree;
 241       Parent    : Cursor);
 242 
 243    procedure Copy_Subtree
 244      (Target   : in out Tree;
 245       Parent   : Cursor;
 246       Before   : Cursor;
 247       Source   : Cursor);
 248 
 249    procedure Splice_Subtree
 250      (Target   : in out Tree;
 251       Parent   : Cursor;
 252       Before   : Cursor;
 253       Source   : in out Tree;
 254       Position : in out Cursor);
 255 
 256    procedure Splice_Subtree
 257      (Container : in out Tree;
 258       Parent    : Cursor;
 259       Before    : Cursor;
 260       Position  : Cursor);
 261 
 262    procedure Splice_Children
 263      (Target          : in out Tree;
 264       Target_Parent   : Cursor;
 265       Before          : Cursor;
 266       Source          : in out Tree;
 267       Source_Parent   : Cursor);
 268 
 269    procedure Splice_Children
 270      (Container       : in out Tree;
 271       Target_Parent   : Cursor;
 272       Before          : Cursor;
 273       Source_Parent   : Cursor);
 274 
 275    function Parent (Position : Cursor) return Cursor;
 276 
 277    function First_Child (Parent : Cursor) return Cursor;
 278 
 279    function First_Child_Element (Parent : Cursor) return Element_Type;
 280 
 281    function Last_Child (Parent : Cursor) return Cursor;
 282 
 283    function Last_Child_Element (Parent : Cursor) return Element_Type;
 284 
 285    function Next_Sibling (Position : Cursor) return Cursor;
 286 
 287    function Previous_Sibling (Position : Cursor) return Cursor;
 288 
 289    procedure Next_Sibling (Position : in out Cursor);
 290 
 291    procedure Previous_Sibling (Position : in out Cursor);
 292 
 293    --  This version of the AI:
 294    --   10-06-02  AI05-0136-1/07
 295    --  declares Iterate_Children this way:
 296    --
 297    --  procedure Iterate_Children
 298    --    (Container : Tree;
 299    --     Parent    : Cursor;
 300    --     Process   : not null access procedure (Position : Cursor));
 301    --
 302    --  It seems that the Container parameter is there by mistake, but we need
 303    --  an official ruling from the ARG. ???
 304 
 305    procedure Iterate_Children
 306      (Parent  : Cursor;
 307       Process : not null access procedure (Position : Cursor));
 308 
 309    procedure Reverse_Iterate_Children
 310      (Parent  : Cursor;
 311       Process : not null access procedure (Position : Cursor));
 312 
 313 private
 314    --  A node of this multiway tree comprises an element and a list of children
 315    --  (that are themselves trees). The root node is distinguished because it
 316    --  contains only children: it does not have an element itself.
 317 
 318    --  This design feature puts two design goals in tension with one another:
 319    --   (1) treat the root node the same as any other node
 320    --   (2) not declare any objects of type Element_Type unnecessarily
 321 
 322    --  To satisfy (1), we could simply declare the Root node of the tree
 323    --  using the normal Tree_Node_Type, but that would mean that (2) is not
 324    --  satisfied. To resolve the tension (in favor of (2)), we declare the
 325    --  component Root as having a different node type, without an Element
 326    --  component (thus satisfying goal (2)) but otherwise identical to a normal
 327    --  node, and then use Unchecked_Conversion to convert an access object
 328    --  designating the Root node component to the access type designating a
 329    --  normal, non-root node (thus satisfying goal (1)). We make an explicit
 330    --  check for Root when there is any attempt to manipulate the Element
 331    --  component of the node (a check required by the RM anyway).
 332 
 333    --  In order to be explicit about node (and pointer) representation, we
 334    --  specify that the respective node types have convention C, to ensure
 335    --  that the layout of the components of the node records is the same,
 336    --  thus guaranteeing that (unchecked) conversions between access types
 337    --  designating each kind of node type is a meaningful conversion.
 338 
 339    use Ada.Containers.Helpers;
 340    package Implementation is new Generic_Implementation;
 341    use Implementation;
 342 
 343    type Tree_Node_Type;
 344    type Tree_Node_Access is access all Tree_Node_Type;
 345    pragma Convention (C, Tree_Node_Access);
 346    pragma No_Strict_Aliasing (Tree_Node_Access);
 347    --  The above-mentioned Unchecked_Conversion is a violation of the normal
 348    --  aliasing rules.
 349 
 350    type Children_Type is record
 351       First : Tree_Node_Access;
 352       Last  : Tree_Node_Access;
 353    end record;
 354 
 355    --  See the comment above. This declaration must exactly match the
 356    --  declaration of Root_Node_Type (except for the Element component).
 357 
 358    type Tree_Node_Type is record
 359       Parent   : Tree_Node_Access;
 360       Prev     : Tree_Node_Access;
 361       Next     : Tree_Node_Access;
 362       Children : Children_Type;
 363       Element  : aliased Element_Type;
 364    end record;
 365    pragma Convention (C, Tree_Node_Type);
 366 
 367    --  See the comment above. This declaration must match the declaration of
 368    --  Tree_Node_Type (except for the Element component).
 369 
 370    type Root_Node_Type is record
 371       Parent   : Tree_Node_Access;
 372       Prev     : Tree_Node_Access;
 373       Next     : Tree_Node_Access;
 374       Children : Children_Type;
 375    end record;
 376    pragma Convention (C, Root_Node_Type);
 377 
 378    for Root_Node_Type'Alignment use Standard'Maximum_Alignment;
 379    --  The alignment has to be large enough to allow Root_Node to Tree_Node
 380    --  access value conversions, and Tree_Node_Type's alignment may be bumped
 381    --  up by the Element component.
 382 
 383    use Ada.Finalization;
 384 
 385    --  The Count component of type Tree represents the number of nodes that
 386    --  have been (dynamically) allocated. It does not include the root node
 387    --  itself. As implementors, we decide to cache this value, so that the
 388    --  selector function Node_Count can execute in O(1) time, in order to be
 389    --  consistent with the behavior of the Length selector function for other
 390    --  standard container library units. This does mean, however, that the
 391    --  two-container forms for Splice_XXX (that move subtrees across tree
 392    --  containers) will execute in O(n) time, because we must count the number
 393    --  of nodes in the subtree(s) that get moved. (We resolve the tension
 394    --  between Node_Count and Splice_XXX in favor of Node_Count, under the
 395    --  assumption that Node_Count is the more common operation).
 396 
 397    type Tree is new Controlled with record
 398       Root  : aliased Root_Node_Type;
 399       TC    : aliased Tamper_Counts;
 400       Count : Count_Type := 0;
 401    end record;
 402 
 403    overriding procedure Adjust (Container : in out Tree);
 404 
 405    overriding procedure Finalize (Container : in out Tree) renames Clear;
 406 
 407    use Ada.Streams;
 408 
 409    procedure Write
 410      (Stream    : not null access Root_Stream_Type'Class;
 411       Container : Tree);
 412 
 413    for Tree'Write use Write;
 414 
 415    procedure Read
 416      (Stream    : not null access Root_Stream_Type'Class;
 417       Container : out Tree);
 418 
 419    for Tree'Read use Read;
 420 
 421    type Tree_Access is access all Tree;
 422    for Tree_Access'Storage_Size use 0;
 423 
 424    type Cursor is record
 425       Container : Tree_Access;
 426       Node      : Tree_Node_Access;
 427    end record;
 428 
 429    procedure Write
 430      (Stream   : not null access Root_Stream_Type'Class;
 431       Position : Cursor);
 432 
 433    for Cursor'Write use Write;
 434 
 435    procedure Read
 436      (Stream   : not null access Root_Stream_Type'Class;
 437       Position : out Cursor);
 438 
 439    for Cursor'Read use Read;
 440 
 441    subtype Reference_Control_Type is Implementation.Reference_Control_Type;
 442    --  It is necessary to rename this here, so that the compiler can find it
 443 
 444    type Constant_Reference_Type
 445      (Element : not null access constant Element_Type) is
 446       record
 447          Control : Reference_Control_Type :=
 448            raise Program_Error with "uninitialized reference";
 449          --  The RM says, "The default initialization of an object of
 450          --  type Constant_Reference_Type or Reference_Type propagates
 451          --  Program_Error."
 452       end record;
 453 
 454    procedure Read
 455      (Stream : not null access Root_Stream_Type'Class;
 456       Item   : out Constant_Reference_Type);
 457 
 458    for Constant_Reference_Type'Read use Read;
 459 
 460    procedure Write
 461      (Stream : not null access Root_Stream_Type'Class;
 462       Item   : Constant_Reference_Type);
 463 
 464    for Constant_Reference_Type'Write use Write;
 465 
 466    type Reference_Type
 467      (Element : not null access Element_Type) is
 468       record
 469          Control : Reference_Control_Type :=
 470            raise Program_Error with "uninitialized reference";
 471          --  The RM says, "The default initialization of an object of
 472          --  type Constant_Reference_Type or Reference_Type propagates
 473          --  Program_Error."
 474       end record;
 475 
 476    procedure Read
 477      (Stream : not null access Root_Stream_Type'Class;
 478       Item   : out Reference_Type);
 479 
 480    for Reference_Type'Read use Read;
 481 
 482    procedure Write
 483      (Stream : not null access Root_Stream_Type'Class;
 484       Item   : Reference_Type);
 485 
 486    for Reference_Type'Write use Write;
 487 
 488    --  Three operations are used to optimize in the expansion of "for ... of"
 489    --  loops: the Next(Cursor) procedure in the visible part, and the following
 490    --  Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for
 491    --  details.
 492 
 493    function Pseudo_Reference
 494      (Container : aliased Tree'Class) return Reference_Control_Type;
 495    pragma Inline (Pseudo_Reference);
 496    --  Creates an object of type Reference_Control_Type pointing to the
 497    --  container, and increments the Lock. Finalization of this object will
 498    --  decrement the Lock.
 499 
 500    type Element_Access is access all Element_Type with
 501      Storage_Size => 0;
 502 
 503    function Get_Element_Access
 504      (Position : Cursor) return not null Element_Access;
 505    --  Returns a pointer to the element designated by Position.
 506 
 507    Empty_Tree : constant Tree := (Controlled with others => <>);
 508 
 509    No_Element : constant Cursor := (others => <>);
 510 
 511 end Ada.Containers.Multiway_Trees;