1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- ADA.CONTAINERS.FORMAL_INDEFINITE_VECTORS -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2014, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26------------------------------------------------------------------------------ 27 28package body Ada.Containers.Formal_Indefinite_Vectors with 29 SPARK_Mode => Off 30is 31 pragma Annotate (CodePeer, Skip_Analysis); 32 33 function H (New_Item : Element_Type) return Holder renames To_Holder; 34 function E (Container : Holder) return Element_Type renames Get; 35 36 --------- 37 -- "=" -- 38 --------- 39 40 function "=" (Left, Right : Vector) return Boolean is 41 (Left.V = Right.V); 42 43 ------------ 44 -- Append -- 45 ------------ 46 47 procedure Append (Container : in out Vector; New_Item : Vector) is 48 begin 49 Append (Container.V, New_Item.V); 50 end Append; 51 52 procedure Append 53 (Container : in out Vector; 54 New_Item : Element_Type) 55 is 56 begin 57 Append (Container.V, H (New_Item)); 58 end Append; 59 60 ------------ 61 -- Assign -- 62 ------------ 63 64 procedure Assign (Target : in out Vector; Source : Vector) is 65 begin 66 Assign (Target.V, Source.V); 67 end Assign; 68 69 -------------- 70 -- Capacity -- 71 -------------- 72 73 function Capacity (Container : Vector) return Capacity_Range is 74 (Capacity (Container.V)); 75 76 ----------- 77 -- Clear -- 78 ----------- 79 80 procedure Clear (Container : in out Vector) is 81 begin 82 Clear (Container.V); 83 end Clear; 84 85 -------------- 86 -- Contains -- 87 -------------- 88 89 function Contains 90 (Container : Vector; 91 Item : Element_Type) return Boolean 92 is 93 (Contains (Container.V, H (Item))); 94 95 ---------- 96 -- Copy -- 97 ---------- 98 99 function Copy 100 (Source : Vector; 101 Capacity : Capacity_Range := 0) return Vector 102 is 103 ((if Capacity = 0 then Length (Source) else Capacity), 104 V => Copy (Source.V, Capacity)); 105 106 --------------------- 107 -- Current_To_Last -- 108 --------------------- 109 110 function Current_To_Last 111 (Container : Vector; 112 Current : Index_Type) return Vector is 113 begin 114 return (Length (Container), Current_To_Last (Container.V, Current)); 115 end Current_To_Last; 116 117 ----------------- 118 -- Delete_Last -- 119 ----------------- 120 121 procedure Delete_Last 122 (Container : in out Vector) 123 is 124 begin 125 Delete_Last (Container.V); 126 end Delete_Last; 127 128 ------------- 129 -- Element -- 130 ------------- 131 132 function Element 133 (Container : Vector; 134 Index : Index_Type) return Element_Type is 135 (E (Element (Container.V, Index))); 136 137 ---------------- 138 -- Find_Index -- 139 ---------------- 140 141 function Find_Index 142 (Container : Vector; 143 Item : Element_Type; 144 Index : Index_Type := Index_Type'First) return Extended_Index 145 is 146 (Find_Index (Container.V, H (Item), Index)); 147 148 ------------------- 149 -- First_Element -- 150 ------------------- 151 152 function First_Element (Container : Vector) return Element_Type is 153 (E (First_Element (Container.V))); 154 155 ----------------- 156 -- First_Index -- 157 ----------------- 158 159 function First_Index (Container : Vector) return Index_Type is 160 (First_Index (Container.V)); 161 162 ----------------------- 163 -- First_To_Previous -- 164 ----------------------- 165 166 function First_To_Previous 167 (Container : Vector; 168 Current : Index_Type) return Vector is 169 begin 170 return (Length (Container), First_To_Previous (Container.V, Current)); 171 end First_To_Previous; 172 173 --------------------- 174 -- Generic_Sorting -- 175 --------------------- 176 177 package body Generic_Sorting is 178 179 function "<" (X, Y : Holder) return Boolean is (E (X) < E (Y)); 180 package Def_Sorting is new Def.Generic_Sorting ("<"); 181 use Def_Sorting; 182 183 --------------- 184 -- Is_Sorted -- 185 --------------- 186 187 function Is_Sorted (Container : Vector) return Boolean is 188 (Is_Sorted (Container.V)); 189 190 ---------- 191 -- Sort -- 192 ---------- 193 194 procedure Sort (Container : in out Vector) is 195 begin 196 Sort (Container.V); 197 end Sort; 198 199 end Generic_Sorting; 200 201 ----------------- 202 -- Has_Element -- 203 ----------------- 204 205 function Has_Element 206 (Container : Vector; 207 Position : Extended_Index) return Boolean 208 is 209 (Has_Element (Container.V, Position)); 210 211 -------------- 212 -- Is_Empty -- 213 -------------- 214 215 function Is_Empty (Container : Vector) return Boolean is 216 (Is_Empty (Container.V)); 217 218 ------------------ 219 -- Last_Element -- 220 ------------------ 221 222 function Last_Element (Container : Vector) return Element_Type is 223 (E (Last_Element (Container.V))); 224 225 ---------------- 226 -- Last_Index -- 227 ---------------- 228 229 function Last_Index (Container : Vector) return Extended_Index is 230 (Last_Index (Container.V)); 231 232 ------------ 233 -- Length -- 234 ------------ 235 236 function Length (Container : Vector) return Capacity_Range is 237 (Length (Container.V)); 238 239 --------------------- 240 -- Replace_Element -- 241 --------------------- 242 243 procedure Replace_Element 244 (Container : in out Vector; 245 Index : Index_Type; 246 New_Item : Element_Type) 247 is 248 begin 249 Replace_Element (Container.V, Index, H (New_Item)); 250 end Replace_Element; 251 252 ---------------------- 253 -- Reserve_Capacity -- 254 ---------------------- 255 256 procedure Reserve_Capacity 257 (Container : in out Vector; 258 Capacity : Capacity_Range) 259 is 260 begin 261 Reserve_Capacity (Container.V, Capacity); 262 end Reserve_Capacity; 263 264 ---------------------- 265 -- Reverse_Elements -- 266 ---------------------- 267 268 procedure Reverse_Elements (Container : in out Vector) is 269 begin 270 Reverse_Elements (Container.V); 271 end Reverse_Elements; 272 273 ------------------------ 274 -- Reverse_Find_Index -- 275 ------------------------ 276 277 function Reverse_Find_Index 278 (Container : Vector; 279 Item : Element_Type; 280 Index : Index_Type := Index_Type'Last) return Extended_Index 281 is 282 (Reverse_Find_Index (Container.V, H (Item), Index)); 283 284 ---------- 285 -- Swap -- 286 ---------- 287 288 procedure Swap (Container : in out Vector; I, J : Index_Type) is 289 begin 290 Swap (Container.V, I, J); 291 end Swap; 292 293 --------------- 294 -- To_Vector -- 295 --------------- 296 297 function To_Vector 298 (New_Item : Element_Type; 299 Length : Capacity_Range) return Vector 300 is 301 begin 302 return (Length, To_Vector (H (New_Item), Length)); 303 end To_Vector; 304 305end Ada.Containers.Formal_Indefinite_Vectors; 306