1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- ADA.CONTAINERS.FUNCTIONAL_BASE -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2016-2018, Free Software Foundation, Inc. -- 10-- -- 11-- This specification is derived from the Ada Reference Manual for use with -- 12-- GNAT. The copyright notice above, and the license provisions that follow -- 13-- apply solely to the contents of the part following the private keyword. -- 14-- -- 15-- GNAT is free software; you can redistribute it and/or modify it under -- 16-- terms of the GNU General Public License as published by the Free Soft- -- 17-- ware Foundation; either version 3, or (at your option) any later ver- -- 18-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 19-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 20-- or FITNESS FOR A PARTICULAR PURPOSE. -- 21-- -- 22-- As a special exception under Section 7 of GPL version 3, you are granted -- 23-- additional permissions described in the GCC Runtime Library Exception, -- 24-- version 3.1, as published by the Free Software Foundation. -- 25-- -- 26-- You should have received a copy of the GNU General Public License and -- 27-- a copy of the GCC Runtime Library Exception along with this program; -- 28-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 29-- <http://www.gnu.org/licenses/>. -- 30------------------------------------------------------------------------------ 31 32pragma Ada_2012; 33 34package body Ada.Containers.Functional_Base with SPARK_Mode => Off is 35 36 function To_Count (Idx : Extended_Index) return Count_Type is 37 (Count_Type 38 (Extended_Index'Pos (Idx) - 39 Extended_Index'Pos (Extended_Index'First))); 40 41 function To_Index (Position : Count_Type) return Extended_Index is 42 (Extended_Index'Val 43 (Position + Extended_Index'Pos (Extended_Index'First))); 44 -- Conversion functions between Index_Type and Count_Type 45 46 function Find (C : Container; E : access Element_Type) return Count_Type; 47 -- Search a container C for an element equal to E.all, returning the 48 -- position in the underlying array. 49 50 --------- 51 -- "=" -- 52 --------- 53 54 function "=" (C1 : Container; C2 : Container) return Boolean is 55 begin 56 if C1.Elements'Length /= C2.Elements'Length then 57 return False; 58 end if; 59 60 for I in C1.Elements'Range loop 61 if C1.Elements (I).all /= C2.Elements (I).all then 62 return False; 63 end if; 64 end loop; 65 66 return True; 67 end "="; 68 69 ---------- 70 -- "<=" -- 71 ---------- 72 73 function "<=" (C1 : Container; C2 : Container) return Boolean is 74 begin 75 for I in C1.Elements'Range loop 76 if Find (C2, C1.Elements (I)) = 0 then 77 return False; 78 end if; 79 end loop; 80 81 return True; 82 end "<="; 83 84 --------- 85 -- Add -- 86 --------- 87 88 function Add 89 (C : Container; 90 I : Index_Type; 91 E : Element_Type) return Container 92 is 93 A : constant Element_Array_Access := 94 new Element_Array'(1 .. C.Elements'Last + 1 => <>); 95 P : Count_Type := 0; 96 97 begin 98 for J in 1 .. C.Elements'Last + 1 loop 99 if J /= To_Count (I) then 100 P := P + 1; 101 A (J) := C.Elements (P); 102 else 103 A (J) := new Element_Type'(E); 104 end if; 105 end loop; 106 107 return Container'(Elements => A); 108 end Add; 109 110 ---------- 111 -- Find -- 112 ---------- 113 114 function Find (C : Container; E : access Element_Type) return Count_Type is 115 begin 116 for I in C.Elements'Range loop 117 if C.Elements (I).all = E.all then 118 return I; 119 end if; 120 end loop; 121 122 return 0; 123 end Find; 124 125 function Find (C : Container; E : Element_Type) return Extended_Index is 126 (To_Index (Find (C, E'Unrestricted_Access))); 127 128 --------- 129 -- Get -- 130 --------- 131 132 function Get (C : Container; I : Index_Type) return Element_Type is 133 (C.Elements (To_Count (I)).all); 134 135 ------------------ 136 -- Intersection -- 137 ------------------ 138 139 function Intersection (C1 : Container; C2 : Container) return Container is 140 A : constant Element_Array_Access := 141 new Element_Array'(1 .. Num_Overlaps (C1, C2) => <>); 142 P : Count_Type := 0; 143 144 begin 145 for I in C1.Elements'Range loop 146 if Find (C2, C1.Elements (I)) > 0 then 147 P := P + 1; 148 A (P) := C1.Elements (I); 149 end if; 150 end loop; 151 152 return Container'(Elements => A); 153 end Intersection; 154 155 ------------ 156 -- Length -- 157 ------------ 158 159 function Length (C : Container) return Count_Type is (C.Elements'Length); 160 161 --------------------- 162 -- Num_Overlaps -- 163 --------------------- 164 165 function Num_Overlaps (C1 : Container; C2 : Container) return Count_Type is 166 P : Count_Type := 0; 167 168 begin 169 for I in C1.Elements'Range loop 170 if Find (C2, C1.Elements (I)) > 0 then 171 P := P + 1; 172 end if; 173 end loop; 174 175 return P; 176 end Num_Overlaps; 177 178 ------------ 179 -- Remove -- 180 ------------ 181 182 function Remove (C : Container; I : Index_Type) return Container is 183 A : constant Element_Array_Access := 184 new Element_Array'(1 .. C.Elements'Last - 1 => <>); 185 P : Count_Type := 0; 186 187 begin 188 for J in C.Elements'Range loop 189 if J /= To_Count (I) then 190 P := P + 1; 191 A (P) := C.Elements (J); 192 end if; 193 end loop; 194 195 return Container'(Elements => A); 196 end Remove; 197 198 --------- 199 -- Set -- 200 --------- 201 202 function Set 203 (C : Container; 204 I : Index_Type; 205 E : Element_Type) return Container 206 is 207 Result : constant Container := 208 Container'(Elements => new Element_Array'(C.Elements.all)); 209 210 begin 211 Result.Elements (To_Count (I)) := new Element_Type'(E); 212 return Result; 213 end Set; 214 215 ----------- 216 -- Union -- 217 ----------- 218 219 function Union (C1 : Container; C2 : Container) return Container is 220 N : constant Count_Type := Num_Overlaps (C1, C2); 221 222 begin 223 -- if C2 is completely included in C1 then return C1 224 225 if N = Length (C2) then 226 return C1; 227 end if; 228 229 -- else loop through C2 to find the remaining elements 230 231 declare 232 L : constant Count_Type := Length (C1) - N + Length (C2); 233 A : constant Element_Array_Access := 234 new Element_Array' 235 (C1.Elements.all & (Length (C1) + 1 .. L => <>)); 236 P : Count_Type := Length (C1); 237 238 begin 239 for I in C2.Elements'Range loop 240 if Find (C1, C2.Elements (I)) = 0 then 241 P := P + 1; 242 A (P) := C2.Elements (I); 243 end if; 244 end loop; 245 246 return Container'(Elements => A); 247 end; 248 end Union; 249 250end Ada.Containers.Functional_Base; 251