-- Abstract : -- -- A simple unbounded vector of definite items, intended to be faster -- than Ada.Containers.Vectors. -- -- Prepend is as fast (in amortized time) as Append. -- -- Design: -- -- We provide no control of references to Vector held by various -- types; adding that proved buggy and very slow (Wisitoken generate -- time for Ada went from 200 seconds to 640 seconds). So the user -- must be aware of potential problems: -- -- declare -- Object : Element_Type renames Vector.Constant_Ref (Position); -- begin -- Vector.Insert (A); -- reallocates underlying array to grow it -- -- B := Object.B; -- Invalid reference -- end; -- -- See ARM 3.10.2 "explicitly aliased" for why we need 'aliased' in -- several subprogram argument modes, and why Container must be an -- access discriminant in Cursor and Iterator. -- -- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. -- -- This library 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 3, or (at your option) any later -- version. This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- As a special exception under Section 7 of GPL version 3, you are granted -- additional permissions described in the GCC Runtime Library Exception, -- version 3.1, as published by the Free Software Foundation. pragma License (Modified_GPL); with Ada.Finalization; with Ada.Iterator_Interfaces; with Ada.Unchecked_Deallocation; generic type Index_Type is range <>; type Element_Type is private; Default_Element : in Element_Type; package SAL.Gen_Unbounded_Definite_Vectors is 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 new Ada.Finalization.Controlled with private with Constant_Indexing => Constant_Ref, Variable_Indexing => Variable_Ref, Default_Iterator => Iterate, Iterator_Element => Element_Type; Empty_Vector : constant Vector; overriding procedure Finalize (Container : in out Vector); overriding procedure Adjust (Container : in out Vector); overriding function "=" (Left, Right : in Vector) return Boolean is (raise Programmer_Error); -- Use Gen_Comparable child. function Is_Empty (Container : in Vector) return Boolean; function Length (Container : in Vector) return Ada.Containers.Count_Type; function Capacity (Container : in Vector) return Ada.Containers.Count_Type; procedure Set_Capacity (Container : in out Vector; First : in Index_Type; Last : in Extended_Index); -- Allocates memory, but does not change Container.First, Container.Last. procedure Clear (Container : in out Vector; Free_Memory : in Boolean := False); -- Set Container to Empty. If Free_Memory, free all memory, . function First_Index (Container : Vector; No_Index_If_Empty : in Boolean := False) return Extended_Index; -- By default, No_Index + 1 when Container is empty, so "for I in -- C.First_Index .. C.Last_Index loop" works. -- -- If you need No_Index for an empty Container, use No_Index_If_Empty -- => True. function Last_Index (Container : Vector) return Extended_Index; -- No_Index when Container is empty. function Element (Container : Vector; Index : Index_Type) return Element_Type with Pre => Index >= Container.First_Index and Index <= Container.Last_Index; procedure Replace_Element (Container : Vector; Index : Index_Type; New_Item : in Element_Type); procedure Append (Container : in out Vector; New_Item : in Element_Type); -- Insert New_Item at end of Container. -- -- Raises Constraint_Error if index of new item would be greater than -- Index_Type'Last. function Append (Container : in out Vector; New_Item : in Element_Type) return Index_Type; -- Same as Append, return index of new element. procedure Append (Container : in out Vector; New_Items : in Vector); -- Insert all elements of New_Items at end of Container. procedure Prepend (Container : in out Vector; New_Item : in Element_Type); -- Insert New_Item at beginning of Container. -- -- Raises Constraint_Error if index of new item would be less than -- Index_Type'First. procedure Prepend (Target : in out Vector; Source : in Vector; Source_First : in Index_Type; Source_Last : in Index_Type); -- Copy Source (Source_First .. Source_Last) to Target, before -- Target.First_Index. procedure Insert (Container : in out Vector; Element : in Element_Type; Before : in Index_Type); -- Existing elements at Before and after are slid to higher indices. procedure Add (Container : in out Vector; Element : in Element_Type; Index : in Index_Type); -- If Index is not in Container.First_Index .. Container.Last_Index, -- grow Container to include Index. Then store Element at Index. procedure Merge (Target : in out Vector; Source : in out Vector); -- Copy all elements from Source to Target, to the same index range, -- deleting them from Source, and overwriting overlapping ranges. function To_Vector (Item : in Element_Type; Count : in Ada.Containers.Count_Type := 1) return Vector; function "+" (Element : in Element_Type) return Vector; function "&" (Left, Right : in Element_Type) return Vector; function "&" (Left : in Vector; Right : in Element_Type) return Vector; procedure Set_First_Last (Container : in out Vector; First : in Index_Type; Last : in Extended_Index); -- Elements in the expansion from previous First .. Last are set to -- Default_Element. procedure Extend (Container : in out Vector; Index : in Index_Type); -- Extend Container index range (if needed) to include Index. procedure Delete (Container : in out Vector; Index : in Index_Type); -- Replace Index element contents with Default_Element. If Index = -- Container.Last_Index, Container.Last_Index is decremented. function Contains (Container : in Vector; Element : in Element_Type) return Boolean; -- Return True if Element is in Container, False if not. type Constant_Reference_Type (Element : not null access constant Element_Type) is private with Implicit_Dereference => Element; function Constant_Ref (Container : aliased in Vector; Index : in Index_Type) return Constant_Reference_Type with Inline, Pre => Index in Container.First_Index .. Container.Last_Index; type Variable_Reference_Type (Element : not null access Element_Type) is private with Implicit_Dereference => Element; function Variable_Ref (Container : aliased in Vector; Index : in Index_Type) return Variable_Reference_Type with Inline, Pre => Index in Container.First_Index .. Container.Last_Index; type Cursor is private; function Has_Element (Position : Cursor) return Boolean; function Element (Container : in Vector; Position : Cursor) return Element_Type with Pre => Has_Element (Position); function First (Container : in Vector) return Cursor; function Next (Container : in Vector; Position : in Cursor) return Cursor; procedure Next (Container : in Vector; Position : in out Cursor); function Prev (Container : in Vector; Position : in Cursor) return Cursor; procedure Prev (Container : in Vector; Position : in out Cursor); function No_Element (Container : in Vector) return Cursor; function To_Cursor (Container : in Vector; Index : in Extended_Index) return Cursor with Pre => Index = No_Index or Index in Container.First_Index .. Container.Last_Index; function To_Index (Position : in Cursor) return Extended_Index; package Iterator_Interfaces is new Ada.Iterator_Interfaces (Cursor, Has_Element); function Iterate (Container : aliased in Vector) return Iterator_Interfaces.Reversible_Iterator'Class; function Constant_Ref (Container : aliased in Vector; Position : in Cursor) return Constant_Reference_Type with Pre => Has_Element (Position) and then To_Index (Position) in Container.First_Index .. Container.Last_Index; function Variable_Ref (Container : aliased in Vector; Position : in Cursor) return Variable_Reference_Type with Pre => Has_Element (Position) and then To_Index (Position) in Container.First_Index .. Container.Last_Index; pragma Inline (Variable_Ref); private type Array_Type is array (SAL.Peek_Type range <>) of aliased Element_Type; type Array_Access is access Array_Type; procedure Free is new Ada.Unchecked_Deallocation (Array_Type, Array_Access); type Vector is new Ada.Finalization.Controlled with record Elements : Array_Access; -- Elements may be non-null with First = No_Index, after -- Set_Capacity. If First /= No_Index and Last >= First, Elements /= -- null. First > Last means Vector is empty. First : Extended_Index := No_Index; Last : Extended_Index := No_Index; end record; type Cursor is record Index : Base_Peek_Type := Invalid_Peek_Index; end record; type Iterator (Container : not null access constant Vector) is new Iterator_Interfaces.Reversible_Iterator with null record; overriding function First (Object : Iterator) return Cursor; overriding function Last (Object : Iterator) return Cursor; overriding function Next (Object : Iterator; Position : Cursor) return Cursor; overriding function Previous (Object : Iterator; Position : Cursor) return Cursor; type Constant_Reference_Type (Element : not null access constant Element_Type) is record Dummy : Integer := raise Program_Error with "uninitialized reference"; end record; type Variable_Reference_Type (Element : not null access Element_Type) is record Dummy : Integer := raise Program_Error with "uninitialized reference"; end record; Empty_Vector : constant Vector := (Ada.Finalization.Controlled with others => <>); ---------- -- Visible for contracts/SPARK function Has_Element (Position : Cursor) return Boolean is (Position.Index /= Invalid_Peek_Index); ---------- -- Visible for child package function To_Peek_Type (Item : in Extended_Index) return Base_Peek_Type with Inline; function To_Index_Type (Item : in Base_Peek_Type) return Extended_Index; procedure Grow (Elements : in out Array_Access; Index : in Base_Peek_Type); end SAL.Gen_Unbounded_Definite_Vectors;