1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- ADA.CONTAINERS.FUNCTIONAL_MAPS -- 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; 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 I in 1 .. Length (Left.Keys) loop 92 declare 93 K : constant Key_Type := Get (Left.Keys, I); 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, I)) 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 I in 1 .. Length (Left.Keys) loop 116 declare 117 K : constant Key_Type := Get (Left.Keys, I); 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, I)) 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 I in 1 .. Length (Left.Keys) loop 177 declare 178 K : constant Key_Type := Get (Left.Keys, I); 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 I in 1 .. Length (Left.Keys) loop 200 declare 201 K : constant Key_Type := Get (Left.Keys, I); 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 I in 1 .. Length (Left.Keys) loop 222 declare 223 K : constant Key_Type := Get (Left.Keys, I); 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 -- Same_Keys -- 248 --------------- 249 250 function Same_Keys (Left : Map; Right : Map) return Boolean is 251 (Keys_Included (Left, Right) 252 and Keys_Included (Left => Right, Right => Left)); 253 254 --------- 255 -- Set -- 256 --------- 257 258 function Set 259 (Container : Map; 260 Key : Key_Type; 261 New_Item : Element_Type) return Map 262 is 263 (Keys => Container.Keys, 264 Elements => 265 Set (Container.Elements, Find (Container.Keys, Key), New_Item)); 266 267 ----------- 268 -- W_Get -- 269 ----------- 270 271 function W_Get 272 (Container : Map; 273 Witness : Count_Type) return Element_Type 274 is 275 (Get (Container.Elements, Witness)); 276 277 ------------- 278 -- Witness -- 279 ------------- 280 281 function Witness (Container : Map; Key : Key_Type) return Count_Type is 282 (Find (Container.Keys, Key)); 283 284end Ada.Containers.Functional_Maps; 285