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-2012, 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
 312    --  A node of this multiway tree comprises an element and a list of children
 313    --  (that are themselves trees). The root node is distinguished because it
 314    --  contains only children: it does not have an element itself.
 315    --
 316    --  This design feature puts two design goals in tension:
 317    --   (1) treat the root node the same as any other node
 318    --   (2) not declare any objects of type Element_Type unnecessarily
 319    --
 320    --  To satisfy (1), we could simply declare the Root node of the tree using
 321    --  the normal Tree_Node_Type, but that would mean that (2) is not
 322    --  satisfied. To resolve the tension (in favor of (2)), we declare the
 323    --  component Root as having a different node type, without an Element
 324    --  component (thus satisfying goal (2)) but otherwise identical to a normal
 325    --  node, and then use Unchecked_Conversion to convert an access object
 326    --  designating the Root node component to the access type designating a
 327    --  normal, non-root node (thus satisfying goal (1)). We make an explicit
 328    --  check for Root when there is any attempt to manipulate the Element
 329    --  component of the node (a check required by the RM anyway).
 330    --
 331    --  In order to be explicit about node (and pointer) representation, we
 332    --  specify that the respective node types have convention C, to ensure that
 333    --  the layout of the components of the node records is the same, thus
 334    --  guaranteeing that (unchecked) conversions between access types
 335    --  designating each kind of node type is a meaningful conversion.
 336
 337    type Tree_Node_Type;
 338    type Tree_Node_Access is access all Tree_Node_Type;
 339    pragma Convention (C, Tree_Node_Access);
 340
 341    type Children_Type is record
 342       First : Tree_Node_Access;
 343       Last  : Tree_Node_Access;
 344    end record;
 345
 346    --  See the comment above. This declaration must exactly match the
 347    --  declaration of Root_Node_Type (except for the Element component).
 348
 349    type Tree_Node_Type is record
 350       Parent   : Tree_Node_Access;
 351       Prev     : Tree_Node_Access;
 352       Next     : Tree_Node_Access;
 353       Children : Children_Type;
 354       Element  : aliased Element_Type;
 355    end record;
 356    pragma Convention (C, Tree_Node_Type);
 357
 358    --  See the comment above. This declaration must match the declaration of
 359    --  Tree_Node_Type (except for the Element component).
 360
 361    type Root_Node_Type is record
 362       Parent   : Tree_Node_Access;
 363       Prev     : Tree_Node_Access;
 364       Next     : Tree_Node_Access;
 365       Children : Children_Type;
 366    end record;
 367    pragma Convention (C, Root_Node_Type);
 368
 369    use Ada.Finalization;
 370
 371    --  The Count component of type Tree represents the number of nodes that
 372    --  have been (dynamically) allocated. It does not include the root node
 373    --  itself. As implementors, we decide to cache this value, so that the
 374    --  selector function Node_Count can execute in O(1) time, in order to be
 375    --  consistent with the behavior of the Length selector function for other
 376    --  standard container library units. This does mean, however, that the
 377    --  two-container forms for Splice_XXX (that move subtrees across tree
 378    --  containers) will execute in O(n) time, because we must count the number
 379    --  of nodes in the subtree(s) that get moved. (We resolve the tension
 380    --  between Node_Count and Splice_XXX in favor of Node_Count, under the
 381    --  assumption that Node_Count is the more common operation).
 382
 383    type Tree is new Controlled with record
 384       Root  : aliased Root_Node_Type;
 385       Busy  : Natural := 0;
 386       Lock  : Natural := 0;
 387       Count : Count_Type := 0;
 388    end record;
 389
 390    overriding procedure Adjust (Container : in out Tree);
 391
 392    overriding procedure Finalize (Container : in out Tree) renames Clear;
 393
 394    use Ada.Streams;
 395
 396    procedure Write
 397      (Stream    : not null access Root_Stream_Type'Class;
 398       Container : Tree);
 399
 400    for Tree'Write use Write;
 401
 402    procedure Read
 403      (Stream    : not null access Root_Stream_Type'Class;
 404       Container : out Tree);
 405
 406    for Tree'Read use Read;
 407
 408    type Tree_Access is access all Tree;
 409    for Tree_Access'Storage_Size use 0;
 410
 411    type Cursor is record
 412       Container : Tree_Access;
 413       Node      : Tree_Node_Access;
 414    end record;
 415
 416    procedure Write
 417      (Stream   : not null access Root_Stream_Type'Class;
 418       Position : Cursor);
 419
 420    for Cursor'Write use Write;
 421
 422    procedure Read
 423      (Stream   : not null access Root_Stream_Type'Class;
 424       Position : out Cursor);
 425
 426    for Cursor'Read use Read;
 427
 428    type Reference_Control_Type is
 429       new Controlled with record
 430          Container : Tree_Access;
 431       end record;
 432
 433    overriding procedure Adjust (Control : in out Reference_Control_Type);
 434    pragma Inline (Adjust);
 435
 436    overriding procedure Finalize (Control : in out Reference_Control_Type);
 437    pragma Inline (Finalize);
 438
 439    type Constant_Reference_Type
 440      (Element : not null access constant Element_Type) is
 441       record
 442          Control : Reference_Control_Type;
 443       end record;
 444
 445    procedure Read
 446      (Stream : not null access Root_Stream_Type'Class;
 447       Item   : out Constant_Reference_Type);
 448
 449    for Constant_Reference_Type'Read use Read;
 450
 451    procedure Write
 452      (Stream : not null access Root_Stream_Type'Class;
 453       Item   : Constant_Reference_Type);
 454
 455    for Constant_Reference_Type'Write use Write;
 456
 457    type Reference_Type
 458      (Element : not null access Element_Type) is
 459       record
 460          Control : Reference_Control_Type;
 461       end record;
 462
 463    procedure Read
 464      (Stream : not null access Root_Stream_Type'Class;
 465       Item   : out Reference_Type);
 466
 467    for Reference_Type'Read use Read;
 468
 469    procedure Write
 470      (Stream : not null access Root_Stream_Type'Class;
 471       Item   : Reference_Type);
 472
 473    for Reference_Type'Write use Write;
 474
 475    Empty_Tree : constant Tree := (Controlled with others => <>);
 476
 477    No_Element : constant Cursor := (others => <>);
 478
 479 end Ada.Containers.Multiway_Trees;