1------------------------------------------------------------------------------ 2-- -- 3-- Matreshka Project -- 4-- -- 5-- Localization, Internationalization, Globalization for Ada -- 6-- -- 7-- Runtime Library Component -- 8-- -- 9------------------------------------------------------------------------------ 10-- -- 11-- Copyright © 2010-2013, Vadim Godunko <vgodunko@gmail.com> -- 12-- All rights reserved. -- 13-- -- 14-- Redistribution and use in source and binary forms, with or without -- 15-- modification, are permitted provided that the following conditions -- 16-- are met: -- 17-- -- 18-- * Redistributions of source code must retain the above copyright -- 19-- notice, this list of conditions and the following disclaimer. -- 20-- -- 21-- * Redistributions in binary form must reproduce the above copyright -- 22-- notice, this list of conditions and the following disclaimer in the -- 23-- documentation and/or other materials provided with the distribution. -- 24-- -- 25-- * Neither the name of the Vadim Godunko, IE nor the names of its -- 26-- contributors may be used to endorse or promote products derived from -- 27-- this software without specific prior written permission. -- 28-- -- 29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -- 35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- 36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- 37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- 38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- 39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 40-- -- 41------------------------------------------------------------------------------ 42-- $Revision: 3859 $ $Date: 2013-04-12 23:13:56 +0400 (Fri, 12 Apr 2013) $ 43------------------------------------------------------------------------------ 44 45package body League.Stream_Element_Vectors is 46 47 use type Ada.Streams.Stream_Element_Array; 48 use type Ada.Streams.Stream_Element_Offset; 49 use Matreshka.Internals.Stream_Element_Vectors; 50 51 --------- 52 -- "=" -- 53 --------- 54 55 overriding function "=" 56 (Left : Stream_Element_Vector; 57 Right : Stream_Element_Vector) return Boolean is 58 begin 59 return 60 Left.Data = Right.Data 61 or else 62 (Left.Data.Length = Right.Data.Length 63 and then 64 Left.Data.Value (0 .. Left.Data.Length - 1) 65 = Right.Data.Value (0 .. Right.Data.Length - 1)); 66 end "="; 67 68 --------- 69 -- "=" -- 70 --------- 71 72 not overriding function "=" 73 (Left : Stream_Element_Vector; 74 Right : Ada.Streams.Stream_Element_Array) return Boolean is 75 begin 76 if Left.Data.Length = Right'Length then 77 return 78 Left.Data.Value (0 .. Left.Data.Length - 1) = Right; 79 80 else 81 return False; 82 end if; 83 end "="; 84 85 --------- 86 -- "=" -- 87 --------- 88 89 not overriding function "=" 90 (Left : Ada.Streams.Stream_Element_Array; 91 Right : Stream_Element_Vector) return Boolean is 92 begin 93 if Left'Length = Right.Data.Length then 94 return 95 Left = Right.Data.Value (0 .. Right.Data.Length - 1); 96 97 else 98 return False; 99 end if; 100 end "="; 101 102 ------------ 103 -- Adjust -- 104 ------------ 105 106 overriding procedure Adjust (Self : in out Stream_Element_Vector) is 107 begin 108 Reference (Self.Data); 109 end Adjust; 110 111 ------------ 112 -- Append -- 113 ------------ 114 115 procedure Append 116 (Self : in out Stream_Element_Vector'Class; 117 Item : Ada.Streams.Stream_Element) 118 is 119 Data : constant Shared_Stream_Element_Vector_Access 120 := Allocate (Self.Data.Length + 1); 121 122 begin 123 Data.Length := Self.Data.Length + 1; 124 Data.Value (0 .. Self.Data.Length - 1) := 125 Self.Data.Value (0 .. Self.Data.Length - 1); 126 Data.Value (Data.Length - 1) := Item; 127 Fill_Tail (Data); 128 Dereference (Self.Data); 129 Self.Data := Data; 130 end Append; 131 132 ------------ 133 -- Append -- 134 ------------ 135 136 procedure Append 137 (Self : in out Stream_Element_Vector'Class; 138 Item : Ada.Streams.Stream_Element_Array) 139 is 140 Data : constant Shared_Stream_Element_Vector_Access 141 := Allocate (Self.Data.Length + Item'Length); 142 143 begin 144 Data.Length := Self.Data.Length + Item'Length; 145 Data.Value (0 .. Self.Data.Length - 1) := 146 Self.Data.Value (0 .. Self.Data.Length - 1); 147 Data.Value (Self.Data.Length .. Data.Length - 1) := Item; 148 Fill_Tail (Data); 149 Dereference (Self.Data); 150 Self.Data := Data; 151 end Append; 152 153 ------------ 154 -- Append -- 155 ------------ 156 157 procedure Append 158 (Self : in out Stream_Element_Vector'Class; 159 Item : Stream_Element_Vector'Class) 160 is 161 Data : constant Shared_Stream_Element_Vector_Access 162 := Allocate (Self.Data.Length + Item.Data.Length); 163 164 begin 165 Data.Length := Self.Data.Length + Item.Data.Length; 166 Data.Value (0 .. Self.Data.Length - 1) := 167 Self.Data.Value (0 .. Self.Data.Length - 1); 168 Data.Value (Self.Data.Length .. Data.Length - 1) := 169 Item.Data.Value (0 .. Item.Data.Length - 1); 170 Fill_Tail (Data); 171 Dereference (Self.Data); 172 Self.Data := Data; 173 end Append; 174 175 ----------- 176 -- Clear -- 177 ----------- 178 179 procedure Clear (Self : in out Stream_Element_Vector) is 180 begin 181 Dereference (Self.Data); 182 Self.Data := MISEV.Empty_Shared_Stream_Element_Vector'Access; 183 end Clear; 184 185 ------------- 186 -- Element -- 187 ------------- 188 189 function Element 190 (Self : Stream_Element_Vector'Class; 191 Index : Ada.Streams.Stream_Element_Offset) return Ada.Streams.Stream_Element is 192 begin 193 if Index <= Self.Data.Length then 194 return Self.Data.Value (Index - 1); 195 196 else 197 raise Constraint_Error with "Index is out of range"; 198 end if; 199 end Element; 200 201 -------------- 202 -- Finalize -- 203 -------------- 204 205 overriding procedure Finalize (Self : in out Stream_Element_Vector) is 206 begin 207 -- Finalize can be called more than once (as specified by language 208 -- standard), thus implementation should provide protection from 209 -- multiple finalization. 210 211 if Self.Data /= null then 212 Dereference (Self.Data); 213 end if; 214 end Finalize; 215 216 ---------- 217 -- Hash -- 218 ---------- 219 220 function Hash (Self : Stream_Element_Vector) return League.Hash_Type is 221 begin 222 return Hash (Self.Data); 223 end Hash; 224 225 -------------- 226 -- Is_Empty -- 227 -------------- 228 229 function Is_Empty (Self : Stream_Element_Vector) return Boolean is 230 begin 231 return Self.Data.Length = 0; 232 end Is_Empty; 233 234 ------------ 235 -- Length -- 236 ------------ 237 238 function Length 239 (Self : Stream_Element_Vector) return Ada.Streams.Stream_Element_Offset is 240 begin 241 return Self.Data.Length; 242 end Length; 243 244 ---------- 245 -- Read -- 246 ---------- 247 248 procedure Read 249 (Stream : not null access Ada.Streams.Root_Stream_Type'Class; 250 Item : out Stream_Element_Vector) 251 is 252 Length : Ada.Streams.Stream_Element_Offset; 253 254 begin 255 -- Read length of the stream element array. 256 257 Ada.Streams.Stream_Element_Offset'Read (Stream, Length); 258 259 -- Release shared object. XXX Object mutation can be used here for 260 -- performance improvement. 261 262 Dereference (Item.Data); 263 264 if Length = 0 then 265 -- Shared empty object is used for empty stream element array. 266 267 Item.Data := Empty_Shared_Stream_Element_Vector'Access; 268 269 else 270 -- Allocate shared object and read data into it. 271 272 Item.Data := Allocate (Length); 273 Item.Data.Length := Length; 274 Ada.Streams.Stream_Element_Array'Read 275 (Stream, Item.Data.Value (0 .. Length - 1)); 276 Fill_Tail (Item.Data); 277 end if; 278 end Read; 279 280 ----------------------------- 281 -- To_Stream_Element_Array -- 282 ----------------------------- 283 284 function To_Stream_Element_Array 285 (Item : Stream_Element_Vector) return Ada.Streams.Stream_Element_Array is 286 begin 287 return Item.Data.Value (0 .. Item.Data.Length - 1); 288 end To_Stream_Element_Array; 289 290 ------------------------------ 291 -- To_Stream_Element_Vector -- 292 ------------------------------ 293 294 function To_Stream_Element_Vector 295 (Item : Ada.Streams.Stream_Element_Array) return Stream_Element_Vector 296 is 297 Data : constant Shared_Stream_Element_Vector_Access 298 := Allocate (Item'Length); 299 300 begin 301 Data.Length := Item'Length; 302 Data.Value (0 .. Data.Length - 1) := Item; 303 Fill_Tail (Data); 304 305 return (Ada.Finalization.Controlled with Data => Data); 306 end To_Stream_Element_Vector; 307 308 ----------- 309 -- Write -- 310 ----------- 311 312 procedure Write 313 (Stream : not null access Ada.Streams.Root_Stream_Type'Class; 314 Item : Stream_Element_Vector) is 315 begin 316 Ada.Streams.Stream_Element_Offset'Write (Stream, Item.Data.Length); 317 318 if Item.Data.Length /= 0 then 319 Ada.Streams.Stream_Element_Array'Write 320 (Stream, Item.Data.Value (0 .. Item.Data.Length - 1)); 321 end if; 322 end Write; 323 324end League.Stream_Element_Vectors; 325