gcc/ada/libgnat/g-table.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                            G N A T . T A B L E                           --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 1998-2023, 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 with System;        use System;
  33 with System.Memory; use System.Memory;
  34
  35 package body GNAT.Table is
  36
  37    --------------
  38    -- Allocate --
  39    --------------
  40
  41    procedure Allocate (Num : Integer := 1) is
  42    begin
  43       Tab.Allocate (The_Instance, Num);
  44    end Allocate;
  45
  46    function Allocate (Num : Integer := 1) return Valid_Table_Index_Type is
  47       Result : constant Valid_Table_Index_Type := Last + 1;
  48    begin
  49       Allocate (Num);
  50       return Result;
  51    end Allocate;
  52
  53    ------------
  54    -- Append --
  55    ------------
  56
  57    procedure Append (New_Val : Table_Component_Type) is
  58    begin
  59       Tab.Append (The_Instance, New_Val);
  60    end Append;
  61
  62    ----------------
  63    -- Append_All --
  64    ----------------
  65
  66    procedure Append_All (New_Vals : Table_Type) is
  67    begin
  68       Tab.Append_All (The_Instance, New_Vals);
  69    end Append_All;
  70
  71    --------------------
  72    -- Decrement_Last --
  73    --------------------
  74
  75    procedure Decrement_Last is
  76    begin
  77       Tab.Decrement_Last (The_Instance);
  78    end Decrement_Last;
  79
  80    -----------
  81    -- First --
  82    -----------
  83
  84    function First return Table_Index_Type is
  85    begin
  86       return Tab.First;
  87    end First;
  88
  89    --------------
  90    -- For_Each --
  91    --------------
  92
  93    procedure For_Each is
  94       procedure For_Each is new Tab.For_Each (Action);
  95    begin
  96       For_Each (The_Instance);
  97    end For_Each;
  98
  99    ----------
 100    -- Free --
 101    ----------
 102
 103    procedure Free is
 104    begin
 105       Tab.Free (The_Instance);
 106    end Free;
 107
 108    --------------------
 109    -- Increment_Last --
 110    --------------------
 111
 112    procedure Increment_Last is
 113    begin
 114       Tab.Increment_Last (The_Instance);
 115    end Increment_Last;
 116
 117    --------------
 118    -- Is_Empty --
 119    --------------
 120
 121    function Is_Empty return Boolean is
 122    begin
 123       return Tab.Is_Empty (The_Instance);
 124    end Is_Empty;
 125
 126    ----------
 127    -- Init --
 128    ----------
 129
 130    procedure Init is
 131    begin
 132       Tab.Init (The_Instance);
 133    end Init;
 134
 135    ----------
 136    -- Last --
 137    ----------
 138
 139    function Last return Table_Last_Type is
 140    begin
 141       return Tab.Last (The_Instance);
 142    end Last;
 143
 144    -------------
 145    -- Release --
 146    -------------
 147
 148    procedure Release is
 149    begin
 150       Tab.Release (The_Instance);
 151    end Release;
 152
 153    -------------
 154    -- Restore --
 155    -------------
 156
 157    procedure Restore (T : in out Saved_Table) is
 158    begin
 159       Init;
 160       Tab.Move (From => T, To => The_Instance);
 161    end Restore;
 162
 163    ----------
 164    -- Save --
 165    ----------
 166
 167    function Save return Saved_Table is
 168       Result : Saved_Table;
 169    begin
 170       Tab.Move (From => The_Instance, To => Result);
 171       return Result;
 172    end Save;
 173
 174    --------------
 175    -- Set_Item --
 176    --------------
 177
 178    procedure Set_Item
 179      (Index : Valid_Table_Index_Type;
 180       Item  : Table_Component_Type)
 181    is
 182    begin
 183       Tab.Set_Item (The_Instance, Index, Item);
 184    end Set_Item;
 185
 186    --------------
 187    -- Set_Last --
 188    --------------
 189
 190    procedure Set_Last (New_Val : Table_Last_Type) is
 191    begin
 192       Tab.Set_Last (The_Instance, New_Val);
 193    end Set_Last;
 194
 195    ----------------
 196    -- Sort_Table --
 197    ----------------
 198
 199    procedure Sort_Table is
 200       procedure Sort_Table is new Tab.Sort_Table (Lt);
 201    begin
 202       Sort_Table (The_Instance);
 203    end Sort_Table;
 204
 205 end GNAT.Table;