gcc/ada/libgnat/a-cimutr.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --                   ADA.CONTAINERS.INDEFINITE_MULTIWAY_TREES               --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2004-2017, 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.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.Indefinite_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
  56    pragma Preelaborable_Initialization (Tree);
  57
  58    type Cursor is private;
  59    pragma Preelaborable_Initialization (Cursor);
  60
  61    Empty_Tree : constant Tree;
  62
  63    No_Element : constant Cursor;
  64    function Has_Element (Position : Cursor) return Boolean;
  65
  66    package Tree_Iterator_Interfaces is new
  67      Ada.Iterator_Interfaces (Cursor, Has_Element);
  68
  69    function Equal_Subtree
  70      (Left_Position  : Cursor;
  71       Right_Position : Cursor) return Boolean;
  72
  73    function "=" (Left, Right : Tree) return Boolean;
  74
  75    function Is_Empty (Container : Tree) return Boolean;
  76
  77    function Node_Count (Container : Tree) return Count_Type;
  78
  79    function Subtree_Node_Count (Position : Cursor) return Count_Type;
  80
  81    function Depth (Position : Cursor) return Count_Type;
  82
  83    function Is_Root (Position : Cursor) return Boolean;
  84
  85    function Is_Leaf (Position : Cursor) return Boolean;
  86
  87    function Root (Container : Tree) return Cursor;
  88
  89    procedure Clear (Container : in out Tree);
  90
  91    function Element (Position : Cursor) return Element_Type;
  92
  93    procedure Replace_Element
  94      (Container : in out Tree;
  95       Position  : Cursor;
  96       New_Item  : Element_Type);
  97
  98    procedure Query_Element
  99      (Position : Cursor;
 100       Process  : not null access procedure (Element : Element_Type));
 101
 102    procedure Update_Element
 103      (Container : in out Tree;
 104       Position  : Cursor;
 105       Process   : not null access procedure (Element : in out Element_Type));
 106
 107    type Constant_Reference_Type
 108      (Element : not null access constant Element_Type) is private
 109         with Implicit_Dereference => Element;
 110
 111    type Reference_Type
 112      (Element : not null access Element_Type) is private
 113         with Implicit_Dereference => Element;
 114
 115    function Constant_Reference
 116      (Container : aliased Tree;
 117       Position  : Cursor) return Constant_Reference_Type;
 118    pragma Inline (Constant_Reference);
 119
 120    function Reference
 121      (Container : aliased in out Tree;
 122       Position  : Cursor) return Reference_Type;
 123    pragma Inline (Reference);
 124
 125    procedure Assign (Target : in out Tree; Source : Tree);
 126
 127    function Copy (Source : Tree) return Tree;
 128
 129    procedure Move (Target : in out Tree; Source : in out Tree);
 130
 131    procedure Delete_Leaf
 132      (Container : in out Tree;
 133       Position  : in out Cursor);
 134
 135    procedure Delete_Subtree
 136      (Container : in out Tree;
 137       Position  : in out Cursor);
 138
 139    procedure Swap
 140      (Container : in out Tree;
 141       I, J      : Cursor);
 142
 143    function Find
 144      (Container : Tree;
 145       Item      : Element_Type) return Cursor;
 146
 147    --  This version of the AI:
 148    --   10-06-02  AI05-0136-1/07
 149    --  declares Find_In_Subtree this way:
 150    --
 151    --  function Find_In_Subtree
 152    --    (Container : Tree;
 153    --     Item      : Element_Type;
 154    --     Position  : Cursor) return Cursor;
 155    --
 156    --  It seems that the Container parameter is there by mistake, but we need
 157    --  an official ruling from the ARG. ???
 158
 159    function Find_In_Subtree
 160      (Position : Cursor;
 161       Item     : Element_Type) return Cursor;
 162
 163    --  This version of the AI:
 164    --   10-06-02  AI05-0136-1/07
 165    --  declares Ancestor_Find this way:
 166    --
 167    --  function Ancestor_Find
 168    --    (Container : Tree;
 169    --     Item      : Element_Type;
 170    --     Position  : Cursor) return Cursor;
 171    --
 172    --  It seems that the Container parameter is there by mistake, but we need
 173    --  an official ruling from the ARG. ???
 174
 175    function Ancestor_Find
 176      (Position : Cursor;
 177       Item     : Element_Type) return Cursor;
 178
 179    function Contains
 180      (Container : Tree;
 181       Item      : Element_Type) return Boolean;
 182
 183    procedure Iterate
 184      (Container : Tree;
 185       Process   : not null access procedure (Position : Cursor));
 186
 187    procedure Iterate_Subtree
 188      (Position  : Cursor;
 189       Process   : not null access procedure (Position : Cursor));
 190
 191    function Iterate (Container : Tree)
 192      return Tree_Iterator_Interfaces.Forward_Iterator'Class;
 193
 194    function Iterate_Subtree (Position : Cursor)
 195      return Tree_Iterator_Interfaces.Forward_Iterator'Class;
 196
 197    function Iterate_Children
 198      (Container : Tree;
 199       Parent    : Cursor)
 200      return Tree_Iterator_Interfaces.Reversible_Iterator'Class;
 201
 202    function Child_Count (Parent : Cursor) return Count_Type;
 203
 204    function Child_Depth (Parent, Child : Cursor) return Count_Type;
 205
 206    procedure Insert_Child
 207      (Container : in out Tree;
 208       Parent    : Cursor;
 209       Before    : Cursor;
 210       New_Item  : Element_Type;
 211       Count     : Count_Type := 1);
 212
 213    procedure Insert_Child
 214      (Container : in out Tree;
 215       Parent    : Cursor;
 216       Before    : Cursor;
 217       New_Item  : Element_Type;
 218       Position  : out Cursor;
 219       Count     : Count_Type := 1);
 220
 221    procedure Prepend_Child
 222      (Container : in out Tree;
 223       Parent    : Cursor;
 224       New_Item  : Element_Type;
 225       Count     : Count_Type := 1);
 226
 227    procedure Append_Child
 228      (Container : in out Tree;
 229       Parent    : Cursor;
 230       New_Item  : Element_Type;
 231       Count     : Count_Type := 1);
 232
 233    procedure Delete_Children
 234      (Container : in out Tree;
 235       Parent    : Cursor);
 236
 237    procedure Copy_Subtree
 238      (Target   : in out Tree;
 239       Parent   : Cursor;
 240       Before   : Cursor;
 241       Source   : Cursor);
 242
 243    procedure Splice_Subtree
 244      (Target   : in out Tree;
 245       Parent   : Cursor;
 246       Before   : Cursor;
 247       Source   : in out Tree;
 248       Position : in out Cursor);
 249
 250    procedure Splice_Subtree
 251      (Container : in out Tree;
 252       Parent    : Cursor;
 253       Before    : Cursor;
 254       Position  : Cursor);
 255
 256    procedure Splice_Children
 257      (Target          : in out Tree;
 258       Target_Parent   : Cursor;
 259       Before          : Cursor;
 260       Source          : in out Tree;
 261       Source_Parent   : Cursor);
 262
 263    procedure Splice_Children
 264      (Container       : in out Tree;
 265       Target_Parent   : Cursor;
 266       Before          : Cursor;
 267       Source_Parent   : Cursor);
 268
 269    function Parent (Position : Cursor) return Cursor;
 270
 271    function First_Child (Parent : Cursor) return Cursor;
 272
 273    function First_Child_Element (Parent : Cursor) return Element_Type;
 274
 275    function Last_Child (Parent : Cursor) return Cursor;
 276
 277    function Last_Child_Element (Parent : Cursor) return Element_Type;
 278
 279    function Next_Sibling (Position : Cursor) return Cursor;
 280
 281    function Previous_Sibling (Position : Cursor) return Cursor;
 282
 283    procedure Next_Sibling (Position : in out Cursor);
 284
 285    procedure Previous_Sibling (Position : in out Cursor);
 286
 287    --  This version of the AI:
 288    --   10-06-02  AI05-0136-1/07
 289    --  declares Iterate_Children this way:
 290    --
 291    --  procedure Iterate_Children
 292    --    (Container : Tree;
 293    --     Parent    : Cursor;
 294    --     Process   : not null access procedure (Position : Cursor));
 295    --
 296    --  It seems that the Container parameter is there by mistake, but we need
 297    --  an official ruling from the ARG. ???
 298
 299    procedure Iterate_Children
 300      (Parent  : Cursor;
 301       Process : not null access procedure (Position : Cursor));
 302
 303    procedure Reverse_Iterate_Children
 304      (Parent  : Cursor;
 305       Process : not null access procedure (Position : Cursor));
 306
 307 private
 308
 309    use Ada.Containers.Helpers;
 310    package Implementation is new Generic_Implementation;
 311    use Implementation;
 312
 313    type Tree_Node_Type;
 314    type Tree_Node_Access is access all Tree_Node_Type;
 315
 316    type Children_Type is record
 317       First : Tree_Node_Access;
 318       Last  : Tree_Node_Access;
 319    end record;
 320
 321    type Element_Access is access all Element_Type;
 322
 323    type Tree_Node_Type is record
 324       Parent   : Tree_Node_Access;
 325       Prev     : Tree_Node_Access;
 326       Next     : Tree_Node_Access;
 327       Children : Children_Type;
 328       Element  : Element_Access;
 329    end record;
 330
 331    use Ada.Finalization;
 332
 333    --  The Count component of type Tree represents the number of nodes that
 334    --  have been (dynamically) allocated. It does not include the root node
 335    --  itself. As implementors, we decide to cache this value, so that the
 336    --  selector function Node_Count can execute in O(1) time, in order to be
 337    --  consistent with the behavior of the Length selector function for other
 338    --  standard container library units. This does mean, however, that the
 339    --  two-container forms for Splice_XXX (that move subtrees across tree
 340    --  containers) will execute in O(n) time, because we must count the number
 341    --  of nodes in the subtree(s) that get moved. (We resolve the tension
 342    --  between Node_Count and Splice_XXX in favor of Node_Count, under the
 343    --  assumption that Node_Count is the more common operation).
 344
 345    type Tree is new Controlled with record
 346       Root  : aliased Tree_Node_Type;
 347       TC    : aliased Tamper_Counts;
 348       Count : Count_Type := 0;
 349    end record;
 350
 351    overriding procedure Adjust (Container : in out Tree);
 352
 353    overriding procedure Finalize (Container : in out Tree) renames Clear;
 354
 355    use Ada.Streams;
 356
 357    procedure Write
 358      (Stream    : not null access Root_Stream_Type'Class;
 359       Container : Tree);
 360
 361    for Tree'Write use Write;
 362
 363    procedure Read
 364      (Stream    : not null access Root_Stream_Type'Class;
 365       Container : out Tree);
 366
 367    for Tree'Read use Read;
 368
 369    type Tree_Access is access all Tree;
 370    for Tree_Access'Storage_Size use 0;
 371
 372    type Cursor is record
 373       Container : Tree_Access;
 374       Node      : Tree_Node_Access;
 375    end record;
 376
 377    procedure Write
 378      (Stream   : not null access Root_Stream_Type'Class;
 379       Position : Cursor);
 380
 381    for Cursor'Write use Write;
 382
 383    procedure Read
 384      (Stream   : not null access Root_Stream_Type'Class;
 385       Position : out Cursor);
 386
 387    for Cursor'Read use Read;
 388
 389    subtype Reference_Control_Type is Implementation.Reference_Control_Type;
 390    --  It is necessary to rename this here, so that the compiler can find it
 391
 392    type Constant_Reference_Type
 393      (Element : not null access constant Element_Type) is
 394       record
 395          Control : Reference_Control_Type :=
 396            raise Program_Error with "uninitialized reference";
 397          --  The RM says, "The default initialization of an object of
 398          --  type Constant_Reference_Type or Reference_Type propagates
 399          --  Program_Error."
 400       end record;
 401
 402    procedure Read
 403      (Stream : not null access Root_Stream_Type'Class;
 404       Item   : out Constant_Reference_Type);
 405
 406    for Constant_Reference_Type'Read use Read;
 407
 408    procedure Write
 409      (Stream : not null access Root_Stream_Type'Class;
 410       Item   : Constant_Reference_Type);
 411
 412    for Constant_Reference_Type'Write use Write;
 413
 414    type Reference_Type
 415      (Element : not null access Element_Type) is
 416       record
 417          Control : Reference_Control_Type :=
 418            raise Program_Error with "uninitialized reference";
 419          --  The RM says, "The default initialization of an object of
 420          --  type Constant_Reference_Type or Reference_Type propagates
 421          --  Program_Error."
 422       end record;
 423
 424    procedure Read
 425      (Stream : not null access Root_Stream_Type'Class;
 426       Item   : out Reference_Type);
 427
 428    for Reference_Type'Read use Read;
 429
 430    procedure Write
 431      (Stream : not null access Root_Stream_Type'Class;
 432       Item   : Reference_Type);
 433
 434    for Reference_Type'Write use Write;
 435
 436    --  Three operations are used to optimize in the expansion of "for ... of"
 437    --  loops: the Next(Cursor) procedure in the visible part, and the following
 438    --  Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for
 439    --  details.
 440
 441    function Pseudo_Reference
 442      (Container : aliased Tree'Class) return Reference_Control_Type;
 443    pragma Inline (Pseudo_Reference);
 444    --  Creates an object of type Reference_Control_Type pointing to the
 445    --  container, and increments the Lock. Finalization of this object will
 446    --  decrement the Lock.
 447
 448    function Get_Element_Access
 449      (Position : Cursor) return not null Element_Access;
 450    --  Returns a pointer to the element designated by Position.
 451
 452    Empty_Tree : constant Tree := (Controlled with others => <>);
 453
 454    No_Element : constant Cursor := (others => <>);
 455
 456 end Ada.Containers.Indefinite_Multiway_Trees;