libgpr2_24.0.0_eda3c693/langkit/generated/src/gpr_parser_support-vectors.adb

--
--  Copyright (C) 2014-2022, AdaCore
--  SPDX-License-Identifier: Apache-2.0
--

with Ada.Containers.Generic_Array_Sort;

with System;        use System;
with System.Memory; use System.Memory;

-----------------------------
-- Gpr_Parser_Support.Vectors --
-----------------------------

package body Gpr_Parser_Support.Vectors is

   El_Size : constant size_t := Elements_Array'Component_Size / Storage_Unit;

   --------------
   -- Is_Empty --
   --------------

   function Is_Empty (Self : Vector) return Boolean is
   begin
      return Self.Size = 0;
   end Is_Empty;

   -------------
   -- Reserve --
   -------------

   procedure Reserve (Self : in out Vector; Capacity : Natural) is
      Siz : constant size_t := size_t (Capacity) * El_Size;
   begin
      if Small_Vector_Capacity > 0
        and then Self.Capacity = Small_Vector_Capacity
      then
         --  We have an inline small vector, and we're still using it

         --  If the small vector has capacity, then Reserve is a no-op
         if Capacity <= Self.Capacity then
            return;
         end if;

         --  The small vector is smaller than the required capacity. So we'll
         --  allocate and transfer the items from the small vector to the
         --  dynamically allocated one.
         Self.E := To_Pointer (Alloc (Siz));
         for I in Self.SV'Range loop
            Self.E.all (I) := Self.SV (I);
         end loop;
      else
         --  We don't want to alloc/realloc any space if ``Capacity`` is
         --  smaller than the current capacity.
         if Capacity <= Self.Capacity then
            return;
         end if;

         if Self.E = null then
            --  E is null: First alloc
            Self.E := To_Pointer (Alloc (Siz));
         else
            --  E is not null: realloc
            Self.E := To_Pointer (Realloc (Self.E.all'Address, Siz));
         end if;

      end if;

      Self.Capacity := Capacity;
   end Reserve;

   ------------
   -- Append --
   ------------

   procedure Append (Self : in out Vector; Element : Element_Type) is
   begin
      if Self.Capacity = Self.Size then
         Reserve (Self, (Self.Capacity * 2) + 1);
      end if;
      Self.Size := Self.Size + 1;

      declare
         Index : constant Index_Type := Last_Index (Self);
      begin
         if Small_Vector_Capacity = 0 then
            Self.E.all (Index) := Element;
         else
            if Self.Capacity = Small_Vector_Capacity then
               Self.SV (Index) := Element;
            else
               Self.E.all (Index) := Element;
            end if;
         end if;
      end;
   end Append;

   ------------
   -- Concat --
   ------------

   procedure Concat (Self : in out Vector; Elements : Elements_Array) is
   begin
      for El of Elements loop
         Self.Append (El);
      end loop;
   end Concat;

   ------------
   -- Concat --
   ------------

   procedure Concat (Self : in out Vector; Elements : Vector) is
   begin
      Self.Reserve (Self.Length + Elements.Length);
      for I in Elements.First_Index .. Elements.Last_Index loop
         Self.Append (Elements.Get (I));
      end loop;
   end Concat;

   ---------------
   -- Remove_At --
   ---------------

   procedure Remove_At (Self : in out Vector; Index : Index_Type) is
   begin
      for I in Index .. Self.Length - 1 loop
         Set (Self, I, Get (Self, I + 1));
      end loop;
      Pop (Self);
   end Remove_At;

   ---------
   -- Get --
   ---------

   function Get
     (Self : Vector; Index : Iteration_Index_Type) return Element_Type
   is
   begin
      if Index > Self.Size then
         raise Constraint_Error with "Out of bound access";
      end if;

      if Small_Vector_Capacity = 0 then
         return Self.E (Index);
      else
         if Self.Capacity = Small_Vector_Capacity then
            return Self.SV (Index);
         else
            return Self.E (Index);
         end if;
      end if;
   end Get;

   ---------
   -- Set --
   ---------

   procedure Set (Self : in out Vector; Index : Index_Type; E : Element_Type)
   is
   begin
      if Small_Vector_Capacity = 0 then
         Self.E (Index) := E;
      else
         if Self.Capacity = Small_Vector_Capacity then
            Self.SV (Index) := E;
         else
            Self.E (Index) := E;
         end if;
      end if;
   end Set;

   ----------------
   -- Get_Access --
   ----------------

   function Get_Access
     (Self : Vector; Index : Index_Type) return Element_Access
   is
   begin
      if Small_Vector_Capacity = 0 then
         return Self.E (Index)'Unrestricted_Access;
      else
         if Self.Capacity = Small_Vector_Capacity then
            return Self.SV (Index)'Unrestricted_Access;
         else
            return Self.E (Index)'Unrestricted_Access;
         end if;
      end if;
   end Get_Access;

   -------------
   -- Destroy --
   -------------

   procedure Destroy (Self : in out Vector) is
   begin
      Free (Self.E);
   end Destroy;

   -----------
   -- Clear --
   -----------

   procedure Clear (Self : in out Vector) is
   begin
      Self.Size := 0;
   end Clear;

   ---------
   -- Pop --
   ---------

   function Pop (Self : in out Vector) return Element_Type is
      Index : constant Index_Type := Last_Index (Self);
      Res : constant Element_Type := Get (Self, Index);
   begin
      Self.Size := Self.Size - 1;
      return Res;
   end Pop;

   ---------
   -- Pop --
   ---------

   procedure Pop (Self : in out Vector) is
      Discard : constant Element_Type := Pop (Self);
   begin
      null;
   end Pop;

   ---------
   -- Cut --
   ---------

   procedure Cut (Self : in out Vector; Index : Iteration_Index_Type) is
   begin
      Self.Size := Index;
   end Cut;

   ---------
   -- Pop --
   ---------

   function Pop (Self : in out Vector; N : Index_Type) return Element_Type is
      Result : constant Element_Type := Self.Get (N);
   begin
      Self.Set (N, Self.Last_Element);
      Self.Size := Self.Size - 1;
      return Result;
   end Pop;

   ---------
   -- Pop --
   ---------

   procedure Pop (Self : in out Vector; N : Index_Type) is
      Discard : constant Element_Type := Self.Pop (N);
   begin
      null;
   end Pop;

   -------------------
   -- First_Element --
   -------------------

   function First_Element (Self : Vector) return Element_Type
   is (Get (Self, First_Index (Self)));

   ------------------
   -- Last_Element --
   ------------------

   function Last_Element (Self : Vector) return Element_Type
   is
   begin
      return Get (Self, Last_Index (Self));
   end Last_Element;

   ------------------
   -- Last_Element --
   ------------------

   function Last_Element (Self : Vector) return Element_Access
   is
   begin
      return Get_Access (Self, Last_Index (Self));
   end Last_Element;

   ------------
   -- Length --
   ------------

   function Length (Self : Vector) return Natural is (Self.Size);

   -----------
   -- Slice --
   -----------

   function Slice
     (Self : Vector; First, Last : Natural) return Elements_Array
   is
   begin
      if Small_Vector_Capacity = 0 then
         return Self.E (First .. Last);
      else
         if Self.Capacity = Small_Vector_Capacity then
            return Self.SV (First .. Last);
         else
            return Self.E (First .. Last);
         end if;
      end if;
   end Slice;

   --------------
   -- To_Array --
   --------------

   function To_Array
     (Self : Vector) return Elements_Array
   is
   begin
      if Self.Size = 0 then
         return Empty_Array;
      else
         return Slice (Self, First_Index (Self), Last_Index (Self));
      end if;
   end To_Array;

   -----------
   -- Image --
   -----------

   function Image (Self : Vector) return String is
      function Image (Self : Vector; I : Index_Type) return String
      is
        (if I < Last_Index (Self)
         then Image (Get (Self, I)) & ", " & Image (Self, I + 1)
         else Image (Get (Self, I)));
   begin
      return "[" & (if Self.Size > 0
                    then Image (Self, First_Index (Self))
                    else "") & "]";
   end Image;

   ----------
   -- Copy --
   ----------

   function Copy (Self : Vector) return Vector is
      N : Vector;
   begin
      if Self.Length > 0 then
         N.Reserve (Self.Length);
      end if;
      for El of Self loop
         N.Append (El);
      end loop;
      return N;
   end Copy;

   ------------------
   -- Generic_Sort --
   ------------------

   procedure Generic_Sort (Self : in out Vector) is
      procedure Sort is new Ada.Containers.Generic_Array_Sort
        (Positive, Element_Type, Elements_Array, "<");
   begin
      if Self.Capacity = Small_Vector_Capacity then
         Sort (Self.SV (1 .. Self.Size));
      else
         Sort (Self.E.all (1 .. Self.Size));
      end if;
   end Generic_Sort;

end Gpr_Parser_Support.Vectors;