gcc/ada/a-cofuve.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --                    ADA.CONTAINERS.FUNCTIONAL_VECTORS                     --
   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_Vectors with SPARK_Mode => Off is
  34    use Containers;
  35
  36    ---------
  37    -- "<" --
  38    ---------
  39
  40    function "<" (Left : Sequence; Right : Sequence) return Boolean is
  41      (Length (Left.Content) < Length (Right.Content)
  42        and then (for all I in Index_Type'First .. Last (Left) =>
  43                   Get (Left.Content, I) = Get (Right.Content, I)));
  44
  45    ----------
  46    -- "<=" --
  47    ----------
  48
  49    function "<=" (Left : Sequence; Right : Sequence) return Boolean is
  50      (Length (Left.Content) <= Length (Right.Content)
  51        and then (for all I in Index_Type'First .. Last (Left) =>
  52                   Get (Left.Content, I) = Get (Right.Content, I)));
  53
  54    ---------
  55    -- "=" --
  56    ---------
  57
  58    function "=" (Left : Sequence; Right : Sequence) return Boolean is
  59      (Left.Content = Right.Content);
  60
  61    ---------
  62    -- Add --
  63    ---------
  64
  65    function Add
  66      (Container : Sequence;
  67       New_Item  : Element_Type) return Sequence
  68    is
  69      (Content =>
  70        Add (Container.Content,
  71             Index_Type'Val (Index_Type'Pos (Index_Type'First) +
  72                             Length (Container.Content)),
  73             New_Item));
  74
  75    function Add
  76      (Container : Sequence;
  77       Position  : Index_Type;
  78       New_Item  : Element_Type) return Sequence
  79    is
  80      (Content => Add (Container.Content, Position, New_Item));
  81
  82    --------------------
  83    -- Constant_Range --
  84    --------------------
  85
  86    function Constant_Range
  87      (Container : Sequence;
  88       Fst       : Index_Type;
  89       Lst       : Extended_Index;
  90       Item      : Element_Type) return Boolean is
  91    begin
  92       for I in Fst .. Lst loop
  93          if Get (Container.Content, I) /= Item then
  94             return False;
  95          end if;
  96       end loop;
  97
  98       return True;
  99    end Constant_Range;
 100
 101    --------------
 102    -- Contains --
 103    --------------
 104
 105    function Contains
 106      (Container : Sequence;
 107       Fst       : Index_Type;
 108       Lst       : Extended_Index;
 109       Item      : Element_Type) return Boolean
 110    is
 111    begin
 112       for I in Fst .. Lst loop
 113          if Get (Container.Content, I) = Item then
 114             return True;
 115          end if;
 116       end loop;
 117
 118       return False;
 119    end Contains;
 120
 121    ------------------
 122    -- Range_Except --
 123    ------------------
 124
 125    function Equal_Except
 126      (Left     : Sequence;
 127       Right    : Sequence;
 128       Position : Index_Type) return Boolean
 129    is
 130    begin
 131       if Length (Left.Content) /= Length (Right.Content) then
 132          return False;
 133       end if;
 134
 135       for I in Index_Type'First .. Last (Left) loop
 136          if I /= Position
 137            and then Get (Left.Content, I) /= Get (Right.Content, I)
 138          then
 139             return False;
 140          end if;
 141       end loop;
 142
 143       return True;
 144    end Equal_Except;
 145
 146    function Equal_Except
 147      (Left  : Sequence;
 148       Right : Sequence;
 149       X     : Index_Type;
 150       Y     : Index_Type) return Boolean
 151    is
 152    begin
 153       if Length (Left.Content) /= Length (Right.Content) then
 154          return False;
 155       end if;
 156
 157       for I in Index_Type'First .. Last (Left) loop
 158          if I /= X and then I /= Y
 159            and then Get (Left.Content, I) /= Get (Right.Content, I)
 160          then
 161             return False;
 162          end if;
 163       end loop;
 164
 165       return True;
 166    end Equal_Except;
 167
 168    ---------
 169    -- Get --
 170    ---------
 171
 172    function Get (Container : Sequence;
 173                  Position  : Extended_Index) return Element_Type
 174    is
 175      (Get (Container.Content, Position));
 176
 177    ----------
 178    -- Last --
 179    ----------
 180
 181    function Last (Container : Sequence) return Extended_Index is
 182      (Index_Type'Val
 183        ((Index_Type'Pos (Index_Type'First) - 1) + Length (Container)));
 184
 185    ------------
 186    -- Length --
 187    ------------
 188
 189    function Length (Container : Sequence) return Count_Type is
 190      (Length (Container.Content));
 191
 192    -----------------
 193    -- Range_Equal --
 194    -----------------
 195
 196    function Range_Equal
 197      (Left  : Sequence;
 198       Right : Sequence;
 199       Fst   : Index_Type;
 200       Lst   : Extended_Index) return Boolean
 201    is
 202    begin
 203       for I in Fst .. Lst loop
 204          if Get (Left, I) /= Get (Right, I) then
 205             return False;
 206          end if;
 207       end loop;
 208
 209       return True;
 210    end Range_Equal;
 211
 212    -------------------
 213    -- Range_Shifted --
 214    -------------------
 215
 216    function Range_Shifted
 217      (Left   : Sequence;
 218       Right  : Sequence;
 219       Fst    : Index_Type;
 220       Lst    : Extended_Index;
 221       Offset : Count_Type'Base) return Boolean
 222    is
 223    begin
 224       for I in Fst .. Lst loop
 225          if Get (Left, I) /=
 226               Get (Right, Index_Type'Val (Index_Type'Pos (I) + Offset))
 227          then
 228             return False;
 229          end if;
 230       end loop;
 231       return True;
 232    end Range_Shifted;
 233
 234    ------------
 235    -- Remove --
 236    ------------
 237
 238    function Remove
 239      (Container : Sequence;
 240       Position : Index_Type) return Sequence
 241    is
 242      (Content => Remove (Container.Content, Position));
 243
 244    ---------
 245    -- Set --
 246    ---------
 247
 248    function Set
 249      (Container : Sequence;
 250       Position  : Index_Type;
 251       New_Item  : Element_Type) return Sequence
 252    is
 253      (Content => Set (Container.Content, Position, New_Item));
 254
 255 end Ada.Containers.Functional_Vectors;