gcc/ada/libgnat/a-cofuma.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --                      ADA.CONTAINERS.FUNCTIONAL_MAPS                      --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2016-2017, 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
  32 pragma Ada_2012;
  33 package 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
 284 end Ada.Containers.Functional_Maps;