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-2024, 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 private with Ada.Strings.Text_Buffers;
  40
  41 generic
  42    type Element_Type (<>) is private;
  43
  44    with function "=" (Left, Right : Element_Type) return Boolean is <>;
  45
  46 package Ada.Containers.Indefinite_Multiway_Trees with
  47   SPARK_Mode => Off
  48 is
  49    pragma Annotate (CodePeer, Skip_Analysis);
  50    pragma Preelaborate;
  51    pragma Remote_Types;
  52
  53    type Tree is tagged private
  54      with Constant_Indexing => Constant_Reference,
  55           Variable_Indexing => Reference,
  56           Default_Iterator  => Iterate,
  57           Iterator_Element  => Element_Type;
  58
  59    pragma Preelaborable_Initialization (Tree);
  60
  61    type Cursor is private;
  62    pragma Preelaborable_Initialization (Cursor);
  63
  64    Empty_Tree : constant Tree;
  65
  66    No_Element : constant Cursor;
  67    function Has_Element (Position : Cursor) return Boolean;
  68
  69    package Tree_Iterator_Interfaces is new
  70      Ada.Iterator_Interfaces (Cursor, Has_Element);
  71
  72    function Equal_Subtree
  73      (Left_Position  : Cursor;
  74       Right_Position : Cursor) return Boolean;
  75
  76    function "=" (Left, Right : Tree) return Boolean;
  77
  78    function Is_Empty (Container : Tree) return Boolean;
  79
  80    function Node_Count (Container : Tree) return Count_Type;
  81
  82    function Subtree_Node_Count (Position : Cursor) return Count_Type;
  83
  84    function Depth (Position : Cursor) return Count_Type;
  85
  86    function Is_Root (Position : Cursor) return Boolean;
  87
  88    function Is_Leaf (Position : Cursor) return Boolean;
  89
  90    function Root (Container : Tree) return Cursor;
  91
  92    procedure Clear (Container : in out Tree);
  93
  94    function Element (Position : Cursor) return Element_Type;
  95
  96    procedure Replace_Element
  97      (Container : in out Tree;
  98       Position  : Cursor;
  99       New_Item  : Element_Type);
 100
 101    procedure Query_Element
 102      (Position : Cursor;
 103       Process  : not null access procedure (Element : Element_Type));
 104
 105    procedure Update_Element
 106      (Container : in out Tree;
 107       Position  : Cursor;
 108       Process   : not null access procedure (Element : in out Element_Type));
 109
 110    type Constant_Reference_Type
 111      (Element : not null access constant Element_Type) is private
 112         with Implicit_Dereference => Element;
 113
 114    type Reference_Type
 115      (Element : not null access Element_Type) is private
 116         with Implicit_Dereference => Element;
 117
 118    function Constant_Reference
 119      (Container : aliased Tree;
 120       Position  : Cursor) return Constant_Reference_Type;
 121    pragma Inline (Constant_Reference);
 122
 123    function Reference
 124      (Container : aliased in out Tree;
 125       Position  : Cursor) return Reference_Type;
 126    pragma Inline (Reference);
 127
 128    procedure Assign (Target : in out Tree; Source : Tree);
 129
 130    function Copy (Source : Tree) return Tree;
 131
 132    procedure Move (Target : in out Tree; Source : in out Tree);
 133
 134    procedure Delete_Leaf
 135      (Container : in out Tree;
 136       Position  : in out Cursor);
 137
 138    procedure Delete_Subtree
 139      (Container : in out Tree;
 140       Position  : in out Cursor);
 141
 142    procedure Swap
 143      (Container : in out Tree;
 144       I, J      : Cursor);
 145
 146    function Find
 147      (Container : Tree;
 148       Item      : Element_Type) return Cursor;
 149
 150    --  This version of the AI:
 151    --   10-06-02  AI05-0136-1/07
 152    --  declares Find_In_Subtree this way:
 153    --
 154    --  function Find_In_Subtree
 155    --    (Container : Tree;
 156    --     Item      : Element_Type;
 157    --     Position  : Cursor) return Cursor;
 158    --
 159    --  It seems that the Container parameter is there by mistake, but we need
 160    --  an official ruling from the ARG. ???
 161
 162    function Find_In_Subtree
 163      (Position : Cursor;
 164       Item     : Element_Type) return Cursor;
 165
 166    --  This version of the AI:
 167    --   10-06-02  AI05-0136-1/07
 168    --  declares Ancestor_Find this way:
 169    --
 170    --  function Ancestor_Find
 171    --    (Container : Tree;
 172    --     Item      : Element_Type;
 173    --     Position  : Cursor) return Cursor;
 174    --
 175    --  It seems that the Container parameter is there by mistake, but we need
 176    --  an official ruling from the ARG. ???
 177
 178    function Ancestor_Find
 179      (Position : Cursor;
 180       Item     : Element_Type) return Cursor;
 181
 182    function Contains
 183      (Container : Tree;
 184       Item      : Element_Type) return Boolean;
 185
 186    procedure Iterate
 187      (Container : Tree;
 188       Process   : not null access procedure (Position : Cursor));
 189
 190    procedure Iterate_Subtree
 191      (Position  : Cursor;
 192       Process   : not null access procedure (Position : Cursor));
 193
 194    function Iterate (Container : Tree)
 195      return Tree_Iterator_Interfaces.Forward_Iterator'Class;
 196
 197    function Iterate_Subtree (Position : Cursor)
 198      return Tree_Iterator_Interfaces.Forward_Iterator'Class;
 199
 200    function Iterate_Children
 201      (Container : Tree;
 202       Parent    : Cursor)
 203      return Tree_Iterator_Interfaces.Reversible_Iterator'Class;
 204
 205    function Child_Count (Parent : Cursor) return Count_Type;
 206
 207    function Child_Depth (Parent, Child : Cursor) return Count_Type;
 208
 209    procedure Insert_Child
 210      (Container : in out Tree;
 211       Parent    : Cursor;
 212       Before    : Cursor;
 213       New_Item  : Element_Type;
 214       Count     : Count_Type := 1);
 215
 216    procedure Insert_Child
 217      (Container : in out Tree;
 218       Parent    : Cursor;
 219       Before    : Cursor;
 220       New_Item  : Element_Type;
 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    use Ada.Containers.Helpers;
 313    package Implementation is new Generic_Implementation;
 314    use Implementation;
 315
 316    type Tree_Node_Type;
 317    type Tree_Node_Access is access all Tree_Node_Type;
 318
 319    type Children_Type is record
 320       First : Tree_Node_Access;
 321       Last  : Tree_Node_Access;
 322    end record;
 323
 324    type Element_Access is access all Element_Type;
 325
 326    type Tree_Node_Type is record
 327       Parent   : Tree_Node_Access;
 328       Prev     : Tree_Node_Access;
 329       Next     : Tree_Node_Access;
 330       Children : Children_Type;
 331       Element  : Element_Access;
 332    end record;
 333
 334    use Ada.Finalization;
 335
 336    --  The Count component of type Tree represents the number of nodes that
 337    --  have been (dynamically) allocated. It does not include the root node
 338    --  itself. As implementors, we decide to cache this value, so that the
 339    --  selector function Node_Count can execute in O(1) time, in order to be
 340    --  consistent with the behavior of the Length selector function for other
 341    --  standard container library units. This does mean, however, that the
 342    --  two-container forms for Splice_XXX (that move subtrees across tree
 343    --  containers) will execute in O(n) time, because we must count the number
 344    --  of nodes in the subtree(s) that get moved. (We resolve the tension
 345    --  between Node_Count and Splice_XXX in favor of Node_Count, under the
 346    --  assumption that Node_Count is the more common operation).
 347
 348    type Tree is new Controlled with record
 349       Root  : aliased Tree_Node_Type;
 350       TC    : aliased Tamper_Counts;
 351       Count : Count_Type := 0;
 352    end record with Put_Image => Put_Image;
 353
 354    procedure Put_Image
 355      (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Tree);
 356
 357    overriding procedure Adjust (Container : in out Tree);
 358
 359    overriding procedure Finalize (Container : in out Tree) renames Clear;
 360
 361    use Ada.Streams;
 362
 363    procedure Write
 364      (Stream    : not null access Root_Stream_Type'Class;
 365       Container : Tree);
 366
 367    for Tree'Write use Write;
 368
 369    procedure Read
 370      (Stream    : not null access Root_Stream_Type'Class;
 371       Container : out Tree);
 372
 373    for Tree'Read use Read;
 374
 375    type Tree_Access is access all Tree;
 376    for Tree_Access'Storage_Size use 0;
 377
 378    type Cursor is record
 379       Container : Tree_Access;
 380       Node      : Tree_Node_Access;
 381    end record;
 382
 383    procedure Write
 384      (Stream   : not null access Root_Stream_Type'Class;
 385       Position : Cursor);
 386
 387    for Cursor'Write use Write;
 388
 389    procedure Read
 390      (Stream   : not null access Root_Stream_Type'Class;
 391       Position : out Cursor);
 392
 393    for Cursor'Read use Read;
 394
 395    subtype Reference_Control_Type is Implementation.Reference_Control_Type;
 396    --  It is necessary to rename this here, so that the compiler can find it
 397
 398    type Constant_Reference_Type
 399      (Element : not null access constant Element_Type) is
 400       record
 401          Control : Reference_Control_Type :=
 402            raise Program_Error with "uninitialized reference";
 403          --  The RM says, "The default initialization of an object of
 404          --  type Constant_Reference_Type or Reference_Type propagates
 405          --  Program_Error."
 406       end record;
 407
 408    procedure Read
 409      (Stream : not null access Root_Stream_Type'Class;
 410       Item   : out Constant_Reference_Type);
 411
 412    for Constant_Reference_Type'Read use Read;
 413
 414    procedure Write
 415      (Stream : not null access Root_Stream_Type'Class;
 416       Item   : Constant_Reference_Type);
 417
 418    for Constant_Reference_Type'Write use Write;
 419
 420    type Reference_Type
 421      (Element : not null access Element_Type) is
 422       record
 423          Control : Reference_Control_Type :=
 424            raise Program_Error with "uninitialized reference";
 425          --  The RM says, "The default initialization of an object of
 426          --  type Constant_Reference_Type or Reference_Type propagates
 427          --  Program_Error."
 428       end record;
 429
 430    procedure Read
 431      (Stream : not null access Root_Stream_Type'Class;
 432       Item   : out Reference_Type);
 433
 434    for Reference_Type'Read use Read;
 435
 436    procedure Write
 437      (Stream : not null access Root_Stream_Type'Class;
 438       Item   : Reference_Type);
 439
 440    for Reference_Type'Write use Write;
 441
 442    --  See Ada.Containers.Vectors for documentation on the following
 443
 444    function Pseudo_Reference
 445      (Container : aliased Tree'Class) return Reference_Control_Type;
 446    pragma Inline (Pseudo_Reference);
 447    --  Creates an object of type Reference_Control_Type pointing to the
 448    --  container, and increments the Lock. Finalization of this object will
 449    --  decrement the Lock.
 450
 451    function Get_Element_Access
 452      (Position : Cursor) return not null Element_Access;
 453    --  Returns a pointer to the element designated by Position.
 454
 455    Empty_Tree : constant Tree := (Controlled with others => <>);
 456
 457    No_Element : constant Cursor := (others => <>);
 458
 459 end Ada.Containers.Indefinite_Multiway_Trees;