1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- ADA.CONTAINERS.FUNCTIONAL_MAPS -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2016-2019, 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; 33package body Ada.Containers.Functional_Maps with SPARK_Mode => Off is 34 use Key_Containers; 35 use Element_Containers; 36 37 --------- 38 -- "=" -- 39 --------- 40 41 function "=" (Left : Map; Right : Map) return Boolean is 42 (Left.Keys <= Right.Keys and Right <= Left); 43 44 ---------- 45 -- "<=" -- 46 ---------- 47 48 function "<=" (Left : Map; Right : Map) return Boolean is 49 I2 : Count_Type; 50 51 begin 52 for I1 in 1 .. Length (Left.Keys) loop 53 I2 := Find (Right.Keys, Get (Left.Keys, I1)); 54 if I2 = 0 55 or else Get (Right.Elements, I2) /= Get (Left.Elements, I1) 56 then 57 return False; 58 end if; 59 end loop; 60 return True; 61 end "<="; 62 63 --------- 64 -- Add -- 65 --------- 66 67 function Add 68 (Container : Map; 69 New_Key : Key_Type; 70 New_Item : Element_Type) return Map 71 is 72 begin 73 return 74 (Keys => 75 Add (Container.Keys, Length (Container.Keys) + 1, New_Key), 76 Elements => 77 Add 78 (Container.Elements, Length (Container.Elements) + 1, New_Item)); 79 end Add; 80 81 --------------------------- 82 -- Elements_Equal_Except -- 83 --------------------------- 84 85 function Elements_Equal_Except 86 (Left : Map; 87 Right : Map; 88 New_Key : Key_Type) return Boolean 89 is 90 begin 91 for J in 1 .. Length (Left.Keys) loop 92 declare 93 K : constant Key_Type := Get (Left.Keys, J); 94 begin 95 if not Equivalent_Keys (K, New_Key) 96 and then 97 (Find (Right.Keys, K) = 0 98 or else Get (Right.Elements, Find (Right.Keys, K)) /= 99 Get (Left.Elements, J)) 100 then 101 return False; 102 end if; 103 end; 104 end loop; 105 return True; 106 end Elements_Equal_Except; 107 108 function Elements_Equal_Except 109 (Left : Map; 110 Right : Map; 111 X : Key_Type; 112 Y : Key_Type) return Boolean 113 is 114 begin 115 for J in 1 .. Length (Left.Keys) loop 116 declare 117 K : constant Key_Type := Get (Left.Keys, J); 118 begin 119 if not Equivalent_Keys (K, X) 120 and then not Equivalent_Keys (K, Y) 121 and then 122 (Find (Right.Keys, K) = 0 123 or else Get (Right.Elements, Find (Right.Keys, K)) /= 124 Get (Left.Elements, J)) 125 then 126 return False; 127 end if; 128 end; 129 end loop; 130 return True; 131 end Elements_Equal_Except; 132 133 --------- 134 -- Get -- 135 --------- 136 137 function Get (Container : Map; Key : Key_Type) return Element_Type is 138 begin 139 return Get (Container.Elements, Find (Container.Keys, Key)); 140 end Get; 141 142 ------------- 143 -- Has_Key -- 144 ------------- 145 146 function Has_Key (Container : Map; Key : Key_Type) return Boolean is 147 begin 148 return Find (Container.Keys, Key) > 0; 149 end Has_Key; 150 151 ----------------- 152 -- Has_Witness -- 153 ----------------- 154 155 function Has_Witness 156 (Container : Map; 157 Witness : Count_Type) return Boolean 158 is 159 (Witness in 1 .. Length (Container.Keys)); 160 161 -------------- 162 -- Is_Empty -- 163 -------------- 164 165 function Is_Empty (Container : Map) return Boolean is 166 begin 167 return Length (Container.Keys) = 0; 168 end Is_Empty; 169 170 ------------------- 171 -- Keys_Included -- 172 ------------------- 173 174 function Keys_Included (Left : Map; Right : Map) return Boolean is 175 begin 176 for J in 1 .. Length (Left.Keys) loop 177 declare 178 K : constant Key_Type := Get (Left.Keys, J); 179 begin 180 if Find (Right.Keys, K) = 0 then 181 return False; 182 end if; 183 end; 184 end loop; 185 186 return True; 187 end Keys_Included; 188 189 -------------------------- 190 -- Keys_Included_Except -- 191 -------------------------- 192 193 function Keys_Included_Except 194 (Left : Map; 195 Right : Map; 196 New_Key : Key_Type) return Boolean 197 is 198 begin 199 for J in 1 .. Length (Left.Keys) loop 200 declare 201 K : constant Key_Type := Get (Left.Keys, J); 202 begin 203 if not Equivalent_Keys (K, New_Key) 204 and then Find (Right.Keys, K) = 0 205 then 206 return False; 207 end if; 208 end; 209 end loop; 210 211 return True; 212 end Keys_Included_Except; 213 214 function Keys_Included_Except 215 (Left : Map; 216 Right : Map; 217 X : Key_Type; 218 Y : Key_Type) return Boolean 219 is 220 begin 221 for J in 1 .. Length (Left.Keys) loop 222 declare 223 K : constant Key_Type := Get (Left.Keys, J); 224 begin 225 if not Equivalent_Keys (K, X) 226 and then not Equivalent_Keys (K, Y) 227 and then Find (Right.Keys, K) = 0 228 then 229 return False; 230 end if; 231 end; 232 end loop; 233 234 return True; 235 end Keys_Included_Except; 236 237 ------------ 238 -- Length -- 239 ------------ 240 241 function Length (Container : Map) return Count_Type is 242 begin 243 return Length (Container.Elements); 244 end Length; 245 246 ------------ 247 -- Remove -- 248 ------------ 249 250 function Remove (Container : Map; Key : Key_Type) return Map is 251 J : constant Extended_Index := Find (Container.Keys, Key); 252 begin 253 return 254 (Keys => Remove (Container.Keys, J), 255 Elements => Remove (Container.Elements, J)); 256 end Remove; 257 258 --------------- 259 -- Same_Keys -- 260 --------------- 261 262 function Same_Keys (Left : Map; Right : Map) return Boolean is 263 (Keys_Included (Left, Right) 264 and Keys_Included (Left => Right, Right => Left)); 265 266 --------- 267 -- Set -- 268 --------- 269 270 function Set 271 (Container : Map; 272 Key : Key_Type; 273 New_Item : Element_Type) return Map 274 is 275 (Keys => Container.Keys, 276 Elements => 277 Set (Container.Elements, Find (Container.Keys, Key), New_Item)); 278 279 ----------- 280 -- W_Get -- 281 ----------- 282 283 function W_Get 284 (Container : Map; 285 Witness : Count_Type) return Element_Type 286 is 287 (Get (Container.Elements, Witness)); 288 289 ------------- 290 -- Witness -- 291 ------------- 292 293 function Witness (Container : Map; Key : Key_Type) return Count_Type is 294 (Find (Container.Keys, Key)); 295 296end Ada.Containers.Functional_Maps; 297