| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT LIBRARY COMPONENTS -- |
| -- -- |
| -- ADA.CONTAINERS.FUNCTIONAL_BASE -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 2016-2019, Free Software Foundation, Inc. -- |
| -- -- |
| -- This specification is derived from the Ada Reference Manual for use with -- |
| -- GNAT. The copyright notice above, and the license provisions that follow -- |
| -- apply solely to the contents of the part following the private keyword. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- 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. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| ------------------------------------------------------------------------------ |
| |
| pragma Ada_2012; |
| |
| package body Ada.Containers.Functional_Base with SPARK_Mode => Off is |
| |
| function To_Count (Idx : Extended_Index) return Count_Type is |
| (Count_Type |
| (Extended_Index'Pos (Idx) - |
| Extended_Index'Pos (Extended_Index'First))); |
| |
| function To_Index (Position : Count_Type) return Extended_Index is |
| (Extended_Index'Val |
| (Position + Extended_Index'Pos (Extended_Index'First))); |
| -- Conversion functions between Index_Type and Count_Type |
| |
| function Find (C : Container; E : access Element_Type) return Count_Type; |
| -- Search a container C for an element equal to E.all, returning the |
| -- position in the underlying array. |
| |
| --------- |
| -- "=" -- |
| --------- |
| |
| function "=" (C1 : Container; C2 : Container) return Boolean is |
| begin |
| if C1.Elements'Length /= C2.Elements'Length then |
| return False; |
| end if; |
| |
| for I in C1.Elements'Range loop |
| if C1.Elements (I).all /= C2.Elements (I).all then |
| return False; |
| end if; |
| end loop; |
| |
| return True; |
| end "="; |
| |
| ---------- |
| -- "<=" -- |
| ---------- |
| |
| function "<=" (C1 : Container; C2 : Container) return Boolean is |
| begin |
| for I in C1.Elements'Range loop |
| if Find (C2, C1.Elements (I)) = 0 then |
| return False; |
| end if; |
| end loop; |
| |
| return True; |
| end "<="; |
| |
| --------- |
| -- Add -- |
| --------- |
| |
| function Add |
| (C : Container; |
| I : Index_Type; |
| E : Element_Type) return Container |
| is |
| A : constant Element_Array_Access := |
| new Element_Array'(1 .. C.Elements'Last + 1 => <>); |
| P : Count_Type := 0; |
| |
| begin |
| for J in 1 .. C.Elements'Last + 1 loop |
| if J /= To_Count (I) then |
| P := P + 1; |
| A (J) := C.Elements (P); |
| else |
| A (J) := new Element_Type'(E); |
| end if; |
| end loop; |
| |
| return Container'(Elements => A); |
| end Add; |
| |
| ---------- |
| -- Find -- |
| ---------- |
| |
| function Find (C : Container; E : access Element_Type) return Count_Type is |
| begin |
| for I in C.Elements'Range loop |
| if C.Elements (I).all = E.all then |
| return I; |
| end if; |
| end loop; |
| |
| return 0; |
| end Find; |
| |
| function Find (C : Container; E : Element_Type) return Extended_Index is |
| (To_Index (Find (C, E'Unrestricted_Access))); |
| |
| --------- |
| -- Get -- |
| --------- |
| |
| function Get (C : Container; I : Index_Type) return Element_Type is |
| (C.Elements (To_Count (I)).all); |
| |
| ------------------ |
| -- Intersection -- |
| ------------------ |
| |
| function Intersection (C1 : Container; C2 : Container) return Container is |
| A : constant Element_Array_Access := |
| new Element_Array'(1 .. Num_Overlaps (C1, C2) => <>); |
| P : Count_Type := 0; |
| |
| begin |
| for I in C1.Elements'Range loop |
| if Find (C2, C1.Elements (I)) > 0 then |
| P := P + 1; |
| A (P) := C1.Elements (I); |
| end if; |
| end loop; |
| |
| return Container'(Elements => A); |
| end Intersection; |
| |
| ------------ |
| -- Length -- |
| ------------ |
| |
| function Length (C : Container) return Count_Type is (C.Elements'Length); |
| |
| --------------------- |
| -- Num_Overlaps -- |
| --------------------- |
| |
| function Num_Overlaps (C1 : Container; C2 : Container) return Count_Type is |
| P : Count_Type := 0; |
| |
| begin |
| for I in C1.Elements'Range loop |
| if Find (C2, C1.Elements (I)) > 0 then |
| P := P + 1; |
| end if; |
| end loop; |
| |
| return P; |
| end Num_Overlaps; |
| |
| ------------ |
| -- Remove -- |
| ------------ |
| |
| function Remove (C : Container; I : Index_Type) return Container is |
| A : constant Element_Array_Access := |
| new Element_Array'(1 .. C.Elements'Last - 1 => <>); |
| P : Count_Type := 0; |
| |
| begin |
| for J in C.Elements'Range loop |
| if J /= To_Count (I) then |
| P := P + 1; |
| A (P) := C.Elements (J); |
| end if; |
| end loop; |
| |
| return Container'(Elements => A); |
| end Remove; |
| |
| --------- |
| -- Set -- |
| --------- |
| |
| function Set |
| (C : Container; |
| I : Index_Type; |
| E : Element_Type) return Container |
| is |
| Result : constant Container := |
| Container'(Elements => new Element_Array'(C.Elements.all)); |
| |
| begin |
| Result.Elements (To_Count (I)) := new Element_Type'(E); |
| return Result; |
| end Set; |
| |
| ----------- |
| -- Union -- |
| ----------- |
| |
| function Union (C1 : Container; C2 : Container) return Container is |
| N : constant Count_Type := Num_Overlaps (C1, C2); |
| |
| begin |
| -- if C2 is completely included in C1 then return C1 |
| |
| if N = Length (C2) then |
| return C1; |
| end if; |
| |
| -- else loop through C2 to find the remaining elements |
| |
| declare |
| L : constant Count_Type := Length (C1) - N + Length (C2); |
| A : constant Element_Array_Access := |
| new Element_Array' |
| (C1.Elements.all & (Length (C1) + 1 .. L => <>)); |
| P : Count_Type := Length (C1); |
| |
| begin |
| for I in C2.Elements'Range loop |
| if Find (C1, C2.Elements (I)) = 0 then |
| P := P + 1; |
| A (P) := C2.Elements (I); |
| end if; |
| end loop; |
| |
| return Container'(Elements => A); |
| end; |
| end Union; |
| |
| end Ada.Containers.Functional_Base; |
