1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- ADA.CONTAINERS.FUNCTIONAL_VECTORS -- 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_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 255end Ada.Containers.Functional_Vectors; 256