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