gcc/ada/g-dyntab.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                   G N A T . D Y N A M I C _ T A B L E S                  --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2000-2016, AdaCore                     --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 --  Resizable one dimensional array support
  33
  34 --  This package provides an implementation of dynamically resizable one
  35 --  dimensional arrays. The idea is to mimic the normal Ada semantics for
  36 --  arrays as closely as possible with the one additional capability of
  37 --  dynamically modifying the value of the Last attribute.
  38
  39 --  This package provides a facility similar to that of GNAT.Table, except
  40 --  that this package declares a type that can be used to define dynamic
  41 --  instances of the table, while an instantiation of GNAT.Table creates a
  42 --  single instance of the table type.
  43
  44 --  Note that these three interfaces should remain synchronized to keep as much
  45 --  coherency as possible among these three related units:
  46 --
  47 --     GNAT.Dynamic_Tables
  48 --     GNAT.Table
  49 --     Table (the compiler unit)
  50
  51 pragma Compiler_Unit_Warning;
  52
  53 with Ada.Unchecked_Conversion;
  54
  55 generic
  56    type Table_Component_Type is private;
  57    type Table_Index_Type     is range <>;
  58
  59    Table_Low_Bound : Table_Index_Type;
  60    Table_Initial   : Positive := 8;
  61    Table_Increment : Natural := 100;
  62
  63 package GNAT.Dynamic_Tables is
  64
  65    --  Table_Component_Type and Table_Index_Type specify the type of the array,
  66    --  Table_Low_Bound is the lower bound. The effect is roughly to declare:
  67
  68    --    Table : array (Table_Low_Bound .. <>) of Table_Component_Type;
  69
  70    --  The lower bound of Table_Index_Type is ignored.
  71
  72    pragma Assert (Table_Low_Bound /= Table_Index_Type'Base'First);
  73
  74    function First return Table_Index_Type;
  75    pragma Inline (First);
  76    --  Export First as synonym for Table_Low_Bound (parallel with use of Last)
  77
  78    subtype Valid_Table_Index_Type is Table_Index_Type'Base
  79      range Table_Low_Bound .. Table_Index_Type'Base'Last;
  80    subtype Table_Count_Type is Table_Index_Type'Base
  81      range Table_Low_Bound - 1 .. Table_Index_Type'Base'Last;
  82
  83    --  Table_Component_Type must not be a type with controlled parts.
  84
  85    --  The Table_Initial value controls the allocation of the table when
  86    --  it is first allocated.
  87
  88    --  The Table_Increment value controls the amount of increase, if the
  89    --  table has to be increased in size. The value given is a percentage
  90    --  value (e.g. 100 = increase table size by 100%, i.e. double it).
  91
  92    --  The Last and Set_Last subprograms provide control over the current
  93    --  logical allocation. They are quite efficient, so they can be used
  94    --  freely (expensive reallocation occurs only at major granularity
  95    --  chunks controlled by the allocation parameters).
  96
  97    --  Note: we do not make the table components aliased, since this would
  98    --  restrict the use of table for discriminated types. If it is necessary
  99    --  to take the access of a table element, use Unrestricted_Access.
 100
 101    type Table_Type is
 102      array (Valid_Table_Index_Type range <>) of Table_Component_Type;
 103    subtype Big_Table_Type is
 104      Table_Type (Table_Low_Bound .. Valid_Table_Index_Type'Last);
 105    --  We work with pointers to a bogus array type that is constrained with
 106    --  the maximum possible range bound. This means that the pointer is a thin
 107    --  pointer, which is more efficient. Since subscript checks in any case
 108    --  must be on the logical, rather than physical bounds, safety is not
 109    --  compromised by this approach.
 110
 111    --  To get subscript checking, rename a slice of the Table, like this:
 112
 113    --     Table : Table_Type renames T.Table (First .. Last (T));
 114
 115    --  and the refer to components of Table.
 116
 117    type Table_Ptr is access all Big_Table_Type;
 118    for Table_Ptr'Storage_Size use 0;
 119    --  The table is actually represented as a pointer to allow reallocation
 120
 121    type Table_Private is private;
 122    --  Table private data that is not exported in Instance
 123
 124    --  Private use only:
 125    subtype Empty_Table_Array_Type is
 126      Table_Type (Table_Low_Bound .. Table_Low_Bound - 1);
 127    type Empty_Table_Array_Ptr is access all Empty_Table_Array_Type;
 128    Empty_Table_Array : aliased Empty_Table_Array_Type;
 129    function Empty_Table_Array_Ptr_To_Table_Ptr is
 130      new Ada.Unchecked_Conversion (Empty_Table_Array_Ptr, Table_Ptr);
 131    --  End private use only. The above are used to initialize Table to point to
 132    --  an empty array.
 133
 134    type Instance is record
 135       Table : aliased Table_Ptr :=
 136                 Empty_Table_Array_Ptr_To_Table_Ptr (Empty_Table_Array'Access);
 137       --  The table itself. The lower bound is the value of First. Logically
 138       --  the upper bound is the current value of Last (although the actual
 139       --  size of the allocated table may be larger than this). The program may
 140       --  only access and modify Table entries in the range First .. Last.
 141       --
 142       --  It's a good idea to access this via a renaming of a slice, in order
 143       --  to ensure bounds checking, as in:
 144       --
 145       --     Tab : Table_Type renames X.Table (First .. X.Last);
 146
 147       Locked : Boolean := False;
 148       --  Table expansion is permitted only if this switch is set to False. A
 149       --  client may set Locked to True, in which case any attempt to expand
 150       --  the table will cause an assertion failure. Note that while a table
 151       --  is locked, its address in memory remains fixed and unchanging.
 152
 153       P : Table_Private;
 154    end record;
 155
 156    procedure Init (T : in out Instance);
 157    --  Reinitializes the table to empty. There is no need to call this before
 158    --  using a table; tables default to empty.
 159
 160    function Last (T : Instance) return Table_Count_Type;
 161    pragma Inline (Last);
 162    --  Returns the current value of the last used entry in the table, which can
 163    --  then be used as a subscript for Table.
 164
 165    procedure Release (T : in out Instance);
 166    --  Storage is allocated in chunks according to the values given in the
 167    --  Table_Initial and Table_Increment parameters. A call to Release releases
 168    --  all storage that is allocated, but is not logically part of the current
 169    --  array value. Current array values are not affected by this call.
 170
 171    procedure Free (T : in out Instance);
 172    --  Same as Init
 173
 174    procedure Set_Last (T : in out Instance; New_Val : Table_Count_Type);
 175    pragma Inline (Set_Last);
 176    --  This procedure sets Last to the indicated value. If necessary the table
 177    --  is reallocated to accommodate the new value (i.e. on return the
 178    --  allocated table has an upper bound of at least Last). If Set_Last
 179    --  reduces the size of the table, then logically entries are removed from
 180    --  the table. If Set_Last increases the size of the table, then new entries
 181    --  are logically added to the table.
 182
 183    procedure Increment_Last (T : in out Instance);
 184    pragma Inline (Increment_Last);
 185    --  Adds 1 to Last (same as Set_Last (Last + 1))
 186
 187    procedure Decrement_Last (T : in out Instance);
 188    pragma Inline (Decrement_Last);
 189    --  Subtracts 1 from Last (same as Set_Last (Last - 1))
 190
 191    procedure Append (T : in out Instance; New_Val : Table_Component_Type);
 192    pragma Inline (Append);
 193    --  Appends New_Val onto the end of the table
 194    --  Equivalent to:
 195    --    Increment_Last (T);
 196    --    T.Table (T.Last) := New_Val;
 197
 198    procedure Append_All (T : in out Instance; New_Vals : Table_Type);
 199    --  Appends all components of New_Vals
 200
 201    procedure Set_Item
 202      (T     : in out Instance;
 203       Index : Valid_Table_Index_Type;
 204       Item  : Table_Component_Type);
 205    pragma Inline (Set_Item);
 206    --  Put Item in the table at position Index. If Index points to an existing
 207    --  item (i.e. it is in the range First .. Last (T)), the item is replaced.
 208    --  Otherwise (i.e. Index > Last (T), the table is expanded, and Last is set
 209    --  to Index.
 210
 211    procedure Allocate (T : in out Instance; Num : Integer := 1);
 212    pragma Inline (Allocate);
 213    --  Adds Num to Last
 214
 215    generic
 216      with procedure Action
 217        (Index : Valid_Table_Index_Type;
 218         Item  : Table_Component_Type;
 219         Quit  : in out Boolean) is <>;
 220    procedure For_Each (Table : Instance);
 221    --  Calls procedure Action for each component of the table, or until one of
 222    --  these calls set Quit to True.
 223
 224    generic
 225      with function Lt (Comp1, Comp2 : Table_Component_Type) return Boolean;
 226    procedure Sort_Table (Table : in out Instance);
 227    --  This procedure sorts the components of the table into ascending
 228    --  order making calls to Lt to do required comparisons, and using
 229    --  assignments to move components around. The Lt function returns True
 230    --  if Comp1 is less than Comp2 (in the sense of the desired sort), and
 231    --  False if Comp1 is greater than Comp2. For equal objects it does not
 232    --  matter if True or False is returned (it is slightly more efficient
 233    --  to return False). The sort is not stable (the order of equal items
 234    --  in the table is not preserved).
 235
 236 private
 237
 238    type Table_Private is record
 239       Last_Allocated : Table_Count_Type := Table_Low_Bound - 1;
 240       --  Subscript of the maximum entry in the currently allocated table.
 241       --  Initial value ensures that we initially allocate the table.
 242
 243       Last : Table_Count_Type := Table_Low_Bound - 1;
 244       --  Current value of Last function
 245
 246       --  Invariant: Last <= Last_Allocated
 247    end record;
 248
 249 end GNAT.Dynamic_Tables;