asis_2019.0.0_3ca32fa2/tools/tool_utils/asis_ul-fast_vectors.ads

------------------------------------------------------------------------------
--                                                                          --
--                            GNAT2XML COMPONENTS                           --
--                                                                          --
--                               V E C T O R S                              --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                      Copyright (C) 2013-2016, AdaCore                    --
--                                                                          --
-- Gnat2xml is free software; you can redistribute it and/or modify it      --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. Gnat2xml is distributed  in the hope  that it will be useful,   --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MER-      --
-- CHANTABILITY or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General  --
-- Public License for more details. You should have received a copy of the  --
-- GNU General Public License distributed with GNAT; see file COPYING. If   --
-- not, write to the Free Software Foundation, 59 Temple Place Suite 330,   --
-- Boston, MA 02111-1307, USA.                                              --
-- The gnat2xml tool was derived from the Avatox sources.                   --
------------------------------------------------------------------------------

pragma Ada_2012;

with Ada.Containers; use Ada.Containers;
with Ada.Iterator_Interfaces;

private with Ada.Finalization;

generic
   type Index_Type is range <>;
   type Element_Type is private;
   type Elements_Array is array (Index_Type range <>) of Element_Type;

   with function "=" (Left, Right : Element_Type) return Boolean is <>;

package ASIS_UL.Fast_Vectors is

   --  This is a more efficient version of Ada.Containers.Vectors.

   pragma Suppress (All_Checks);

   pragma Assert (Index_Type'First = 1);
   pragma Assert (Index_Type'Last = 2**31 - 1);
   --  These assumptions allow us to avoid a lot of horsing around. But we
   --  still inherit some such horsing from Ada.Containers.Vectors.

   subtype Extended_Index is
     Index_Type'
       Base range
       Index_Type'First - 1 ..
         Index_Type'Min (Index_Type'Base'Last - 1, Index_Type'Last) + 1;

   No_Index : constant Extended_Index := Extended_Index'First;

   type Vector is tagged private with
      Constant_Indexing => Constant_Reference,
      Variable_Indexing => Reference,
      Default_Iterator  => Iterate,
      Iterator_Element  => Element_Type;

   type Cursor is private;

   No_Element : constant Cursor;

   function Has_Element (Position : Cursor) return Boolean;

   package Vector_Iterator_Interfaces is new Ada.Iterator_Interfaces
     (Cursor,
      Has_Element);

   Empty_Vector : constant Vector;

   overriding function "=" (Left, Right : Vector) return Boolean;

   function Length (Container : Vector) return Count_Type;

   procedure Set_Length (Container : in out Vector; Length : Count_Type);

   function Is_Empty (Container : Vector) return Boolean;

   procedure Clear (Container : in out Vector);

   procedure Free (Container : in out Vector);
   --  Same as Clear, but also frees storage

   function To_Cursor
     (Container : Vector;
      Index     : Extended_Index)
      return      Cursor;

   function To_Index (Position : Cursor) return Extended_Index;

   function Element
     (Container : Vector;
      Index     : Index_Type)
      return      Element_Type;

   function Element (Position : Cursor) return Element_Type;

   type Constant_Reference_Type
     (Element : not null access constant Element_Type) is private with
      Implicit_Dereference => Element;

   type Reference_Type (Element : not null access Element_Type) is private with
      Implicit_Dereference => Element;

   function Constant_Reference
     (Container : aliased Vector;
      Position  : Cursor)
      return      Constant_Reference_Type;

   function Reference
     (Container : aliased in out Vector;
      Position  : Cursor)
      return      Reference_Type;

   function Constant_Reference
     (Container : aliased Vector;
      Index     : Index_Type)
      return      Constant_Reference_Type;

   function Reference
     (Container : aliased in out Vector;
      Index     : Index_Type)
      return      Reference_Type;

   procedure Move (Target : in out Vector; Source : in out Vector);

   procedure Append (Container : in out Vector; New_Item : Element_Type);

   type Element_Access is access all Element_Type;
   function Append (Container : in out Vector) return Element_Access;

   procedure Delete_Last (Container : in out Vector);

   function First (Container : Vector) return Cursor;

   function Last_Index (Container : Vector) return Extended_Index;

   function Last (Container : Vector) return Cursor;

   function Last_Element (Container : Vector) return Element_Type;

   function Next (Position : Cursor) return Cursor;

   procedure Next (Position : in out Cursor);

   function Previous (Position : Cursor) return Cursor;

   procedure Previous (Position : in out Cursor);

   procedure Iterate
     (Container : Vector;
      Process   : not null access procedure (Position : Cursor));

   procedure Reverse_Iterate
     (Container : Vector;
      Process   : not null access procedure (Position : Cursor));

   function Iterate
     (Container : Vector)
      return      Vector_Iterator_Interfaces.Reversible_Iterator'Class;

   function Iterate
     (Container : Vector;
      Start     : Cursor)
      return      Vector_Iterator_Interfaces.Reversible_Iterator'Class;

   generic
      with function "<" (Left, Right : Element_Type) return Boolean is <>;
   package Generic_Sorting is

      function Is_Sorted (Container : Vector) return Boolean;

      procedure Sort (Container : in out Vector);

      procedure Merge (Target : in out Vector; Source : in out Vector);

   end Generic_Sorting;

   --  Extra operations not in Ada.Containers.Vectors:

   subtype Big_Elements_Array is Elements_Array (Index_Type);
   type Big_Ptr is access constant Big_Elements_Array;
   pragma No_Strict_Aliasing (Big_Ptr);
   type Big_Ptr_Var is access all Big_Elements_Array;
   pragma No_Strict_Aliasing (Big_Ptr_Var);

   function Elems (Container : Vector) return Big_Ptr; -- with
--      Post => Elems'Result'First = Index_Type'First;
   function Elems_Var (Container : Vector) return Big_Ptr_Var; -- with
--      Post => Elems_Var'Result'First = Index_Type'First;
--  ???Above postconditions cause warnings These return a pointer to the
--  underlying data structure. This is of course dangerous. The idea is
--  that you can do:
   --
   --     X : Elems_Array renames Elems (V) (1 .. Last_Index (V));
   --
   --  But don't do Append (etc) while X still exists. Do not call these
   --  without the slicing.

   function Slice
     (Container : Vector;
      First     : Index_Type;
      Last      : Extended_Index)
      return      Elements_Array with
      Post => Slice'Result'First = Index_Type'First;

   function To_Array (Container : Vector) return Elements_Array with
      Post => To_Array'Result'First = Index_Type'First;

   procedure Append (Container : in out Vector; New_Items : Elements_Array);

private

   pragma Inline (Append);
   pragma Inline (Constant_Reference);
   pragma Inline (Clear);
   pragma Inline (Reference);
   pragma Inline (Last_Index);
   pragma Inline (Element);
   pragma Inline (Last_Element);
   pragma Inline (Is_Empty);

   function "=" (L, R : Elements_Array) return Boolean is abstract;

   type Elements_Type (Last : Extended_Index) is limited record
      EA : aliased Elements_Array (Index_Type'First .. Last);
   end record;

   Empty_Elements : aliased Elements_Type := (Last => 0, EA => (others => <>));

   type Elements_Access is access all Elements_Type;

   use Ada.Finalization;

   type Vector is new Controlled with record
      Elements : Elements_Access := Empty_Elements'Access;
      Last     : Extended_Index  := No_Index;
   end record;

   overriding procedure Adjust (Container : in out Vector);

   overriding procedure Finalize (Container : in out Vector);

   type Vector_Access is access all Vector;

   type Cursor is record
      Container : Vector_Access;
      Index     : Index_Type := Index_Type'First;
   end record;

   type Constant_Reference_Type
     (Element : not null access constant Element_Type) is null record;

   type Reference_Type (Element : not null access Element_Type) is null record;

   No_Element : constant Cursor := Cursor'(null, Index_Type'First);

   Empty_Vector : constant Vector := (Controlled with others => <>);

end ASIS_UL.Fast_Vectors;