annotate gcc/ada/libgnat/a-stzunb__shared.adb @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT RUN-TIME COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- A D A . S T R I N G S . W I D E _ W I D E _ U N B O U N D E D --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
kono
parents:
diff changeset
9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
kono
parents:
diff changeset
17 -- --
kono
parents:
diff changeset
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
kono
parents:
diff changeset
19 -- additional permissions described in the GCC Runtime Library Exception, --
kono
parents:
diff changeset
20 -- version 3.1, as published by the Free Software Foundation. --
kono
parents:
diff changeset
21 -- --
kono
parents:
diff changeset
22 -- You should have received a copy of the GNU General Public License and --
kono
parents:
diff changeset
23 -- a copy of the GCC Runtime Library Exception along with this program; --
kono
parents:
diff changeset
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
kono
parents:
diff changeset
25 -- <http://www.gnu.org/licenses/>. --
kono
parents:
diff changeset
26 -- --
kono
parents:
diff changeset
27 -- GNAT was originally developed by the GNAT team at New York University. --
kono
parents:
diff changeset
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
kono
parents:
diff changeset
29 -- --
kono
parents:
diff changeset
30 ------------------------------------------------------------------------------
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 with Ada.Strings.Wide_Wide_Search;
kono
parents:
diff changeset
33 with Ada.Unchecked_Deallocation;
kono
parents:
diff changeset
34
kono
parents:
diff changeset
35 package body Ada.Strings.Wide_Wide_Unbounded is
kono
parents:
diff changeset
36
kono
parents:
diff changeset
37 use Ada.Strings.Wide_Wide_Maps;
kono
parents:
diff changeset
38
kono
parents:
diff changeset
39 Growth_Factor : constant := 32;
kono
parents:
diff changeset
40 -- The growth factor controls how much extra space is allocated when
kono
parents:
diff changeset
41 -- we have to increase the size of an allocated unbounded string. By
kono
parents:
diff changeset
42 -- allocating extra space, we avoid the need to reallocate on every
kono
parents:
diff changeset
43 -- append, particularly important when a string is built up by repeated
kono
parents:
diff changeset
44 -- append operations of small pieces. This is expressed as a factor so
kono
parents:
diff changeset
45 -- 32 means add 1/32 of the length of the string as growth space.
kono
parents:
diff changeset
46
kono
parents:
diff changeset
47 Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
kono
parents:
diff changeset
48 -- Allocation will be done by a multiple of Min_Mul_Alloc. This causes
kono
parents:
diff changeset
49 -- no memory loss as most (all?) malloc implementations are obliged to
kono
parents:
diff changeset
50 -- align the returned memory on the maximum alignment as malloc does not
kono
parents:
diff changeset
51 -- know the target alignment.
kono
parents:
diff changeset
52
kono
parents:
diff changeset
53 function Aligned_Max_Length (Max_Length : Natural) return Natural;
kono
parents:
diff changeset
54 -- Returns recommended length of the shared string which is greater or
kono
parents:
diff changeset
55 -- equal to specified length. Calculation take in sense alignment of
kono
parents:
diff changeset
56 -- the allocated memory segments to use memory effectively by
kono
parents:
diff changeset
57 -- Append/Insert/etc operations.
kono
parents:
diff changeset
58
kono
parents:
diff changeset
59 ---------
kono
parents:
diff changeset
60 -- "&" --
kono
parents:
diff changeset
61 ---------
kono
parents:
diff changeset
62
kono
parents:
diff changeset
63 function "&"
kono
parents:
diff changeset
64 (Left : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
65 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
66 is
kono
parents:
diff changeset
67 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
kono
parents:
diff changeset
68 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
69 DL : constant Natural := LR.Last + RR.Last;
kono
parents:
diff changeset
70 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
71
kono
parents:
diff changeset
72 begin
kono
parents:
diff changeset
73 -- Result is an empty string, reuse shared empty string
kono
parents:
diff changeset
74
kono
parents:
diff changeset
75 if DL = 0 then
kono
parents:
diff changeset
76 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
77 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
78
kono
parents:
diff changeset
79 -- Left string is empty, return Rigth string
kono
parents:
diff changeset
80
kono
parents:
diff changeset
81 elsif LR.Last = 0 then
kono
parents:
diff changeset
82 Reference (RR);
kono
parents:
diff changeset
83 DR := RR;
kono
parents:
diff changeset
84
kono
parents:
diff changeset
85 -- Right string is empty, return Left string
kono
parents:
diff changeset
86
kono
parents:
diff changeset
87 elsif RR.Last = 0 then
kono
parents:
diff changeset
88 Reference (LR);
kono
parents:
diff changeset
89 DR := LR;
kono
parents:
diff changeset
90
kono
parents:
diff changeset
91 -- Overwise, allocate new shared string and fill data
kono
parents:
diff changeset
92
kono
parents:
diff changeset
93 else
kono
parents:
diff changeset
94 DR := Allocate (DL);
kono
parents:
diff changeset
95 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
kono
parents:
diff changeset
96 DR.Data (LR.Last + 1 .. DL) := RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
97 DR.Last := DL;
kono
parents:
diff changeset
98 end if;
kono
parents:
diff changeset
99
kono
parents:
diff changeset
100 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
101 end "&";
kono
parents:
diff changeset
102
kono
parents:
diff changeset
103 function "&"
kono
parents:
diff changeset
104 (Left : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
105 Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
106 is
kono
parents:
diff changeset
107 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
kono
parents:
diff changeset
108 DL : constant Natural := LR.Last + Right'Length;
kono
parents:
diff changeset
109 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
110
kono
parents:
diff changeset
111 begin
kono
parents:
diff changeset
112 -- Result is an empty string, reuse shared empty string
kono
parents:
diff changeset
113
kono
parents:
diff changeset
114 if DL = 0 then
kono
parents:
diff changeset
115 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
116 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
117
kono
parents:
diff changeset
118 -- Right is an empty string, return Left string
kono
parents:
diff changeset
119
kono
parents:
diff changeset
120 elsif Right'Length = 0 then
kono
parents:
diff changeset
121 Reference (LR);
kono
parents:
diff changeset
122 DR := LR;
kono
parents:
diff changeset
123
kono
parents:
diff changeset
124 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
125
kono
parents:
diff changeset
126 else
kono
parents:
diff changeset
127 DR := Allocate (DL);
kono
parents:
diff changeset
128 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
kono
parents:
diff changeset
129 DR.Data (LR.Last + 1 .. DL) := Right;
kono
parents:
diff changeset
130 DR.Last := DL;
kono
parents:
diff changeset
131 end if;
kono
parents:
diff changeset
132
kono
parents:
diff changeset
133 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
134 end "&";
kono
parents:
diff changeset
135
kono
parents:
diff changeset
136 function "&"
kono
parents:
diff changeset
137 (Left : Wide_Wide_String;
kono
parents:
diff changeset
138 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
139 is
kono
parents:
diff changeset
140 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
141 DL : constant Natural := Left'Length + RR.Last;
kono
parents:
diff changeset
142 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
143
kono
parents:
diff changeset
144 begin
kono
parents:
diff changeset
145 -- Result is an empty string, reuse shared one
kono
parents:
diff changeset
146
kono
parents:
diff changeset
147 if DL = 0 then
kono
parents:
diff changeset
148 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
149 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
150
kono
parents:
diff changeset
151 -- Left is empty string, return Right string
kono
parents:
diff changeset
152
kono
parents:
diff changeset
153 elsif Left'Length = 0 then
kono
parents:
diff changeset
154 Reference (RR);
kono
parents:
diff changeset
155 DR := RR;
kono
parents:
diff changeset
156
kono
parents:
diff changeset
157 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
158
kono
parents:
diff changeset
159 else
kono
parents:
diff changeset
160 DR := Allocate (DL);
kono
parents:
diff changeset
161 DR.Data (1 .. Left'Length) := Left;
kono
parents:
diff changeset
162 DR.Data (Left'Length + 1 .. DL) := RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
163 DR.Last := DL;
kono
parents:
diff changeset
164 end if;
kono
parents:
diff changeset
165
kono
parents:
diff changeset
166 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
167 end "&";
kono
parents:
diff changeset
168
kono
parents:
diff changeset
169 function "&"
kono
parents:
diff changeset
170 (Left : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
171 Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
172 is
kono
parents:
diff changeset
173 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
kono
parents:
diff changeset
174 DL : constant Natural := LR.Last + 1;
kono
parents:
diff changeset
175 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
176
kono
parents:
diff changeset
177 begin
kono
parents:
diff changeset
178 DR := Allocate (DL);
kono
parents:
diff changeset
179 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
kono
parents:
diff changeset
180 DR.Data (DL) := Right;
kono
parents:
diff changeset
181 DR.Last := DL;
kono
parents:
diff changeset
182
kono
parents:
diff changeset
183 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
184 end "&";
kono
parents:
diff changeset
185
kono
parents:
diff changeset
186 function "&"
kono
parents:
diff changeset
187 (Left : Wide_Wide_Character;
kono
parents:
diff changeset
188 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
189 is
kono
parents:
diff changeset
190 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
191 DL : constant Natural := 1 + RR.Last;
kono
parents:
diff changeset
192 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
193
kono
parents:
diff changeset
194 begin
kono
parents:
diff changeset
195 DR := Allocate (DL);
kono
parents:
diff changeset
196 DR.Data (1) := Left;
kono
parents:
diff changeset
197 DR.Data (2 .. DL) := RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
198 DR.Last := DL;
kono
parents:
diff changeset
199
kono
parents:
diff changeset
200 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
201 end "&";
kono
parents:
diff changeset
202
kono
parents:
diff changeset
203 ---------
kono
parents:
diff changeset
204 -- "*" --
kono
parents:
diff changeset
205 ---------
kono
parents:
diff changeset
206
kono
parents:
diff changeset
207 function "*"
kono
parents:
diff changeset
208 (Left : Natural;
kono
parents:
diff changeset
209 Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
210 is
kono
parents:
diff changeset
211 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
212
kono
parents:
diff changeset
213 begin
kono
parents:
diff changeset
214 -- Result is an empty string, reuse shared empty string
kono
parents:
diff changeset
215
kono
parents:
diff changeset
216 if Left = 0 then
kono
parents:
diff changeset
217 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
218 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
219
kono
parents:
diff changeset
220 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
221
kono
parents:
diff changeset
222 else
kono
parents:
diff changeset
223 DR := Allocate (Left);
kono
parents:
diff changeset
224
kono
parents:
diff changeset
225 for J in 1 .. Left loop
kono
parents:
diff changeset
226 DR.Data (J) := Right;
kono
parents:
diff changeset
227 end loop;
kono
parents:
diff changeset
228
kono
parents:
diff changeset
229 DR.Last := Left;
kono
parents:
diff changeset
230 end if;
kono
parents:
diff changeset
231
kono
parents:
diff changeset
232 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
233 end "*";
kono
parents:
diff changeset
234
kono
parents:
diff changeset
235 function "*"
kono
parents:
diff changeset
236 (Left : Natural;
kono
parents:
diff changeset
237 Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
238 is
kono
parents:
diff changeset
239 DL : constant Natural := Left * Right'Length;
kono
parents:
diff changeset
240 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
241 K : Positive;
kono
parents:
diff changeset
242
kono
parents:
diff changeset
243 begin
kono
parents:
diff changeset
244 -- Result is an empty string, reuse shared empty string
kono
parents:
diff changeset
245
kono
parents:
diff changeset
246 if DL = 0 then
kono
parents:
diff changeset
247 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
248 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
249
kono
parents:
diff changeset
250 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
251
kono
parents:
diff changeset
252 else
kono
parents:
diff changeset
253 DR := Allocate (DL);
kono
parents:
diff changeset
254 K := 1;
kono
parents:
diff changeset
255
kono
parents:
diff changeset
256 for J in 1 .. Left loop
kono
parents:
diff changeset
257 DR.Data (K .. K + Right'Length - 1) := Right;
kono
parents:
diff changeset
258 K := K + Right'Length;
kono
parents:
diff changeset
259 end loop;
kono
parents:
diff changeset
260
kono
parents:
diff changeset
261 DR.Last := DL;
kono
parents:
diff changeset
262 end if;
kono
parents:
diff changeset
263
kono
parents:
diff changeset
264 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
265 end "*";
kono
parents:
diff changeset
266
kono
parents:
diff changeset
267 function "*"
kono
parents:
diff changeset
268 (Left : Natural;
kono
parents:
diff changeset
269 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
270 is
kono
parents:
diff changeset
271 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
272 DL : constant Natural := Left * RR.Last;
kono
parents:
diff changeset
273 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
274 K : Positive;
kono
parents:
diff changeset
275
kono
parents:
diff changeset
276 begin
kono
parents:
diff changeset
277 -- Result is an empty string, reuse shared empty string
kono
parents:
diff changeset
278
kono
parents:
diff changeset
279 if DL = 0 then
kono
parents:
diff changeset
280 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
281 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
282
kono
parents:
diff changeset
283 -- Coefficient is one, just return string itself
kono
parents:
diff changeset
284
kono
parents:
diff changeset
285 elsif Left = 1 then
kono
parents:
diff changeset
286 Reference (RR);
kono
parents:
diff changeset
287 DR := RR;
kono
parents:
diff changeset
288
kono
parents:
diff changeset
289 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
290
kono
parents:
diff changeset
291 else
kono
parents:
diff changeset
292 DR := Allocate (DL);
kono
parents:
diff changeset
293 K := 1;
kono
parents:
diff changeset
294
kono
parents:
diff changeset
295 for J in 1 .. Left loop
kono
parents:
diff changeset
296 DR.Data (K .. K + RR.Last - 1) := RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
297 K := K + RR.Last;
kono
parents:
diff changeset
298 end loop;
kono
parents:
diff changeset
299
kono
parents:
diff changeset
300 DR.Last := DL;
kono
parents:
diff changeset
301 end if;
kono
parents:
diff changeset
302
kono
parents:
diff changeset
303 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
304 end "*";
kono
parents:
diff changeset
305
kono
parents:
diff changeset
306 ---------
kono
parents:
diff changeset
307 -- "<" --
kono
parents:
diff changeset
308 ---------
kono
parents:
diff changeset
309
kono
parents:
diff changeset
310 function "<"
kono
parents:
diff changeset
311 (Left : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
312 Right : Unbounded_Wide_Wide_String) return Boolean
kono
parents:
diff changeset
313 is
kono
parents:
diff changeset
314 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
kono
parents:
diff changeset
315 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
316 begin
kono
parents:
diff changeset
317 return LR.Data (1 .. LR.Last) < RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
318 end "<";
kono
parents:
diff changeset
319
kono
parents:
diff changeset
320 function "<"
kono
parents:
diff changeset
321 (Left : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
322 Right : Wide_Wide_String) return Boolean
kono
parents:
diff changeset
323 is
kono
parents:
diff changeset
324 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
kono
parents:
diff changeset
325 begin
kono
parents:
diff changeset
326 return LR.Data (1 .. LR.Last) < Right;
kono
parents:
diff changeset
327 end "<";
kono
parents:
diff changeset
328
kono
parents:
diff changeset
329 function "<"
kono
parents:
diff changeset
330 (Left : Wide_Wide_String;
kono
parents:
diff changeset
331 Right : Unbounded_Wide_Wide_String) return Boolean
kono
parents:
diff changeset
332 is
kono
parents:
diff changeset
333 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
334 begin
kono
parents:
diff changeset
335 return Left < RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
336 end "<";
kono
parents:
diff changeset
337
kono
parents:
diff changeset
338 ----------
kono
parents:
diff changeset
339 -- "<=" --
kono
parents:
diff changeset
340 ----------
kono
parents:
diff changeset
341
kono
parents:
diff changeset
342 function "<="
kono
parents:
diff changeset
343 (Left : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
344 Right : Unbounded_Wide_Wide_String) return Boolean
kono
parents:
diff changeset
345 is
kono
parents:
diff changeset
346 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
kono
parents:
diff changeset
347 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
348
kono
parents:
diff changeset
349 begin
kono
parents:
diff changeset
350 -- LR = RR means two strings shares shared string, thus they are equal
kono
parents:
diff changeset
351
kono
parents:
diff changeset
352 return LR = RR or else LR.Data (1 .. LR.Last) <= RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
353 end "<=";
kono
parents:
diff changeset
354
kono
parents:
diff changeset
355 function "<="
kono
parents:
diff changeset
356 (Left : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
357 Right : Wide_Wide_String) return Boolean
kono
parents:
diff changeset
358 is
kono
parents:
diff changeset
359 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
kono
parents:
diff changeset
360 begin
kono
parents:
diff changeset
361 return LR.Data (1 .. LR.Last) <= Right;
kono
parents:
diff changeset
362 end "<=";
kono
parents:
diff changeset
363
kono
parents:
diff changeset
364 function "<="
kono
parents:
diff changeset
365 (Left : Wide_Wide_String;
kono
parents:
diff changeset
366 Right : Unbounded_Wide_Wide_String) return Boolean
kono
parents:
diff changeset
367 is
kono
parents:
diff changeset
368 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
369 begin
kono
parents:
diff changeset
370 return Left <= RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
371 end "<=";
kono
parents:
diff changeset
372
kono
parents:
diff changeset
373 ---------
kono
parents:
diff changeset
374 -- "=" --
kono
parents:
diff changeset
375 ---------
kono
parents:
diff changeset
376
kono
parents:
diff changeset
377 function "="
kono
parents:
diff changeset
378 (Left : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
379 Right : Unbounded_Wide_Wide_String) return Boolean
kono
parents:
diff changeset
380 is
kono
parents:
diff changeset
381 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
kono
parents:
diff changeset
382 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
383
kono
parents:
diff changeset
384 begin
kono
parents:
diff changeset
385 return LR = RR or else LR.Data (1 .. LR.Last) = RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
386 -- LR = RR means two strings shares shared string, thus they are equal
kono
parents:
diff changeset
387 end "=";
kono
parents:
diff changeset
388
kono
parents:
diff changeset
389 function "="
kono
parents:
diff changeset
390 (Left : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
391 Right : Wide_Wide_String) return Boolean
kono
parents:
diff changeset
392 is
kono
parents:
diff changeset
393 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
kono
parents:
diff changeset
394 begin
kono
parents:
diff changeset
395 return LR.Data (1 .. LR.Last) = Right;
kono
parents:
diff changeset
396 end "=";
kono
parents:
diff changeset
397
kono
parents:
diff changeset
398 function "="
kono
parents:
diff changeset
399 (Left : Wide_Wide_String;
kono
parents:
diff changeset
400 Right : Unbounded_Wide_Wide_String) return Boolean
kono
parents:
diff changeset
401 is
kono
parents:
diff changeset
402 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
403 begin
kono
parents:
diff changeset
404 return Left = RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
405 end "=";
kono
parents:
diff changeset
406
kono
parents:
diff changeset
407 ---------
kono
parents:
diff changeset
408 -- ">" --
kono
parents:
diff changeset
409 ---------
kono
parents:
diff changeset
410
kono
parents:
diff changeset
411 function ">"
kono
parents:
diff changeset
412 (Left : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
413 Right : Unbounded_Wide_Wide_String) return Boolean
kono
parents:
diff changeset
414 is
kono
parents:
diff changeset
415 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
kono
parents:
diff changeset
416 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
417 begin
kono
parents:
diff changeset
418 return LR.Data (1 .. LR.Last) > RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
419 end ">";
kono
parents:
diff changeset
420
kono
parents:
diff changeset
421 function ">"
kono
parents:
diff changeset
422 (Left : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
423 Right : Wide_Wide_String) return Boolean
kono
parents:
diff changeset
424 is
kono
parents:
diff changeset
425 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
kono
parents:
diff changeset
426 begin
kono
parents:
diff changeset
427 return LR.Data (1 .. LR.Last) > Right;
kono
parents:
diff changeset
428 end ">";
kono
parents:
diff changeset
429
kono
parents:
diff changeset
430 function ">"
kono
parents:
diff changeset
431 (Left : Wide_Wide_String;
kono
parents:
diff changeset
432 Right : Unbounded_Wide_Wide_String) return Boolean
kono
parents:
diff changeset
433 is
kono
parents:
diff changeset
434 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
435 begin
kono
parents:
diff changeset
436 return Left > RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
437 end ">";
kono
parents:
diff changeset
438
kono
parents:
diff changeset
439 ----------
kono
parents:
diff changeset
440 -- ">=" --
kono
parents:
diff changeset
441 ----------
kono
parents:
diff changeset
442
kono
parents:
diff changeset
443 function ">="
kono
parents:
diff changeset
444 (Left : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
445 Right : Unbounded_Wide_Wide_String) return Boolean
kono
parents:
diff changeset
446 is
kono
parents:
diff changeset
447 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
kono
parents:
diff changeset
448 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
449
kono
parents:
diff changeset
450 begin
kono
parents:
diff changeset
451 -- LR = RR means two strings shares shared string, thus they are equal
kono
parents:
diff changeset
452
kono
parents:
diff changeset
453 return LR = RR or else LR.Data (1 .. LR.Last) >= RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
454 end ">=";
kono
parents:
diff changeset
455
kono
parents:
diff changeset
456 function ">="
kono
parents:
diff changeset
457 (Left : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
458 Right : Wide_Wide_String) return Boolean
kono
parents:
diff changeset
459 is
kono
parents:
diff changeset
460 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
kono
parents:
diff changeset
461 begin
kono
parents:
diff changeset
462 return LR.Data (1 .. LR.Last) >= Right;
kono
parents:
diff changeset
463 end ">=";
kono
parents:
diff changeset
464
kono
parents:
diff changeset
465 function ">="
kono
parents:
diff changeset
466 (Left : Wide_Wide_String;
kono
parents:
diff changeset
467 Right : Unbounded_Wide_Wide_String) return Boolean
kono
parents:
diff changeset
468 is
kono
parents:
diff changeset
469 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
kono
parents:
diff changeset
470 begin
kono
parents:
diff changeset
471 return Left >= RR.Data (1 .. RR.Last);
kono
parents:
diff changeset
472 end ">=";
kono
parents:
diff changeset
473
kono
parents:
diff changeset
474 ------------
kono
parents:
diff changeset
475 -- Adjust --
kono
parents:
diff changeset
476 ------------
kono
parents:
diff changeset
477
kono
parents:
diff changeset
478 procedure Adjust (Object : in out Unbounded_Wide_Wide_String) is
kono
parents:
diff changeset
479 begin
kono
parents:
diff changeset
480 Reference (Object.Reference);
kono
parents:
diff changeset
481 end Adjust;
kono
parents:
diff changeset
482
kono
parents:
diff changeset
483 ------------------------
kono
parents:
diff changeset
484 -- Aligned_Max_Length --
kono
parents:
diff changeset
485 ------------------------
kono
parents:
diff changeset
486
kono
parents:
diff changeset
487 function Aligned_Max_Length (Max_Length : Natural) return Natural is
kono
parents:
diff changeset
488 Static_Size : constant Natural :=
kono
parents:
diff changeset
489 Empty_Shared_Wide_Wide_String'Size / Standard'Storage_Unit;
kono
parents:
diff changeset
490 -- Total size of all static components
kono
parents:
diff changeset
491
kono
parents:
diff changeset
492 Element_Size : constant Natural :=
kono
parents:
diff changeset
493 Wide_Wide_Character'Size / Standard'Storage_Unit;
kono
parents:
diff changeset
494
kono
parents:
diff changeset
495 begin
kono
parents:
diff changeset
496 return
kono
parents:
diff changeset
497 (((Static_Size + Max_Length * Element_Size - 1) / Min_Mul_Alloc + 2)
kono
parents:
diff changeset
498 * Min_Mul_Alloc - Static_Size) / Element_Size;
kono
parents:
diff changeset
499 end Aligned_Max_Length;
kono
parents:
diff changeset
500
kono
parents:
diff changeset
501 --------------
kono
parents:
diff changeset
502 -- Allocate --
kono
parents:
diff changeset
503 --------------
kono
parents:
diff changeset
504
kono
parents:
diff changeset
505 function Allocate
kono
parents:
diff changeset
506 (Max_Length : Natural) return Shared_Wide_Wide_String_Access is
kono
parents:
diff changeset
507 begin
kono
parents:
diff changeset
508 -- Empty string requested, return shared empty string
kono
parents:
diff changeset
509
kono
parents:
diff changeset
510 if Max_Length = 0 then
kono
parents:
diff changeset
511 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
512 return Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
513
kono
parents:
diff changeset
514 -- Otherwise, allocate requested space (and probably some more room)
kono
parents:
diff changeset
515
kono
parents:
diff changeset
516 else
kono
parents:
diff changeset
517 return new Shared_Wide_Wide_String (Aligned_Max_Length (Max_Length));
kono
parents:
diff changeset
518 end if;
kono
parents:
diff changeset
519 end Allocate;
kono
parents:
diff changeset
520
kono
parents:
diff changeset
521 ------------
kono
parents:
diff changeset
522 -- Append --
kono
parents:
diff changeset
523 ------------
kono
parents:
diff changeset
524
kono
parents:
diff changeset
525 procedure Append
kono
parents:
diff changeset
526 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
527 New_Item : Unbounded_Wide_Wide_String)
kono
parents:
diff changeset
528 is
kono
parents:
diff changeset
529 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
530 NR : constant Shared_Wide_Wide_String_Access := New_Item.Reference;
kono
parents:
diff changeset
531 DL : constant Natural := SR.Last + NR.Last;
kono
parents:
diff changeset
532 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
533
kono
parents:
diff changeset
534 begin
kono
parents:
diff changeset
535 -- Source is an empty string, reuse New_Item data
kono
parents:
diff changeset
536
kono
parents:
diff changeset
537 if SR.Last = 0 then
kono
parents:
diff changeset
538 Reference (NR);
kono
parents:
diff changeset
539 Source.Reference := NR;
kono
parents:
diff changeset
540 Unreference (SR);
kono
parents:
diff changeset
541
kono
parents:
diff changeset
542 -- New_Item is empty string, nothing to do
kono
parents:
diff changeset
543
kono
parents:
diff changeset
544 elsif NR.Last = 0 then
kono
parents:
diff changeset
545 null;
kono
parents:
diff changeset
546
kono
parents:
diff changeset
547 -- Try to reuse existent shared string
kono
parents:
diff changeset
548
kono
parents:
diff changeset
549 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
550 SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
kono
parents:
diff changeset
551 SR.Last := DL;
kono
parents:
diff changeset
552
kono
parents:
diff changeset
553 -- Otherwise, allocate new one and fill it
kono
parents:
diff changeset
554
kono
parents:
diff changeset
555 else
kono
parents:
diff changeset
556 DR := Allocate (DL + DL / Growth_Factor);
kono
parents:
diff changeset
557 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
558 DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
kono
parents:
diff changeset
559 DR.Last := DL;
kono
parents:
diff changeset
560 Source.Reference := DR;
kono
parents:
diff changeset
561 Unreference (SR);
kono
parents:
diff changeset
562 end if;
kono
parents:
diff changeset
563 end Append;
kono
parents:
diff changeset
564
kono
parents:
diff changeset
565 procedure Append
kono
parents:
diff changeset
566 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
567 New_Item : Wide_Wide_String)
kono
parents:
diff changeset
568 is
kono
parents:
diff changeset
569 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
570 DL : constant Natural := SR.Last + New_Item'Length;
kono
parents:
diff changeset
571 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
572
kono
parents:
diff changeset
573 begin
kono
parents:
diff changeset
574 -- New_Item is an empty string, nothing to do
kono
parents:
diff changeset
575
kono
parents:
diff changeset
576 if New_Item'Length = 0 then
kono
parents:
diff changeset
577 null;
kono
parents:
diff changeset
578
kono
parents:
diff changeset
579 -- Try to reuse existing shared string
kono
parents:
diff changeset
580
kono
parents:
diff changeset
581 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
582 SR.Data (SR.Last + 1 .. DL) := New_Item;
kono
parents:
diff changeset
583 SR.Last := DL;
kono
parents:
diff changeset
584
kono
parents:
diff changeset
585 -- Otherwise, allocate new one and fill it
kono
parents:
diff changeset
586
kono
parents:
diff changeset
587 else
kono
parents:
diff changeset
588 DR := Allocate (DL + DL / Growth_Factor);
kono
parents:
diff changeset
589 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
590 DR.Data (SR.Last + 1 .. DL) := New_Item;
kono
parents:
diff changeset
591 DR.Last := DL;
kono
parents:
diff changeset
592 Source.Reference := DR;
kono
parents:
diff changeset
593 Unreference (SR);
kono
parents:
diff changeset
594 end if;
kono
parents:
diff changeset
595 end Append;
kono
parents:
diff changeset
596
kono
parents:
diff changeset
597 procedure Append
kono
parents:
diff changeset
598 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
599 New_Item : Wide_Wide_Character)
kono
parents:
diff changeset
600 is
kono
parents:
diff changeset
601 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
602 DL : constant Natural := SR.Last + 1;
kono
parents:
diff changeset
603 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
604
kono
parents:
diff changeset
605 begin
kono
parents:
diff changeset
606 -- Try to reuse existing shared string
kono
parents:
diff changeset
607
kono
parents:
diff changeset
608 if Can_Be_Reused (SR, SR.Last + 1) then
kono
parents:
diff changeset
609 SR.Data (SR.Last + 1) := New_Item;
kono
parents:
diff changeset
610 SR.Last := SR.Last + 1;
kono
parents:
diff changeset
611
kono
parents:
diff changeset
612 -- Otherwise, allocate new one and fill it
kono
parents:
diff changeset
613
kono
parents:
diff changeset
614 else
kono
parents:
diff changeset
615 DR := Allocate (DL + DL / Growth_Factor);
kono
parents:
diff changeset
616 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
617 DR.Data (DL) := New_Item;
kono
parents:
diff changeset
618 DR.Last := DL;
kono
parents:
diff changeset
619 Source.Reference := DR;
kono
parents:
diff changeset
620 Unreference (SR);
kono
parents:
diff changeset
621 end if;
kono
parents:
diff changeset
622 end Append;
kono
parents:
diff changeset
623
kono
parents:
diff changeset
624 -------------------
kono
parents:
diff changeset
625 -- Can_Be_Reused --
kono
parents:
diff changeset
626 -------------------
kono
parents:
diff changeset
627
kono
parents:
diff changeset
628 function Can_Be_Reused
kono
parents:
diff changeset
629 (Item : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
630 Length : Natural) return Boolean is
kono
parents:
diff changeset
631 begin
kono
parents:
diff changeset
632 return
kono
parents:
diff changeset
633 System.Atomic_Counters.Is_One (Item.Counter)
kono
parents:
diff changeset
634 and then Item.Max_Length >= Length
kono
parents:
diff changeset
635 and then Item.Max_Length <=
kono
parents:
diff changeset
636 Aligned_Max_Length (Length + Length / Growth_Factor);
kono
parents:
diff changeset
637 end Can_Be_Reused;
kono
parents:
diff changeset
638
kono
parents:
diff changeset
639 -----------
kono
parents:
diff changeset
640 -- Count --
kono
parents:
diff changeset
641 -----------
kono
parents:
diff changeset
642
kono
parents:
diff changeset
643 function Count
kono
parents:
diff changeset
644 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
645 Pattern : Wide_Wide_String;
kono
parents:
diff changeset
646 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
kono
parents:
diff changeset
647 Wide_Wide_Maps.Identity) return Natural
kono
parents:
diff changeset
648 is
kono
parents:
diff changeset
649 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
650 begin
kono
parents:
diff changeset
651 return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
kono
parents:
diff changeset
652 end Count;
kono
parents:
diff changeset
653
kono
parents:
diff changeset
654 function Count
kono
parents:
diff changeset
655 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
656 Pattern : Wide_Wide_String;
kono
parents:
diff changeset
657 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
kono
parents:
diff changeset
658 return Natural
kono
parents:
diff changeset
659 is
kono
parents:
diff changeset
660 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
661 begin
kono
parents:
diff changeset
662 return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
kono
parents:
diff changeset
663 end Count;
kono
parents:
diff changeset
664
kono
parents:
diff changeset
665 function Count
kono
parents:
diff changeset
666 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
667 Set : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
kono
parents:
diff changeset
668 is
kono
parents:
diff changeset
669 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
670 begin
kono
parents:
diff changeset
671 return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Set);
kono
parents:
diff changeset
672 end Count;
kono
parents:
diff changeset
673
kono
parents:
diff changeset
674 ------------
kono
parents:
diff changeset
675 -- Delete --
kono
parents:
diff changeset
676 ------------
kono
parents:
diff changeset
677
kono
parents:
diff changeset
678 function Delete
kono
parents:
diff changeset
679 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
680 From : Positive;
kono
parents:
diff changeset
681 Through : Natural) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
682 is
kono
parents:
diff changeset
683 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
684 DL : Natural;
kono
parents:
diff changeset
685 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
686
kono
parents:
diff changeset
687 begin
kono
parents:
diff changeset
688 -- Empty slice is deleted, use the same shared string
kono
parents:
diff changeset
689
kono
parents:
diff changeset
690 if From > Through then
kono
parents:
diff changeset
691 Reference (SR);
kono
parents:
diff changeset
692 DR := SR;
kono
parents:
diff changeset
693
kono
parents:
diff changeset
694 -- Index is out of range
kono
parents:
diff changeset
695
kono
parents:
diff changeset
696 elsif Through > SR.Last then
kono
parents:
diff changeset
697 raise Index_Error;
kono
parents:
diff changeset
698
kono
parents:
diff changeset
699 -- Compute size of the result
kono
parents:
diff changeset
700
kono
parents:
diff changeset
701 else
kono
parents:
diff changeset
702 DL := SR.Last - (Through - From + 1);
kono
parents:
diff changeset
703
kono
parents:
diff changeset
704 -- Result is an empty string, reuse shared empty string
kono
parents:
diff changeset
705
kono
parents:
diff changeset
706 if DL = 0 then
kono
parents:
diff changeset
707 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
708 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
709
kono
parents:
diff changeset
710 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
711
kono
parents:
diff changeset
712 else
kono
parents:
diff changeset
713 DR := Allocate (DL);
kono
parents:
diff changeset
714 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
kono
parents:
diff changeset
715 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
kono
parents:
diff changeset
716 DR.Last := DL;
kono
parents:
diff changeset
717 end if;
kono
parents:
diff changeset
718 end if;
kono
parents:
diff changeset
719
kono
parents:
diff changeset
720 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
721 end Delete;
kono
parents:
diff changeset
722
kono
parents:
diff changeset
723 procedure Delete
kono
parents:
diff changeset
724 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
725 From : Positive;
kono
parents:
diff changeset
726 Through : Natural)
kono
parents:
diff changeset
727 is
kono
parents:
diff changeset
728 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
729 DL : Natural;
kono
parents:
diff changeset
730 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
731
kono
parents:
diff changeset
732 begin
kono
parents:
diff changeset
733 -- Nothing changed, return
kono
parents:
diff changeset
734
kono
parents:
diff changeset
735 if From > Through then
kono
parents:
diff changeset
736 null;
kono
parents:
diff changeset
737
kono
parents:
diff changeset
738 -- Through is outside of the range
kono
parents:
diff changeset
739
kono
parents:
diff changeset
740 elsif Through > SR.Last then
kono
parents:
diff changeset
741 raise Index_Error;
kono
parents:
diff changeset
742
kono
parents:
diff changeset
743 else
kono
parents:
diff changeset
744 DL := SR.Last - (Through - From + 1);
kono
parents:
diff changeset
745
kono
parents:
diff changeset
746 -- Result is empty, reuse shared empty string
kono
parents:
diff changeset
747
kono
parents:
diff changeset
748 if DL = 0 then
kono
parents:
diff changeset
749 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
750 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
751 Unreference (SR);
kono
parents:
diff changeset
752
kono
parents:
diff changeset
753 -- Try to reuse existent shared string
kono
parents:
diff changeset
754
kono
parents:
diff changeset
755 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
756 SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
kono
parents:
diff changeset
757 SR.Last := DL;
kono
parents:
diff changeset
758
kono
parents:
diff changeset
759 -- Otherwise, allocate new shared string
kono
parents:
diff changeset
760
kono
parents:
diff changeset
761 else
kono
parents:
diff changeset
762 DR := Allocate (DL);
kono
parents:
diff changeset
763 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
kono
parents:
diff changeset
764 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
kono
parents:
diff changeset
765 DR.Last := DL;
kono
parents:
diff changeset
766 Source.Reference := DR;
kono
parents:
diff changeset
767 Unreference (SR);
kono
parents:
diff changeset
768 end if;
kono
parents:
diff changeset
769 end if;
kono
parents:
diff changeset
770 end Delete;
kono
parents:
diff changeset
771
kono
parents:
diff changeset
772 -------------
kono
parents:
diff changeset
773 -- Element --
kono
parents:
diff changeset
774 -------------
kono
parents:
diff changeset
775
kono
parents:
diff changeset
776 function Element
kono
parents:
diff changeset
777 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
778 Index : Positive) return Wide_Wide_Character
kono
parents:
diff changeset
779 is
kono
parents:
diff changeset
780 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
781 begin
kono
parents:
diff changeset
782 if Index <= SR.Last then
kono
parents:
diff changeset
783 return SR.Data (Index);
kono
parents:
diff changeset
784 else
kono
parents:
diff changeset
785 raise Index_Error;
kono
parents:
diff changeset
786 end if;
kono
parents:
diff changeset
787 end Element;
kono
parents:
diff changeset
788
kono
parents:
diff changeset
789 --------------
kono
parents:
diff changeset
790 -- Finalize --
kono
parents:
diff changeset
791 --------------
kono
parents:
diff changeset
792
kono
parents:
diff changeset
793 procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is
kono
parents:
diff changeset
794 SR : constant Shared_Wide_Wide_String_Access := Object.Reference;
kono
parents:
diff changeset
795
kono
parents:
diff changeset
796 begin
kono
parents:
diff changeset
797 if SR /= null then
kono
parents:
diff changeset
798
kono
parents:
diff changeset
799 -- The same controlled object can be finalized several times for
kono
parents:
diff changeset
800 -- some reason. As per 7.6.1(24) this should have no ill effect,
kono
parents:
diff changeset
801 -- so we need to add a guard for the case of finalizing the same
kono
parents:
diff changeset
802 -- object twice.
kono
parents:
diff changeset
803
kono
parents:
diff changeset
804 Object.Reference := null;
kono
parents:
diff changeset
805 Unreference (SR);
kono
parents:
diff changeset
806 end if;
kono
parents:
diff changeset
807 end Finalize;
kono
parents:
diff changeset
808
kono
parents:
diff changeset
809 ----------------
kono
parents:
diff changeset
810 -- Find_Token --
kono
parents:
diff changeset
811 ----------------
kono
parents:
diff changeset
812
kono
parents:
diff changeset
813 procedure Find_Token
kono
parents:
diff changeset
814 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
815 Set : Wide_Wide_Maps.Wide_Wide_Character_Set;
kono
parents:
diff changeset
816 From : Positive;
kono
parents:
diff changeset
817 Test : Strings.Membership;
kono
parents:
diff changeset
818 First : out Positive;
kono
parents:
diff changeset
819 Last : out Natural)
kono
parents:
diff changeset
820 is
kono
parents:
diff changeset
821 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
822 begin
kono
parents:
diff changeset
823 Wide_Wide_Search.Find_Token
kono
parents:
diff changeset
824 (SR.Data (From .. SR.Last), Set, Test, First, Last);
kono
parents:
diff changeset
825 end Find_Token;
kono
parents:
diff changeset
826
kono
parents:
diff changeset
827 procedure Find_Token
kono
parents:
diff changeset
828 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
829 Set : Wide_Wide_Maps.Wide_Wide_Character_Set;
kono
parents:
diff changeset
830 Test : Strings.Membership;
kono
parents:
diff changeset
831 First : out Positive;
kono
parents:
diff changeset
832 Last : out Natural)
kono
parents:
diff changeset
833 is
kono
parents:
diff changeset
834 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
835 begin
kono
parents:
diff changeset
836 Wide_Wide_Search.Find_Token
kono
parents:
diff changeset
837 (SR.Data (1 .. SR.Last), Set, Test, First, Last);
kono
parents:
diff changeset
838 end Find_Token;
kono
parents:
diff changeset
839
kono
parents:
diff changeset
840 ----------
kono
parents:
diff changeset
841 -- Free --
kono
parents:
diff changeset
842 ----------
kono
parents:
diff changeset
843
kono
parents:
diff changeset
844 procedure Free (X : in out Wide_Wide_String_Access) is
kono
parents:
diff changeset
845 procedure Deallocate is
kono
parents:
diff changeset
846 new Ada.Unchecked_Deallocation
kono
parents:
diff changeset
847 (Wide_Wide_String, Wide_Wide_String_Access);
kono
parents:
diff changeset
848 begin
kono
parents:
diff changeset
849 Deallocate (X);
kono
parents:
diff changeset
850 end Free;
kono
parents:
diff changeset
851
kono
parents:
diff changeset
852 ----------
kono
parents:
diff changeset
853 -- Head --
kono
parents:
diff changeset
854 ----------
kono
parents:
diff changeset
855
kono
parents:
diff changeset
856 function Head
kono
parents:
diff changeset
857 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
858 Count : Natural;
kono
parents:
diff changeset
859 Pad : Wide_Wide_Character := Wide_Wide_Space)
kono
parents:
diff changeset
860 return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
861 is
kono
parents:
diff changeset
862 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
863 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
864
kono
parents:
diff changeset
865 begin
kono
parents:
diff changeset
866 -- Result is empty, reuse shared empty string
kono
parents:
diff changeset
867
kono
parents:
diff changeset
868 if Count = 0 then
kono
parents:
diff changeset
869 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
870 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
871
kono
parents:
diff changeset
872 -- Length of the string is the same as requested, reuse source shared
kono
parents:
diff changeset
873 -- string.
kono
parents:
diff changeset
874
kono
parents:
diff changeset
875 elsif Count = SR.Last then
kono
parents:
diff changeset
876 Reference (SR);
kono
parents:
diff changeset
877 DR := SR;
kono
parents:
diff changeset
878
kono
parents:
diff changeset
879 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
880
kono
parents:
diff changeset
881 else
kono
parents:
diff changeset
882 DR := Allocate (Count);
kono
parents:
diff changeset
883
kono
parents:
diff changeset
884 -- Length of the source string is more than requested, copy
kono
parents:
diff changeset
885 -- corresponding slice.
kono
parents:
diff changeset
886
kono
parents:
diff changeset
887 if Count < SR.Last then
kono
parents:
diff changeset
888 DR.Data (1 .. Count) := SR.Data (1 .. Count);
kono
parents:
diff changeset
889
kono
parents:
diff changeset
890 -- Length of the source string is less than requested, copy all
kono
parents:
diff changeset
891 -- contents and fill others by Pad character.
kono
parents:
diff changeset
892
kono
parents:
diff changeset
893 else
kono
parents:
diff changeset
894 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
895
kono
parents:
diff changeset
896 for J in SR.Last + 1 .. Count loop
kono
parents:
diff changeset
897 DR.Data (J) := Pad;
kono
parents:
diff changeset
898 end loop;
kono
parents:
diff changeset
899 end if;
kono
parents:
diff changeset
900
kono
parents:
diff changeset
901 DR.Last := Count;
kono
parents:
diff changeset
902 end if;
kono
parents:
diff changeset
903
kono
parents:
diff changeset
904 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
905 end Head;
kono
parents:
diff changeset
906
kono
parents:
diff changeset
907 procedure Head
kono
parents:
diff changeset
908 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
909 Count : Natural;
kono
parents:
diff changeset
910 Pad : Wide_Wide_Character := Wide_Wide_Space)
kono
parents:
diff changeset
911 is
kono
parents:
diff changeset
912 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
913 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
914
kono
parents:
diff changeset
915 begin
kono
parents:
diff changeset
916 -- Result is empty, reuse empty shared string
kono
parents:
diff changeset
917
kono
parents:
diff changeset
918 if Count = 0 then
kono
parents:
diff changeset
919 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
920 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
921 Unreference (SR);
kono
parents:
diff changeset
922
kono
parents:
diff changeset
923 -- Result is same with source string, reuse source shared string
kono
parents:
diff changeset
924
kono
parents:
diff changeset
925 elsif Count = SR.Last then
kono
parents:
diff changeset
926 null;
kono
parents:
diff changeset
927
kono
parents:
diff changeset
928 -- Try to reuse existent shared string
kono
parents:
diff changeset
929
kono
parents:
diff changeset
930 elsif Can_Be_Reused (SR, Count) then
kono
parents:
diff changeset
931 if Count > SR.Last then
kono
parents:
diff changeset
932 for J in SR.Last + 1 .. Count loop
kono
parents:
diff changeset
933 SR.Data (J) := Pad;
kono
parents:
diff changeset
934 end loop;
kono
parents:
diff changeset
935 end if;
kono
parents:
diff changeset
936
kono
parents:
diff changeset
937 SR.Last := Count;
kono
parents:
diff changeset
938
kono
parents:
diff changeset
939 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
940
kono
parents:
diff changeset
941 else
kono
parents:
diff changeset
942 DR := Allocate (Count);
kono
parents:
diff changeset
943
kono
parents:
diff changeset
944 -- Length of the source string is greater than requested, copy
kono
parents:
diff changeset
945 -- corresponding slice.
kono
parents:
diff changeset
946
kono
parents:
diff changeset
947 if Count < SR.Last then
kono
parents:
diff changeset
948 DR.Data (1 .. Count) := SR.Data (1 .. Count);
kono
parents:
diff changeset
949
kono
parents:
diff changeset
950 -- Length of the source string is less than requested, copy all
kono
parents:
diff changeset
951 -- exists data and fill others by Pad character.
kono
parents:
diff changeset
952
kono
parents:
diff changeset
953 else
kono
parents:
diff changeset
954 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
955
kono
parents:
diff changeset
956 for J in SR.Last + 1 .. Count loop
kono
parents:
diff changeset
957 DR.Data (J) := Pad;
kono
parents:
diff changeset
958 end loop;
kono
parents:
diff changeset
959 end if;
kono
parents:
diff changeset
960
kono
parents:
diff changeset
961 DR.Last := Count;
kono
parents:
diff changeset
962 Source.Reference := DR;
kono
parents:
diff changeset
963 Unreference (SR);
kono
parents:
diff changeset
964 end if;
kono
parents:
diff changeset
965 end Head;
kono
parents:
diff changeset
966
kono
parents:
diff changeset
967 -----------
kono
parents:
diff changeset
968 -- Index --
kono
parents:
diff changeset
969 -----------
kono
parents:
diff changeset
970
kono
parents:
diff changeset
971 function Index
kono
parents:
diff changeset
972 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
973 Pattern : Wide_Wide_String;
kono
parents:
diff changeset
974 Going : Strings.Direction := Strings.Forward;
kono
parents:
diff changeset
975 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
kono
parents:
diff changeset
976 Wide_Wide_Maps.Identity) return Natural
kono
parents:
diff changeset
977 is
kono
parents:
diff changeset
978 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
979 begin
kono
parents:
diff changeset
980 return Wide_Wide_Search.Index
kono
parents:
diff changeset
981 (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
kono
parents:
diff changeset
982 end Index;
kono
parents:
diff changeset
983
kono
parents:
diff changeset
984 function Index
kono
parents:
diff changeset
985 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
986 Pattern : Wide_Wide_String;
kono
parents:
diff changeset
987 Going : Direction := Forward;
kono
parents:
diff changeset
988 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
kono
parents:
diff changeset
989 return Natural
kono
parents:
diff changeset
990 is
kono
parents:
diff changeset
991 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
992 begin
kono
parents:
diff changeset
993 return Wide_Wide_Search.Index
kono
parents:
diff changeset
994 (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
kono
parents:
diff changeset
995 end Index;
kono
parents:
diff changeset
996
kono
parents:
diff changeset
997 function Index
kono
parents:
diff changeset
998 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
999 Set : Wide_Wide_Maps.Wide_Wide_Character_Set;
kono
parents:
diff changeset
1000 Test : Strings.Membership := Strings.Inside;
kono
parents:
diff changeset
1001 Going : Strings.Direction := Strings.Forward) return Natural
kono
parents:
diff changeset
1002 is
kono
parents:
diff changeset
1003 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1004 begin
kono
parents:
diff changeset
1005 return Wide_Wide_Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going);
kono
parents:
diff changeset
1006 end Index;
kono
parents:
diff changeset
1007
kono
parents:
diff changeset
1008 function Index
kono
parents:
diff changeset
1009 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1010 Pattern : Wide_Wide_String;
kono
parents:
diff changeset
1011 From : Positive;
kono
parents:
diff changeset
1012 Going : Direction := Forward;
kono
parents:
diff changeset
1013 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
kono
parents:
diff changeset
1014 Wide_Wide_Maps.Identity) return Natural
kono
parents:
diff changeset
1015 is
kono
parents:
diff changeset
1016 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1017 begin
kono
parents:
diff changeset
1018 return Wide_Wide_Search.Index
kono
parents:
diff changeset
1019 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
kono
parents:
diff changeset
1020 end Index;
kono
parents:
diff changeset
1021
kono
parents:
diff changeset
1022 function Index
kono
parents:
diff changeset
1023 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1024 Pattern : Wide_Wide_String;
kono
parents:
diff changeset
1025 From : Positive;
kono
parents:
diff changeset
1026 Going : Direction := Forward;
kono
parents:
diff changeset
1027 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
kono
parents:
diff changeset
1028 return Natural
kono
parents:
diff changeset
1029 is
kono
parents:
diff changeset
1030 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1031 begin
kono
parents:
diff changeset
1032 return Wide_Wide_Search.Index
kono
parents:
diff changeset
1033 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
kono
parents:
diff changeset
1034 end Index;
kono
parents:
diff changeset
1035
kono
parents:
diff changeset
1036 function Index
kono
parents:
diff changeset
1037 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1038 Set : Wide_Wide_Maps.Wide_Wide_Character_Set;
kono
parents:
diff changeset
1039 From : Positive;
kono
parents:
diff changeset
1040 Test : Membership := Inside;
kono
parents:
diff changeset
1041 Going : Direction := Forward) return Natural
kono
parents:
diff changeset
1042 is
kono
parents:
diff changeset
1043 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1044 begin
kono
parents:
diff changeset
1045 return Wide_Wide_Search.Index
kono
parents:
diff changeset
1046 (SR.Data (1 .. SR.Last), Set, From, Test, Going);
kono
parents:
diff changeset
1047 end Index;
kono
parents:
diff changeset
1048
kono
parents:
diff changeset
1049 ---------------------
kono
parents:
diff changeset
1050 -- Index_Non_Blank --
kono
parents:
diff changeset
1051 ---------------------
kono
parents:
diff changeset
1052
kono
parents:
diff changeset
1053 function Index_Non_Blank
kono
parents:
diff changeset
1054 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1055 Going : Strings.Direction := Strings.Forward) return Natural
kono
parents:
diff changeset
1056 is
kono
parents:
diff changeset
1057 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1058 begin
kono
parents:
diff changeset
1059 return Wide_Wide_Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going);
kono
parents:
diff changeset
1060 end Index_Non_Blank;
kono
parents:
diff changeset
1061
kono
parents:
diff changeset
1062 function Index_Non_Blank
kono
parents:
diff changeset
1063 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1064 From : Positive;
kono
parents:
diff changeset
1065 Going : Direction := Forward) return Natural
kono
parents:
diff changeset
1066 is
kono
parents:
diff changeset
1067 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1068 begin
kono
parents:
diff changeset
1069 return Wide_Wide_Search.Index_Non_Blank
kono
parents:
diff changeset
1070 (SR.Data (1 .. SR.Last), From, Going);
kono
parents:
diff changeset
1071 end Index_Non_Blank;
kono
parents:
diff changeset
1072
kono
parents:
diff changeset
1073 ----------------
kono
parents:
diff changeset
1074 -- Initialize --
kono
parents:
diff changeset
1075 ----------------
kono
parents:
diff changeset
1076
kono
parents:
diff changeset
1077 procedure Initialize (Object : in out Unbounded_Wide_Wide_String) is
kono
parents:
diff changeset
1078 begin
kono
parents:
diff changeset
1079 Reference (Object.Reference);
kono
parents:
diff changeset
1080 end Initialize;
kono
parents:
diff changeset
1081
kono
parents:
diff changeset
1082 ------------
kono
parents:
diff changeset
1083 -- Insert --
kono
parents:
diff changeset
1084 ------------
kono
parents:
diff changeset
1085
kono
parents:
diff changeset
1086 function Insert
kono
parents:
diff changeset
1087 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1088 Before : Positive;
kono
parents:
diff changeset
1089 New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
1090 is
kono
parents:
diff changeset
1091 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1092 DL : constant Natural := SR.Last + New_Item'Length;
kono
parents:
diff changeset
1093 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1094
kono
parents:
diff changeset
1095 begin
kono
parents:
diff changeset
1096 -- Check index first
kono
parents:
diff changeset
1097
kono
parents:
diff changeset
1098 if Before > SR.Last + 1 then
kono
parents:
diff changeset
1099 raise Index_Error;
kono
parents:
diff changeset
1100 end if;
kono
parents:
diff changeset
1101
kono
parents:
diff changeset
1102 -- Result is empty, reuse empty shared string
kono
parents:
diff changeset
1103
kono
parents:
diff changeset
1104 if DL = 0 then
kono
parents:
diff changeset
1105 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1106 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1107
kono
parents:
diff changeset
1108 -- Inserted string is empty, reuse source shared string
kono
parents:
diff changeset
1109
kono
parents:
diff changeset
1110 elsif New_Item'Length = 0 then
kono
parents:
diff changeset
1111 Reference (SR);
kono
parents:
diff changeset
1112 DR := SR;
kono
parents:
diff changeset
1113
kono
parents:
diff changeset
1114 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
1115
kono
parents:
diff changeset
1116 else
kono
parents:
diff changeset
1117 DR := Allocate (DL + DL / Growth_Factor);
kono
parents:
diff changeset
1118 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
kono
parents:
diff changeset
1119 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
kono
parents:
diff changeset
1120 DR.Data (Before + New_Item'Length .. DL) :=
kono
parents:
diff changeset
1121 SR.Data (Before .. SR.Last);
kono
parents:
diff changeset
1122 DR.Last := DL;
kono
parents:
diff changeset
1123 end if;
kono
parents:
diff changeset
1124
kono
parents:
diff changeset
1125 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1126 end Insert;
kono
parents:
diff changeset
1127
kono
parents:
diff changeset
1128 procedure Insert
kono
parents:
diff changeset
1129 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1130 Before : Positive;
kono
parents:
diff changeset
1131 New_Item : Wide_Wide_String)
kono
parents:
diff changeset
1132 is
kono
parents:
diff changeset
1133 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1134 DL : constant Natural := SR.Last + New_Item'Length;
kono
parents:
diff changeset
1135 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1136
kono
parents:
diff changeset
1137 begin
kono
parents:
diff changeset
1138 -- Check bounds
kono
parents:
diff changeset
1139
kono
parents:
diff changeset
1140 if Before > SR.Last + 1 then
kono
parents:
diff changeset
1141 raise Index_Error;
kono
parents:
diff changeset
1142 end if;
kono
parents:
diff changeset
1143
kono
parents:
diff changeset
1144 -- Result is empty string, reuse empty shared string
kono
parents:
diff changeset
1145
kono
parents:
diff changeset
1146 if DL = 0 then
kono
parents:
diff changeset
1147 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1148 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1149 Unreference (SR);
kono
parents:
diff changeset
1150
kono
parents:
diff changeset
1151 -- Inserted string is empty, nothing to do
kono
parents:
diff changeset
1152
kono
parents:
diff changeset
1153 elsif New_Item'Length = 0 then
kono
parents:
diff changeset
1154 null;
kono
parents:
diff changeset
1155
kono
parents:
diff changeset
1156 -- Try to reuse existent shared string first
kono
parents:
diff changeset
1157
kono
parents:
diff changeset
1158 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
1159 SR.Data (Before + New_Item'Length .. DL) :=
kono
parents:
diff changeset
1160 SR.Data (Before .. SR.Last);
kono
parents:
diff changeset
1161 SR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
kono
parents:
diff changeset
1162 SR.Last := DL;
kono
parents:
diff changeset
1163
kono
parents:
diff changeset
1164 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
1165
kono
parents:
diff changeset
1166 else
kono
parents:
diff changeset
1167 DR := Allocate (DL + DL / Growth_Factor);
kono
parents:
diff changeset
1168 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
kono
parents:
diff changeset
1169 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
kono
parents:
diff changeset
1170 DR.Data (Before + New_Item'Length .. DL) :=
kono
parents:
diff changeset
1171 SR.Data (Before .. SR.Last);
kono
parents:
diff changeset
1172 DR.Last := DL;
kono
parents:
diff changeset
1173 Source.Reference := DR;
kono
parents:
diff changeset
1174 Unreference (SR);
kono
parents:
diff changeset
1175 end if;
kono
parents:
diff changeset
1176 end Insert;
kono
parents:
diff changeset
1177
kono
parents:
diff changeset
1178 ------------
kono
parents:
diff changeset
1179 -- Length --
kono
parents:
diff changeset
1180 ------------
kono
parents:
diff changeset
1181
kono
parents:
diff changeset
1182 function Length (Source : Unbounded_Wide_Wide_String) return Natural is
kono
parents:
diff changeset
1183 begin
kono
parents:
diff changeset
1184 return Source.Reference.Last;
kono
parents:
diff changeset
1185 end Length;
kono
parents:
diff changeset
1186
kono
parents:
diff changeset
1187 ---------------
kono
parents:
diff changeset
1188 -- Overwrite --
kono
parents:
diff changeset
1189 ---------------
kono
parents:
diff changeset
1190
kono
parents:
diff changeset
1191 function Overwrite
kono
parents:
diff changeset
1192 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1193 Position : Positive;
kono
parents:
diff changeset
1194 New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
1195 is
kono
parents:
diff changeset
1196 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1197 DL : Natural;
kono
parents:
diff changeset
1198 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1199
kono
parents:
diff changeset
1200 begin
kono
parents:
diff changeset
1201 -- Check bounds
kono
parents:
diff changeset
1202
kono
parents:
diff changeset
1203 if Position > SR.Last + 1 then
kono
parents:
diff changeset
1204 raise Index_Error;
kono
parents:
diff changeset
1205 end if;
kono
parents:
diff changeset
1206
kono
parents:
diff changeset
1207 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
kono
parents:
diff changeset
1208
kono
parents:
diff changeset
1209 -- Result is empty string, reuse empty shared string
kono
parents:
diff changeset
1210
kono
parents:
diff changeset
1211 if DL = 0 then
kono
parents:
diff changeset
1212 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1213 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1214
kono
parents:
diff changeset
1215 -- Result is same with source string, reuse source shared string
kono
parents:
diff changeset
1216
kono
parents:
diff changeset
1217 elsif New_Item'Length = 0 then
kono
parents:
diff changeset
1218 Reference (SR);
kono
parents:
diff changeset
1219 DR := SR;
kono
parents:
diff changeset
1220
kono
parents:
diff changeset
1221 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
1222
kono
parents:
diff changeset
1223 else
kono
parents:
diff changeset
1224 DR := Allocate (DL);
kono
parents:
diff changeset
1225 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
kono
parents:
diff changeset
1226 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
kono
parents:
diff changeset
1227 DR.Data (Position + New_Item'Length .. DL) :=
kono
parents:
diff changeset
1228 SR.Data (Position + New_Item'Length .. SR.Last);
kono
parents:
diff changeset
1229 DR.Last := DL;
kono
parents:
diff changeset
1230 end if;
kono
parents:
diff changeset
1231
kono
parents:
diff changeset
1232 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1233 end Overwrite;
kono
parents:
diff changeset
1234
kono
parents:
diff changeset
1235 procedure Overwrite
kono
parents:
diff changeset
1236 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1237 Position : Positive;
kono
parents:
diff changeset
1238 New_Item : Wide_Wide_String)
kono
parents:
diff changeset
1239 is
kono
parents:
diff changeset
1240 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1241 DL : Natural;
kono
parents:
diff changeset
1242 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1243
kono
parents:
diff changeset
1244 begin
kono
parents:
diff changeset
1245 -- Bounds check
kono
parents:
diff changeset
1246
kono
parents:
diff changeset
1247 if Position > SR.Last + 1 then
kono
parents:
diff changeset
1248 raise Index_Error;
kono
parents:
diff changeset
1249 end if;
kono
parents:
diff changeset
1250
kono
parents:
diff changeset
1251 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
kono
parents:
diff changeset
1252
kono
parents:
diff changeset
1253 -- Result is empty string, reuse empty shared string
kono
parents:
diff changeset
1254
kono
parents:
diff changeset
1255 if DL = 0 then
kono
parents:
diff changeset
1256 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1257 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1258 Unreference (SR);
kono
parents:
diff changeset
1259
kono
parents:
diff changeset
1260 -- String unchanged, nothing to do
kono
parents:
diff changeset
1261
kono
parents:
diff changeset
1262 elsif New_Item'Length = 0 then
kono
parents:
diff changeset
1263 null;
kono
parents:
diff changeset
1264
kono
parents:
diff changeset
1265 -- Try to reuse existent shared string
kono
parents:
diff changeset
1266
kono
parents:
diff changeset
1267 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
1268 SR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
kono
parents:
diff changeset
1269 SR.Last := DL;
kono
parents:
diff changeset
1270
kono
parents:
diff changeset
1271 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1272
kono
parents:
diff changeset
1273 else
kono
parents:
diff changeset
1274 DR := Allocate (DL);
kono
parents:
diff changeset
1275 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
kono
parents:
diff changeset
1276 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
kono
parents:
diff changeset
1277 DR.Data (Position + New_Item'Length .. DL) :=
kono
parents:
diff changeset
1278 SR.Data (Position + New_Item'Length .. SR.Last);
kono
parents:
diff changeset
1279 DR.Last := DL;
kono
parents:
diff changeset
1280 Source.Reference := DR;
kono
parents:
diff changeset
1281 Unreference (SR);
kono
parents:
diff changeset
1282 end if;
kono
parents:
diff changeset
1283 end Overwrite;
kono
parents:
diff changeset
1284
kono
parents:
diff changeset
1285 ---------------
kono
parents:
diff changeset
1286 -- Reference --
kono
parents:
diff changeset
1287 ---------------
kono
parents:
diff changeset
1288
kono
parents:
diff changeset
1289 procedure Reference (Item : not null Shared_Wide_Wide_String_Access) is
kono
parents:
diff changeset
1290 begin
kono
parents:
diff changeset
1291 System.Atomic_Counters.Increment (Item.Counter);
kono
parents:
diff changeset
1292 end Reference;
kono
parents:
diff changeset
1293
kono
parents:
diff changeset
1294 ---------------------
kono
parents:
diff changeset
1295 -- Replace_Element --
kono
parents:
diff changeset
1296 ---------------------
kono
parents:
diff changeset
1297
kono
parents:
diff changeset
1298 procedure Replace_Element
kono
parents:
diff changeset
1299 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1300 Index : Positive;
kono
parents:
diff changeset
1301 By : Wide_Wide_Character)
kono
parents:
diff changeset
1302 is
kono
parents:
diff changeset
1303 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1304 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1305
kono
parents:
diff changeset
1306 begin
kono
parents:
diff changeset
1307 -- Bounds check
kono
parents:
diff changeset
1308
kono
parents:
diff changeset
1309 if Index <= SR.Last then
kono
parents:
diff changeset
1310
kono
parents:
diff changeset
1311 -- Try to reuse existent shared string
kono
parents:
diff changeset
1312
kono
parents:
diff changeset
1313 if Can_Be_Reused (SR, SR.Last) then
kono
parents:
diff changeset
1314 SR.Data (Index) := By;
kono
parents:
diff changeset
1315
kono
parents:
diff changeset
1316 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1317
kono
parents:
diff changeset
1318 else
kono
parents:
diff changeset
1319 DR := Allocate (SR.Last);
kono
parents:
diff changeset
1320 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
1321 DR.Data (Index) := By;
kono
parents:
diff changeset
1322 DR.Last := SR.Last;
kono
parents:
diff changeset
1323 Source.Reference := DR;
kono
parents:
diff changeset
1324 Unreference (SR);
kono
parents:
diff changeset
1325 end if;
kono
parents:
diff changeset
1326
kono
parents:
diff changeset
1327 else
kono
parents:
diff changeset
1328 raise Index_Error;
kono
parents:
diff changeset
1329 end if;
kono
parents:
diff changeset
1330 end Replace_Element;
kono
parents:
diff changeset
1331
kono
parents:
diff changeset
1332 -------------------
kono
parents:
diff changeset
1333 -- Replace_Slice --
kono
parents:
diff changeset
1334 -------------------
kono
parents:
diff changeset
1335
kono
parents:
diff changeset
1336 function Replace_Slice
kono
parents:
diff changeset
1337 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1338 Low : Positive;
kono
parents:
diff changeset
1339 High : Natural;
kono
parents:
diff changeset
1340 By : Wide_Wide_String) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
1341 is
kono
parents:
diff changeset
1342 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1343 DL : Natural;
kono
parents:
diff changeset
1344 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1345
kono
parents:
diff changeset
1346 begin
kono
parents:
diff changeset
1347 -- Check bounds
kono
parents:
diff changeset
1348
kono
parents:
diff changeset
1349 if Low > SR.Last + 1 then
kono
parents:
diff changeset
1350 raise Index_Error;
kono
parents:
diff changeset
1351 end if;
kono
parents:
diff changeset
1352
kono
parents:
diff changeset
1353 -- Do replace operation when removed slice is not empty
kono
parents:
diff changeset
1354
kono
parents:
diff changeset
1355 if High >= Low then
kono
parents:
diff changeset
1356 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
kono
parents:
diff changeset
1357 -- This is the number of characters remaining in the string after
kono
parents:
diff changeset
1358 -- replacing the slice.
kono
parents:
diff changeset
1359
kono
parents:
diff changeset
1360 -- Result is empty string, reuse empty shared string
kono
parents:
diff changeset
1361
kono
parents:
diff changeset
1362 if DL = 0 then
kono
parents:
diff changeset
1363 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1364 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1365
kono
parents:
diff changeset
1366 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1367
kono
parents:
diff changeset
1368 else
kono
parents:
diff changeset
1369 DR := Allocate (DL);
kono
parents:
diff changeset
1370 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
kono
parents:
diff changeset
1371 DR.Data (Low .. Low + By'Length - 1) := By;
kono
parents:
diff changeset
1372 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
kono
parents:
diff changeset
1373 DR.Last := DL;
kono
parents:
diff changeset
1374 end if;
kono
parents:
diff changeset
1375
kono
parents:
diff changeset
1376 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1377
kono
parents:
diff changeset
1378 -- Otherwise just insert string
kono
parents:
diff changeset
1379
kono
parents:
diff changeset
1380 else
kono
parents:
diff changeset
1381 return Insert (Source, Low, By);
kono
parents:
diff changeset
1382 end if;
kono
parents:
diff changeset
1383 end Replace_Slice;
kono
parents:
diff changeset
1384
kono
parents:
diff changeset
1385 procedure Replace_Slice
kono
parents:
diff changeset
1386 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1387 Low : Positive;
kono
parents:
diff changeset
1388 High : Natural;
kono
parents:
diff changeset
1389 By : Wide_Wide_String)
kono
parents:
diff changeset
1390 is
kono
parents:
diff changeset
1391 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1392 DL : Natural;
kono
parents:
diff changeset
1393 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1394
kono
parents:
diff changeset
1395 begin
kono
parents:
diff changeset
1396 -- Bounds check
kono
parents:
diff changeset
1397
kono
parents:
diff changeset
1398 if Low > SR.Last + 1 then
kono
parents:
diff changeset
1399 raise Index_Error;
kono
parents:
diff changeset
1400 end if;
kono
parents:
diff changeset
1401
kono
parents:
diff changeset
1402 -- Do replace operation only when replaced slice is not empty
kono
parents:
diff changeset
1403
kono
parents:
diff changeset
1404 if High >= Low then
kono
parents:
diff changeset
1405 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
kono
parents:
diff changeset
1406 -- This is the number of characters remaining in the string after
kono
parents:
diff changeset
1407 -- replacing the slice.
kono
parents:
diff changeset
1408
kono
parents:
diff changeset
1409 -- Result is empty string, reuse empty shared string
kono
parents:
diff changeset
1410
kono
parents:
diff changeset
1411 if DL = 0 then
kono
parents:
diff changeset
1412 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1413 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1414 Unreference (SR);
kono
parents:
diff changeset
1415
kono
parents:
diff changeset
1416 -- Try to reuse existent shared string
kono
parents:
diff changeset
1417
kono
parents:
diff changeset
1418 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
1419 SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
kono
parents:
diff changeset
1420 SR.Data (Low .. Low + By'Length - 1) := By;
kono
parents:
diff changeset
1421 SR.Last := DL;
kono
parents:
diff changeset
1422
kono
parents:
diff changeset
1423 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1424
kono
parents:
diff changeset
1425 else
kono
parents:
diff changeset
1426 DR := Allocate (DL);
kono
parents:
diff changeset
1427 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
kono
parents:
diff changeset
1428 DR.Data (Low .. Low + By'Length - 1) := By;
kono
parents:
diff changeset
1429 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
kono
parents:
diff changeset
1430 DR.Last := DL;
kono
parents:
diff changeset
1431 Source.Reference := DR;
kono
parents:
diff changeset
1432 Unreference (SR);
kono
parents:
diff changeset
1433 end if;
kono
parents:
diff changeset
1434
kono
parents:
diff changeset
1435 -- Otherwise just insert item
kono
parents:
diff changeset
1436
kono
parents:
diff changeset
1437 else
kono
parents:
diff changeset
1438 Insert (Source, Low, By);
kono
parents:
diff changeset
1439 end if;
kono
parents:
diff changeset
1440 end Replace_Slice;
kono
parents:
diff changeset
1441
kono
parents:
diff changeset
1442 -------------------------------
kono
parents:
diff changeset
1443 -- Set_Unbounded_Wide_Wide_String --
kono
parents:
diff changeset
1444 -------------------------------
kono
parents:
diff changeset
1445
kono
parents:
diff changeset
1446 procedure Set_Unbounded_Wide_Wide_String
kono
parents:
diff changeset
1447 (Target : out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1448 Source : Wide_Wide_String)
kono
parents:
diff changeset
1449 is
kono
parents:
diff changeset
1450 TR : constant Shared_Wide_Wide_String_Access := Target.Reference;
kono
parents:
diff changeset
1451 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1452
kono
parents:
diff changeset
1453 begin
kono
parents:
diff changeset
1454 -- In case of empty string, reuse empty shared string
kono
parents:
diff changeset
1455
kono
parents:
diff changeset
1456 if Source'Length = 0 then
kono
parents:
diff changeset
1457 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1458 Target.Reference := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1459
kono
parents:
diff changeset
1460 else
kono
parents:
diff changeset
1461 -- Try to reuse existent shared string
kono
parents:
diff changeset
1462
kono
parents:
diff changeset
1463 if Can_Be_Reused (TR, Source'Length) then
kono
parents:
diff changeset
1464 Reference (TR);
kono
parents:
diff changeset
1465 DR := TR;
kono
parents:
diff changeset
1466
kono
parents:
diff changeset
1467 -- Otherwise allocate new shared string
kono
parents:
diff changeset
1468
kono
parents:
diff changeset
1469 else
kono
parents:
diff changeset
1470 DR := Allocate (Source'Length);
kono
parents:
diff changeset
1471 Target.Reference := DR;
kono
parents:
diff changeset
1472 end if;
kono
parents:
diff changeset
1473
kono
parents:
diff changeset
1474 DR.Data (1 .. Source'Length) := Source;
kono
parents:
diff changeset
1475 DR.Last := Source'Length;
kono
parents:
diff changeset
1476 end if;
kono
parents:
diff changeset
1477
kono
parents:
diff changeset
1478 Unreference (TR);
kono
parents:
diff changeset
1479 end Set_Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1480
kono
parents:
diff changeset
1481 -----------
kono
parents:
diff changeset
1482 -- Slice --
kono
parents:
diff changeset
1483 -----------
kono
parents:
diff changeset
1484
kono
parents:
diff changeset
1485 function Slice
kono
parents:
diff changeset
1486 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1487 Low : Positive;
kono
parents:
diff changeset
1488 High : Natural) return Wide_Wide_String
kono
parents:
diff changeset
1489 is
kono
parents:
diff changeset
1490 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1491
kono
parents:
diff changeset
1492 begin
kono
parents:
diff changeset
1493 -- Note: test of High > Length is in accordance with AI95-00128
kono
parents:
diff changeset
1494
kono
parents:
diff changeset
1495 if Low > SR.Last + 1 or else High > SR.Last then
kono
parents:
diff changeset
1496 raise Index_Error;
kono
parents:
diff changeset
1497
kono
parents:
diff changeset
1498 else
kono
parents:
diff changeset
1499 return SR.Data (Low .. High);
kono
parents:
diff changeset
1500 end if;
kono
parents:
diff changeset
1501 end Slice;
kono
parents:
diff changeset
1502
kono
parents:
diff changeset
1503 ----------
kono
parents:
diff changeset
1504 -- Tail --
kono
parents:
diff changeset
1505 ----------
kono
parents:
diff changeset
1506
kono
parents:
diff changeset
1507 function Tail
kono
parents:
diff changeset
1508 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1509 Count : Natural;
kono
parents:
diff changeset
1510 Pad : Wide_Wide_Character := Wide_Wide_Space)
kono
parents:
diff changeset
1511 return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
1512 is
kono
parents:
diff changeset
1513 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1514 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1515
kono
parents:
diff changeset
1516 begin
kono
parents:
diff changeset
1517 -- For empty result reuse empty shared string
kono
parents:
diff changeset
1518
kono
parents:
diff changeset
1519 if Count = 0 then
kono
parents:
diff changeset
1520 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1521 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1522
kono
parents:
diff changeset
1523 -- Result is hole source string, reuse source shared string
kono
parents:
diff changeset
1524
kono
parents:
diff changeset
1525 elsif Count = SR.Last then
kono
parents:
diff changeset
1526 Reference (SR);
kono
parents:
diff changeset
1527 DR := SR;
kono
parents:
diff changeset
1528
kono
parents:
diff changeset
1529 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1530
kono
parents:
diff changeset
1531 else
kono
parents:
diff changeset
1532 DR := Allocate (Count);
kono
parents:
diff changeset
1533
kono
parents:
diff changeset
1534 if Count < SR.Last then
kono
parents:
diff changeset
1535 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
kono
parents:
diff changeset
1536
kono
parents:
diff changeset
1537 else
kono
parents:
diff changeset
1538 for J in 1 .. Count - SR.Last loop
kono
parents:
diff changeset
1539 DR.Data (J) := Pad;
kono
parents:
diff changeset
1540 end loop;
kono
parents:
diff changeset
1541
kono
parents:
diff changeset
1542 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
1543 end if;
kono
parents:
diff changeset
1544
kono
parents:
diff changeset
1545 DR.Last := Count;
kono
parents:
diff changeset
1546 end if;
kono
parents:
diff changeset
1547
kono
parents:
diff changeset
1548 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1549 end Tail;
kono
parents:
diff changeset
1550
kono
parents:
diff changeset
1551 procedure Tail
kono
parents:
diff changeset
1552 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1553 Count : Natural;
kono
parents:
diff changeset
1554 Pad : Wide_Wide_Character := Wide_Wide_Space)
kono
parents:
diff changeset
1555 is
kono
parents:
diff changeset
1556 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1557 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1558
kono
parents:
diff changeset
1559 procedure Common
kono
parents:
diff changeset
1560 (SR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1561 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1562 Count : Natural);
kono
parents:
diff changeset
1563 -- Common code of tail computation. SR/DR can point to the same object
kono
parents:
diff changeset
1564
kono
parents:
diff changeset
1565 ------------
kono
parents:
diff changeset
1566 -- Common --
kono
parents:
diff changeset
1567 ------------
kono
parents:
diff changeset
1568
kono
parents:
diff changeset
1569 procedure Common
kono
parents:
diff changeset
1570 (SR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1571 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1572 Count : Natural) is
kono
parents:
diff changeset
1573 begin
kono
parents:
diff changeset
1574 if Count < SR.Last then
kono
parents:
diff changeset
1575 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
kono
parents:
diff changeset
1576
kono
parents:
diff changeset
1577 else
kono
parents:
diff changeset
1578 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
1579
kono
parents:
diff changeset
1580 for J in 1 .. Count - SR.Last loop
kono
parents:
diff changeset
1581 DR.Data (J) := Pad;
kono
parents:
diff changeset
1582 end loop;
kono
parents:
diff changeset
1583 end if;
kono
parents:
diff changeset
1584
kono
parents:
diff changeset
1585 DR.Last := Count;
kono
parents:
diff changeset
1586 end Common;
kono
parents:
diff changeset
1587
kono
parents:
diff changeset
1588 begin
kono
parents:
diff changeset
1589 -- Result is empty string, reuse empty shared string
kono
parents:
diff changeset
1590
kono
parents:
diff changeset
1591 if Count = 0 then
kono
parents:
diff changeset
1592 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1593 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1594 Unreference (SR);
kono
parents:
diff changeset
1595
kono
parents:
diff changeset
1596 -- Length of the result is the same with length of the source string,
kono
parents:
diff changeset
1597 -- reuse source shared string.
kono
parents:
diff changeset
1598
kono
parents:
diff changeset
1599 elsif Count = SR.Last then
kono
parents:
diff changeset
1600 null;
kono
parents:
diff changeset
1601
kono
parents:
diff changeset
1602 -- Try to reuse existent shared string
kono
parents:
diff changeset
1603
kono
parents:
diff changeset
1604 elsif Can_Be_Reused (SR, Count) then
kono
parents:
diff changeset
1605 Common (SR, SR, Count);
kono
parents:
diff changeset
1606
kono
parents:
diff changeset
1607 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1608
kono
parents:
diff changeset
1609 else
kono
parents:
diff changeset
1610 DR := Allocate (Count);
kono
parents:
diff changeset
1611 Common (SR, DR, Count);
kono
parents:
diff changeset
1612 Source.Reference := DR;
kono
parents:
diff changeset
1613 Unreference (SR);
kono
parents:
diff changeset
1614 end if;
kono
parents:
diff changeset
1615 end Tail;
kono
parents:
diff changeset
1616
kono
parents:
diff changeset
1617 -------------------------
kono
parents:
diff changeset
1618 -- To_Wide_Wide_String --
kono
parents:
diff changeset
1619 -------------------------
kono
parents:
diff changeset
1620
kono
parents:
diff changeset
1621 function To_Wide_Wide_String
kono
parents:
diff changeset
1622 (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String is
kono
parents:
diff changeset
1623 begin
kono
parents:
diff changeset
1624 return Source.Reference.Data (1 .. Source.Reference.Last);
kono
parents:
diff changeset
1625 end To_Wide_Wide_String;
kono
parents:
diff changeset
1626
kono
parents:
diff changeset
1627 -----------------------------------
kono
parents:
diff changeset
1628 -- To_Unbounded_Wide_Wide_String --
kono
parents:
diff changeset
1629 -----------------------------------
kono
parents:
diff changeset
1630
kono
parents:
diff changeset
1631 function To_Unbounded_Wide_Wide_String
kono
parents:
diff changeset
1632 (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
1633 is
kono
parents:
diff changeset
1634 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1635
kono
parents:
diff changeset
1636 begin
kono
parents:
diff changeset
1637 if Source'Length = 0 then
kono
parents:
diff changeset
1638 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1639 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1640
kono
parents:
diff changeset
1641 else
kono
parents:
diff changeset
1642 DR := Allocate (Source'Length);
kono
parents:
diff changeset
1643 DR.Data (1 .. Source'Length) := Source;
kono
parents:
diff changeset
1644 DR.Last := Source'Length;
kono
parents:
diff changeset
1645 end if;
kono
parents:
diff changeset
1646
kono
parents:
diff changeset
1647 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1648 end To_Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1649
kono
parents:
diff changeset
1650 function To_Unbounded_Wide_Wide_String
kono
parents:
diff changeset
1651 (Length : Natural) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
1652 is
kono
parents:
diff changeset
1653 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1654
kono
parents:
diff changeset
1655 begin
kono
parents:
diff changeset
1656 if Length = 0 then
kono
parents:
diff changeset
1657 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1658 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1659
kono
parents:
diff changeset
1660 else
kono
parents:
diff changeset
1661 DR := Allocate (Length);
kono
parents:
diff changeset
1662 DR.Last := Length;
kono
parents:
diff changeset
1663 end if;
kono
parents:
diff changeset
1664
kono
parents:
diff changeset
1665 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1666 end To_Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1667
kono
parents:
diff changeset
1668 ---------------
kono
parents:
diff changeset
1669 -- Translate --
kono
parents:
diff changeset
1670 ---------------
kono
parents:
diff changeset
1671
kono
parents:
diff changeset
1672 function Translate
kono
parents:
diff changeset
1673 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1674 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
kono
parents:
diff changeset
1675 return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
1676 is
kono
parents:
diff changeset
1677 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1678 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1679
kono
parents:
diff changeset
1680 begin
kono
parents:
diff changeset
1681 -- Nothing to translate, reuse empty shared string
kono
parents:
diff changeset
1682
kono
parents:
diff changeset
1683 if SR.Last = 0 then
kono
parents:
diff changeset
1684 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1685 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1686
kono
parents:
diff changeset
1687 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
1688
kono
parents:
diff changeset
1689 else
kono
parents:
diff changeset
1690 DR := Allocate (SR.Last);
kono
parents:
diff changeset
1691
kono
parents:
diff changeset
1692 for J in 1 .. SR.Last loop
kono
parents:
diff changeset
1693 DR.Data (J) := Value (Mapping, SR.Data (J));
kono
parents:
diff changeset
1694 end loop;
kono
parents:
diff changeset
1695
kono
parents:
diff changeset
1696 DR.Last := SR.Last;
kono
parents:
diff changeset
1697 end if;
kono
parents:
diff changeset
1698
kono
parents:
diff changeset
1699 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1700 end Translate;
kono
parents:
diff changeset
1701
kono
parents:
diff changeset
1702 procedure Translate
kono
parents:
diff changeset
1703 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1704 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
kono
parents:
diff changeset
1705 is
kono
parents:
diff changeset
1706 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1707 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1708
kono
parents:
diff changeset
1709 begin
kono
parents:
diff changeset
1710 -- Nothing to translate
kono
parents:
diff changeset
1711
kono
parents:
diff changeset
1712 if SR.Last = 0 then
kono
parents:
diff changeset
1713 null;
kono
parents:
diff changeset
1714
kono
parents:
diff changeset
1715 -- Try to reuse shared string
kono
parents:
diff changeset
1716
kono
parents:
diff changeset
1717 elsif Can_Be_Reused (SR, SR.Last) then
kono
parents:
diff changeset
1718 for J in 1 .. SR.Last loop
kono
parents:
diff changeset
1719 SR.Data (J) := Value (Mapping, SR.Data (J));
kono
parents:
diff changeset
1720 end loop;
kono
parents:
diff changeset
1721
kono
parents:
diff changeset
1722 -- Otherwise, allocate new shared string
kono
parents:
diff changeset
1723
kono
parents:
diff changeset
1724 else
kono
parents:
diff changeset
1725 DR := Allocate (SR.Last);
kono
parents:
diff changeset
1726
kono
parents:
diff changeset
1727 for J in 1 .. SR.Last loop
kono
parents:
diff changeset
1728 DR.Data (J) := Value (Mapping, SR.Data (J));
kono
parents:
diff changeset
1729 end loop;
kono
parents:
diff changeset
1730
kono
parents:
diff changeset
1731 DR.Last := SR.Last;
kono
parents:
diff changeset
1732 Source.Reference := DR;
kono
parents:
diff changeset
1733 Unreference (SR);
kono
parents:
diff changeset
1734 end if;
kono
parents:
diff changeset
1735 end Translate;
kono
parents:
diff changeset
1736
kono
parents:
diff changeset
1737 function Translate
kono
parents:
diff changeset
1738 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1739 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
kono
parents:
diff changeset
1740 return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
1741 is
kono
parents:
diff changeset
1742 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1743 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1744
kono
parents:
diff changeset
1745 begin
kono
parents:
diff changeset
1746 -- Nothing to translate, reuse empty shared string
kono
parents:
diff changeset
1747
kono
parents:
diff changeset
1748 if SR.Last = 0 then
kono
parents:
diff changeset
1749 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1750 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1751
kono
parents:
diff changeset
1752 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
1753
kono
parents:
diff changeset
1754 else
kono
parents:
diff changeset
1755 DR := Allocate (SR.Last);
kono
parents:
diff changeset
1756
kono
parents:
diff changeset
1757 for J in 1 .. SR.Last loop
kono
parents:
diff changeset
1758 DR.Data (J) := Mapping.all (SR.Data (J));
kono
parents:
diff changeset
1759 end loop;
kono
parents:
diff changeset
1760
kono
parents:
diff changeset
1761 DR.Last := SR.Last;
kono
parents:
diff changeset
1762 end if;
kono
parents:
diff changeset
1763
kono
parents:
diff changeset
1764 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1765
kono
parents:
diff changeset
1766 exception
kono
parents:
diff changeset
1767 when others =>
kono
parents:
diff changeset
1768 Unreference (DR);
kono
parents:
diff changeset
1769
kono
parents:
diff changeset
1770 raise;
kono
parents:
diff changeset
1771 end Translate;
kono
parents:
diff changeset
1772
kono
parents:
diff changeset
1773 procedure Translate
kono
parents:
diff changeset
1774 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1775 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
kono
parents:
diff changeset
1776 is
kono
parents:
diff changeset
1777 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1778 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1779
kono
parents:
diff changeset
1780 begin
kono
parents:
diff changeset
1781 -- Nothing to translate
kono
parents:
diff changeset
1782
kono
parents:
diff changeset
1783 if SR.Last = 0 then
kono
parents:
diff changeset
1784 null;
kono
parents:
diff changeset
1785
kono
parents:
diff changeset
1786 -- Try to reuse shared string
kono
parents:
diff changeset
1787
kono
parents:
diff changeset
1788 elsif Can_Be_Reused (SR, SR.Last) then
kono
parents:
diff changeset
1789 for J in 1 .. SR.Last loop
kono
parents:
diff changeset
1790 SR.Data (J) := Mapping.all (SR.Data (J));
kono
parents:
diff changeset
1791 end loop;
kono
parents:
diff changeset
1792
kono
parents:
diff changeset
1793 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1794
kono
parents:
diff changeset
1795 else
kono
parents:
diff changeset
1796 DR := Allocate (SR.Last);
kono
parents:
diff changeset
1797
kono
parents:
diff changeset
1798 for J in 1 .. SR.Last loop
kono
parents:
diff changeset
1799 DR.Data (J) := Mapping.all (SR.Data (J));
kono
parents:
diff changeset
1800 end loop;
kono
parents:
diff changeset
1801
kono
parents:
diff changeset
1802 DR.Last := SR.Last;
kono
parents:
diff changeset
1803 Source.Reference := DR;
kono
parents:
diff changeset
1804 Unreference (SR);
kono
parents:
diff changeset
1805 end if;
kono
parents:
diff changeset
1806
kono
parents:
diff changeset
1807 exception
kono
parents:
diff changeset
1808 when others =>
kono
parents:
diff changeset
1809 if DR /= null then
kono
parents:
diff changeset
1810 Unreference (DR);
kono
parents:
diff changeset
1811 end if;
kono
parents:
diff changeset
1812
kono
parents:
diff changeset
1813 raise;
kono
parents:
diff changeset
1814 end Translate;
kono
parents:
diff changeset
1815
kono
parents:
diff changeset
1816 ----------
kono
parents:
diff changeset
1817 -- Trim --
kono
parents:
diff changeset
1818 ----------
kono
parents:
diff changeset
1819
kono
parents:
diff changeset
1820 function Trim
kono
parents:
diff changeset
1821 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1822 Side : Trim_End) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
1823 is
kono
parents:
diff changeset
1824 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1825 DL : Natural;
kono
parents:
diff changeset
1826 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1827 Low : Natural;
kono
parents:
diff changeset
1828 High : Natural;
kono
parents:
diff changeset
1829
kono
parents:
diff changeset
1830 begin
kono
parents:
diff changeset
1831 Low := Index_Non_Blank (Source, Forward);
kono
parents:
diff changeset
1832
kono
parents:
diff changeset
1833 -- All blanks, reuse empty shared string
kono
parents:
diff changeset
1834
kono
parents:
diff changeset
1835 if Low = 0 then
kono
parents:
diff changeset
1836 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1837 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1838
kono
parents:
diff changeset
1839 else
kono
parents:
diff changeset
1840 case Side is
kono
parents:
diff changeset
1841 when Left =>
kono
parents:
diff changeset
1842 High := SR.Last;
kono
parents:
diff changeset
1843 DL := SR.Last - Low + 1;
kono
parents:
diff changeset
1844
kono
parents:
diff changeset
1845 when Right =>
kono
parents:
diff changeset
1846 Low := 1;
kono
parents:
diff changeset
1847 High := Index_Non_Blank (Source, Backward);
kono
parents:
diff changeset
1848 DL := High;
kono
parents:
diff changeset
1849
kono
parents:
diff changeset
1850 when Both =>
kono
parents:
diff changeset
1851 High := Index_Non_Blank (Source, Backward);
kono
parents:
diff changeset
1852 DL := High - Low + 1;
kono
parents:
diff changeset
1853 end case;
kono
parents:
diff changeset
1854
kono
parents:
diff changeset
1855 -- Length of the result is the same as length of the source string,
kono
parents:
diff changeset
1856 -- reuse source shared string.
kono
parents:
diff changeset
1857
kono
parents:
diff changeset
1858 if DL = SR.Last then
kono
parents:
diff changeset
1859 Reference (SR);
kono
parents:
diff changeset
1860 DR := SR;
kono
parents:
diff changeset
1861
kono
parents:
diff changeset
1862 -- Otherwise, allocate new shared string
kono
parents:
diff changeset
1863
kono
parents:
diff changeset
1864 else
kono
parents:
diff changeset
1865 DR := Allocate (DL);
kono
parents:
diff changeset
1866 DR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
1867 DR.Last := DL;
kono
parents:
diff changeset
1868 end if;
kono
parents:
diff changeset
1869 end if;
kono
parents:
diff changeset
1870
kono
parents:
diff changeset
1871 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1872 end Trim;
kono
parents:
diff changeset
1873
kono
parents:
diff changeset
1874 procedure Trim
kono
parents:
diff changeset
1875 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1876 Side : Trim_End)
kono
parents:
diff changeset
1877 is
kono
parents:
diff changeset
1878 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1879 DL : Natural;
kono
parents:
diff changeset
1880 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1881 Low : Natural;
kono
parents:
diff changeset
1882 High : Natural;
kono
parents:
diff changeset
1883
kono
parents:
diff changeset
1884 begin
kono
parents:
diff changeset
1885 Low := Index_Non_Blank (Source, Forward);
kono
parents:
diff changeset
1886
kono
parents:
diff changeset
1887 -- All blanks, reuse empty shared string
kono
parents:
diff changeset
1888
kono
parents:
diff changeset
1889 if Low = 0 then
kono
parents:
diff changeset
1890 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1891 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1892 Unreference (SR);
kono
parents:
diff changeset
1893
kono
parents:
diff changeset
1894 else
kono
parents:
diff changeset
1895 case Side is
kono
parents:
diff changeset
1896 when Left =>
kono
parents:
diff changeset
1897 High := SR.Last;
kono
parents:
diff changeset
1898 DL := SR.Last - Low + 1;
kono
parents:
diff changeset
1899
kono
parents:
diff changeset
1900 when Right =>
kono
parents:
diff changeset
1901 Low := 1;
kono
parents:
diff changeset
1902 High := Index_Non_Blank (Source, Backward);
kono
parents:
diff changeset
1903 DL := High;
kono
parents:
diff changeset
1904
kono
parents:
diff changeset
1905 when Both =>
kono
parents:
diff changeset
1906 High := Index_Non_Blank (Source, Backward);
kono
parents:
diff changeset
1907 DL := High - Low + 1;
kono
parents:
diff changeset
1908 end case;
kono
parents:
diff changeset
1909
kono
parents:
diff changeset
1910 -- Length of the result is the same as length of the source string,
kono
parents:
diff changeset
1911 -- nothing to do.
kono
parents:
diff changeset
1912
kono
parents:
diff changeset
1913 if DL = SR.Last then
kono
parents:
diff changeset
1914 null;
kono
parents:
diff changeset
1915
kono
parents:
diff changeset
1916 -- Try to reuse existent shared string
kono
parents:
diff changeset
1917
kono
parents:
diff changeset
1918 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
1919 SR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
1920 SR.Last := DL;
kono
parents:
diff changeset
1921
kono
parents:
diff changeset
1922 -- Otherwise, allocate new shared string
kono
parents:
diff changeset
1923
kono
parents:
diff changeset
1924 else
kono
parents:
diff changeset
1925 DR := Allocate (DL);
kono
parents:
diff changeset
1926 DR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
1927 DR.Last := DL;
kono
parents:
diff changeset
1928 Source.Reference := DR;
kono
parents:
diff changeset
1929 Unreference (SR);
kono
parents:
diff changeset
1930 end if;
kono
parents:
diff changeset
1931 end if;
kono
parents:
diff changeset
1932 end Trim;
kono
parents:
diff changeset
1933
kono
parents:
diff changeset
1934 function Trim
kono
parents:
diff changeset
1935 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1936 Left : Wide_Wide_Maps.Wide_Wide_Character_Set;
kono
parents:
diff changeset
1937 Right : Wide_Wide_Maps.Wide_Wide_Character_Set)
kono
parents:
diff changeset
1938 return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
1939 is
kono
parents:
diff changeset
1940 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1941 DL : Natural;
kono
parents:
diff changeset
1942 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1943 Low : Natural;
kono
parents:
diff changeset
1944 High : Natural;
kono
parents:
diff changeset
1945
kono
parents:
diff changeset
1946 begin
kono
parents:
diff changeset
1947 Low := Index (Source, Left, Outside, Forward);
kono
parents:
diff changeset
1948
kono
parents:
diff changeset
1949 -- Source includes only characters from Left set, reuse empty shared
kono
parents:
diff changeset
1950 -- string.
kono
parents:
diff changeset
1951
kono
parents:
diff changeset
1952 if Low = 0 then
kono
parents:
diff changeset
1953 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1954 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1955
kono
parents:
diff changeset
1956 else
kono
parents:
diff changeset
1957 High := Index (Source, Right, Outside, Backward);
kono
parents:
diff changeset
1958 DL := Integer'Max (0, High - Low + 1);
kono
parents:
diff changeset
1959
kono
parents:
diff changeset
1960 -- Source includes only characters from Right set or result string
kono
parents:
diff changeset
1961 -- is empty, reuse empty shared string.
kono
parents:
diff changeset
1962
kono
parents:
diff changeset
1963 if High = 0 or else DL = 0 then
kono
parents:
diff changeset
1964 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1965 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1966
kono
parents:
diff changeset
1967 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
1968
kono
parents:
diff changeset
1969 else
kono
parents:
diff changeset
1970 DR := Allocate (DL);
kono
parents:
diff changeset
1971 DR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
1972 DR.Last := DL;
kono
parents:
diff changeset
1973 end if;
kono
parents:
diff changeset
1974 end if;
kono
parents:
diff changeset
1975
kono
parents:
diff changeset
1976 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1977 end Trim;
kono
parents:
diff changeset
1978
kono
parents:
diff changeset
1979 procedure Trim
kono
parents:
diff changeset
1980 (Source : in out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
1981 Left : Wide_Wide_Maps.Wide_Wide_Character_Set;
kono
parents:
diff changeset
1982 Right : Wide_Wide_Maps.Wide_Wide_Character_Set)
kono
parents:
diff changeset
1983 is
kono
parents:
diff changeset
1984 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
1985 DL : Natural;
kono
parents:
diff changeset
1986 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
1987 Low : Natural;
kono
parents:
diff changeset
1988 High : Natural;
kono
parents:
diff changeset
1989
kono
parents:
diff changeset
1990 begin
kono
parents:
diff changeset
1991 Low := Index (Source, Left, Outside, Forward);
kono
parents:
diff changeset
1992
kono
parents:
diff changeset
1993 -- Source includes only characters from Left set, reuse empty shared
kono
parents:
diff changeset
1994 -- string.
kono
parents:
diff changeset
1995
kono
parents:
diff changeset
1996 if Low = 0 then
kono
parents:
diff changeset
1997 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
1998 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
1999 Unreference (SR);
kono
parents:
diff changeset
2000
kono
parents:
diff changeset
2001 else
kono
parents:
diff changeset
2002 High := Index (Source, Right, Outside, Backward);
kono
parents:
diff changeset
2003 DL := Integer'Max (0, High - Low + 1);
kono
parents:
diff changeset
2004
kono
parents:
diff changeset
2005 -- Source includes only characters from Right set or result string
kono
parents:
diff changeset
2006 -- is empty, reuse empty shared string.
kono
parents:
diff changeset
2007
kono
parents:
diff changeset
2008 if High = 0 or else DL = 0 then
kono
parents:
diff changeset
2009 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
2010 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
2011 Unreference (SR);
kono
parents:
diff changeset
2012
kono
parents:
diff changeset
2013 -- Try to reuse existent shared string
kono
parents:
diff changeset
2014
kono
parents:
diff changeset
2015 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
2016 SR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
2017 SR.Last := DL;
kono
parents:
diff changeset
2018
kono
parents:
diff changeset
2019 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
2020
kono
parents:
diff changeset
2021 else
kono
parents:
diff changeset
2022 DR := Allocate (DL);
kono
parents:
diff changeset
2023 DR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
2024 DR.Last := DL;
kono
parents:
diff changeset
2025 Source.Reference := DR;
kono
parents:
diff changeset
2026 Unreference (SR);
kono
parents:
diff changeset
2027 end if;
kono
parents:
diff changeset
2028 end if;
kono
parents:
diff changeset
2029 end Trim;
kono
parents:
diff changeset
2030
kono
parents:
diff changeset
2031 ---------------------
kono
parents:
diff changeset
2032 -- Unbounded_Slice --
kono
parents:
diff changeset
2033 ---------------------
kono
parents:
diff changeset
2034
kono
parents:
diff changeset
2035 function Unbounded_Slice
kono
parents:
diff changeset
2036 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
2037 Low : Positive;
kono
parents:
diff changeset
2038 High : Natural) return Unbounded_Wide_Wide_String
kono
parents:
diff changeset
2039 is
kono
parents:
diff changeset
2040 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
2041 DL : Natural;
kono
parents:
diff changeset
2042 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
2043
kono
parents:
diff changeset
2044 begin
kono
parents:
diff changeset
2045 -- Check bounds
kono
parents:
diff changeset
2046
kono
parents:
diff changeset
2047 if Low > SR.Last + 1 or else High > SR.Last then
kono
parents:
diff changeset
2048 raise Index_Error;
kono
parents:
diff changeset
2049
kono
parents:
diff changeset
2050 -- Result is empty slice, reuse empty shared string
kono
parents:
diff changeset
2051
kono
parents:
diff changeset
2052 elsif Low > High then
kono
parents:
diff changeset
2053 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
2054 DR := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
2055
kono
parents:
diff changeset
2056 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
2057
kono
parents:
diff changeset
2058 else
kono
parents:
diff changeset
2059 DL := High - Low + 1;
kono
parents:
diff changeset
2060 DR := Allocate (DL);
kono
parents:
diff changeset
2061 DR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
2062 DR.Last := DL;
kono
parents:
diff changeset
2063 end if;
kono
parents:
diff changeset
2064
kono
parents:
diff changeset
2065 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
2066 end Unbounded_Slice;
kono
parents:
diff changeset
2067
kono
parents:
diff changeset
2068 procedure Unbounded_Slice
kono
parents:
diff changeset
2069 (Source : Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
2070 Target : out Unbounded_Wide_Wide_String;
kono
parents:
diff changeset
2071 Low : Positive;
kono
parents:
diff changeset
2072 High : Natural)
kono
parents:
diff changeset
2073 is
kono
parents:
diff changeset
2074 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
kono
parents:
diff changeset
2075 TR : constant Shared_Wide_Wide_String_Access := Target.Reference;
kono
parents:
diff changeset
2076 DL : Natural;
kono
parents:
diff changeset
2077 DR : Shared_Wide_Wide_String_Access;
kono
parents:
diff changeset
2078
kono
parents:
diff changeset
2079 begin
kono
parents:
diff changeset
2080 -- Check bounds
kono
parents:
diff changeset
2081
kono
parents:
diff changeset
2082 if Low > SR.Last + 1 or else High > SR.Last then
kono
parents:
diff changeset
2083 raise Index_Error;
kono
parents:
diff changeset
2084
kono
parents:
diff changeset
2085 -- Result is empty slice, reuse empty shared string
kono
parents:
diff changeset
2086
kono
parents:
diff changeset
2087 elsif Low > High then
kono
parents:
diff changeset
2088 Reference (Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
2089 Target.Reference := Empty_Shared_Wide_Wide_String'Access;
kono
parents:
diff changeset
2090 Unreference (TR);
kono
parents:
diff changeset
2091
kono
parents:
diff changeset
2092 else
kono
parents:
diff changeset
2093 DL := High - Low + 1;
kono
parents:
diff changeset
2094
kono
parents:
diff changeset
2095 -- Try to reuse existent shared string
kono
parents:
diff changeset
2096
kono
parents:
diff changeset
2097 if Can_Be_Reused (TR, DL) then
kono
parents:
diff changeset
2098 TR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
2099 TR.Last := DL;
kono
parents:
diff changeset
2100
kono
parents:
diff changeset
2101 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
2102
kono
parents:
diff changeset
2103 else
kono
parents:
diff changeset
2104 DR := Allocate (DL);
kono
parents:
diff changeset
2105 DR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
2106 DR.Last := DL;
kono
parents:
diff changeset
2107 Target.Reference := DR;
kono
parents:
diff changeset
2108 Unreference (TR);
kono
parents:
diff changeset
2109 end if;
kono
parents:
diff changeset
2110 end if;
kono
parents:
diff changeset
2111 end Unbounded_Slice;
kono
parents:
diff changeset
2112
kono
parents:
diff changeset
2113 -----------------
kono
parents:
diff changeset
2114 -- Unreference --
kono
parents:
diff changeset
2115 -----------------
kono
parents:
diff changeset
2116
kono
parents:
diff changeset
2117 procedure Unreference (Item : not null Shared_Wide_Wide_String_Access) is
kono
parents:
diff changeset
2118
kono
parents:
diff changeset
2119 procedure Free is
kono
parents:
diff changeset
2120 new Ada.Unchecked_Deallocation
kono
parents:
diff changeset
2121 (Shared_Wide_Wide_String, Shared_Wide_Wide_String_Access);
kono
parents:
diff changeset
2122
kono
parents:
diff changeset
2123 Aux : Shared_Wide_Wide_String_Access := Item;
kono
parents:
diff changeset
2124
kono
parents:
diff changeset
2125 begin
kono
parents:
diff changeset
2126 if System.Atomic_Counters.Decrement (Aux.Counter) then
kono
parents:
diff changeset
2127
kono
parents:
diff changeset
2128 -- Reference counter of Empty_Shared_Wide_Wide_String must never
kono
parents:
diff changeset
2129 -- reach zero.
kono
parents:
diff changeset
2130
kono
parents:
diff changeset
2131 pragma Assert (Aux /= Empty_Shared_Wide_Wide_String'Access);
kono
parents:
diff changeset
2132
kono
parents:
diff changeset
2133 Free (Aux);
kono
parents:
diff changeset
2134 end if;
kono
parents:
diff changeset
2135 end Unreference;
kono
parents:
diff changeset
2136
kono
parents:
diff changeset
2137 end Ada.Strings.Wide_Wide_Unbounded;