annotate gcc/ada/libgnat/a-strunb__shared.adb @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
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 . 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 -- --
145
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
111
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.Search;
kono
parents:
diff changeset
33 with Ada.Unchecked_Deallocation;
kono
parents:
diff changeset
34
kono
parents:
diff changeset
35 package body Ada.Strings.Unbounded is
kono
parents:
diff changeset
36
kono
parents:
diff changeset
37 use Ada.Strings.Maps;
kono
parents:
diff changeset
38
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
39 Growth_Factor : constant := 2;
111
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
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
45 -- 2 means add 1/2 of the length of the string as growth space.
111
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 the
kono
parents:
diff changeset
56 -- allocated memory segments to use memory effectively by Append/Insert/etc
kono
parents:
diff changeset
57 -- 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_String;
kono
parents:
diff changeset
65 Right : Unbounded_String) return Unbounded_String
kono
parents:
diff changeset
66 is
kono
parents:
diff changeset
67 LR : constant Shared_String_Access := Left.Reference;
kono
parents:
diff changeset
68 RR : constant Shared_String_Access := Right.Reference;
kono
parents:
diff changeset
69 DL : constant Natural := LR.Last + RR.Last;
kono
parents:
diff changeset
70 DR : Shared_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_String'Access);
kono
parents:
diff changeset
77 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
78
kono
parents:
diff changeset
79 -- Left string is empty, return Right 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 -- Otherwise, 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_String;
kono
parents:
diff changeset
105 Right : String) return Unbounded_String
kono
parents:
diff changeset
106 is
kono
parents:
diff changeset
107 LR : constant Shared_String_Access := Left.Reference;
kono
parents:
diff changeset
108 DL : constant Natural := LR.Last + Right'Length;
kono
parents:
diff changeset
109 DR : Shared_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_String'Access);
kono
parents:
diff changeset
116 DR := Empty_Shared_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 : String;
kono
parents:
diff changeset
138 Right : Unbounded_String) return Unbounded_String
kono
parents:
diff changeset
139 is
kono
parents:
diff changeset
140 RR : constant Shared_String_Access := Right.Reference;
kono
parents:
diff changeset
141 DL : constant Natural := Left'Length + RR.Last;
kono
parents:
diff changeset
142 DR : Shared_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_String'Access);
kono
parents:
diff changeset
149 DR := Empty_Shared_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_String;
kono
parents:
diff changeset
171 Right : Character) return Unbounded_String
kono
parents:
diff changeset
172 is
kono
parents:
diff changeset
173 LR : constant Shared_String_Access := Left.Reference;
kono
parents:
diff changeset
174 DL : constant Natural := LR.Last + 1;
kono
parents:
diff changeset
175 DR : Shared_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 : Character;
kono
parents:
diff changeset
188 Right : Unbounded_String) return Unbounded_String
kono
parents:
diff changeset
189 is
kono
parents:
diff changeset
190 RR : constant Shared_String_Access := Right.Reference;
kono
parents:
diff changeset
191 DL : constant Natural := 1 + RR.Last;
kono
parents:
diff changeset
192 DR : Shared_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 : Character) return Unbounded_String
kono
parents:
diff changeset
210 is
kono
parents:
diff changeset
211 DR : Shared_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_String'Access);
kono
parents:
diff changeset
218 DR := Empty_Shared_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 : String) return Unbounded_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_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_String'Access);
kono
parents:
diff changeset
248 DR := Empty_Shared_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_String) return Unbounded_String
kono
parents:
diff changeset
270 is
kono
parents:
diff changeset
271 RR : constant Shared_String_Access := Right.Reference;
kono
parents:
diff changeset
272 DL : constant Natural := Left * RR.Last;
kono
parents:
diff changeset
273 DR : Shared_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_String'Access);
kono
parents:
diff changeset
281 DR := Empty_Shared_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_String;
kono
parents:
diff changeset
312 Right : Unbounded_String) return Boolean
kono
parents:
diff changeset
313 is
kono
parents:
diff changeset
314 LR : constant Shared_String_Access := Left.Reference;
kono
parents:
diff changeset
315 RR : constant Shared_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_String;
kono
parents:
diff changeset
322 Right : String) return Boolean
kono
parents:
diff changeset
323 is
kono
parents:
diff changeset
324 LR : constant Shared_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 : String;
kono
parents:
diff changeset
331 Right : Unbounded_String) return Boolean
kono
parents:
diff changeset
332 is
kono
parents:
diff changeset
333 RR : constant Shared_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_String;
kono
parents:
diff changeset
344 Right : Unbounded_String) return Boolean
kono
parents:
diff changeset
345 is
kono
parents:
diff changeset
346 LR : constant Shared_String_Access := Left.Reference;
kono
parents:
diff changeset
347 RR : constant Shared_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_String;
kono
parents:
diff changeset
357 Right : String) return Boolean
kono
parents:
diff changeset
358 is
kono
parents:
diff changeset
359 LR : constant Shared_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 : String;
kono
parents:
diff changeset
366 Right : Unbounded_String) return Boolean
kono
parents:
diff changeset
367 is
kono
parents:
diff changeset
368 RR : constant Shared_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_String;
kono
parents:
diff changeset
379 Right : Unbounded_String) return Boolean
kono
parents:
diff changeset
380 is
kono
parents:
diff changeset
381 LR : constant Shared_String_Access := Left.Reference;
kono
parents:
diff changeset
382 RR : constant Shared_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_String;
kono
parents:
diff changeset
391 Right : String) return Boolean
kono
parents:
diff changeset
392 is
kono
parents:
diff changeset
393 LR : constant Shared_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 : String;
kono
parents:
diff changeset
400 Right : Unbounded_String) return Boolean
kono
parents:
diff changeset
401 is
kono
parents:
diff changeset
402 RR : constant Shared_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_String;
kono
parents:
diff changeset
413 Right : Unbounded_String) return Boolean
kono
parents:
diff changeset
414 is
kono
parents:
diff changeset
415 LR : constant Shared_String_Access := Left.Reference;
kono
parents:
diff changeset
416 RR : constant Shared_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_String;
kono
parents:
diff changeset
423 Right : String) return Boolean
kono
parents:
diff changeset
424 is
kono
parents:
diff changeset
425 LR : constant Shared_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 : String;
kono
parents:
diff changeset
432 Right : Unbounded_String) return Boolean
kono
parents:
diff changeset
433 is
kono
parents:
diff changeset
434 RR : constant Shared_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_String;
kono
parents:
diff changeset
445 Right : Unbounded_String) return Boolean
kono
parents:
diff changeset
446 is
kono
parents:
diff changeset
447 LR : constant Shared_String_Access := Left.Reference;
kono
parents:
diff changeset
448 RR : constant Shared_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_String;
kono
parents:
diff changeset
458 Right : String) return Boolean
kono
parents:
diff changeset
459 is
kono
parents:
diff changeset
460 LR : constant Shared_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 : String;
kono
parents:
diff changeset
467 Right : Unbounded_String) return Boolean
kono
parents:
diff changeset
468 is
kono
parents:
diff changeset
469 RR : constant Shared_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_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_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 begin
kono
parents:
diff changeset
493 return
kono
parents:
diff changeset
494 ((Static_Size + Max_Length - 1) / Min_Mul_Alloc + 2) * Min_Mul_Alloc
kono
parents:
diff changeset
495 - Static_Size;
kono
parents:
diff changeset
496 end Aligned_Max_Length;
kono
parents:
diff changeset
497
kono
parents:
diff changeset
498 --------------
kono
parents:
diff changeset
499 -- Allocate --
kono
parents:
diff changeset
500 --------------
kono
parents:
diff changeset
501
kono
parents:
diff changeset
502 function Allocate
kono
parents:
diff changeset
503 (Max_Length : Natural) return not null Shared_String_Access
kono
parents:
diff changeset
504 is
kono
parents:
diff changeset
505 begin
kono
parents:
diff changeset
506 -- Empty string requested, return shared empty string
kono
parents:
diff changeset
507
kono
parents:
diff changeset
508 if Max_Length = 0 then
kono
parents:
diff changeset
509 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
510 return Empty_Shared_String'Access;
kono
parents:
diff changeset
511
kono
parents:
diff changeset
512 -- Otherwise, allocate requested space (and probably some more room)
kono
parents:
diff changeset
513
kono
parents:
diff changeset
514 else
kono
parents:
diff changeset
515 return new Shared_String (Aligned_Max_Length (Max_Length));
kono
parents:
diff changeset
516 end if;
kono
parents:
diff changeset
517 end Allocate;
kono
parents:
diff changeset
518
kono
parents:
diff changeset
519 ------------
kono
parents:
diff changeset
520 -- Append --
kono
parents:
diff changeset
521 ------------
kono
parents:
diff changeset
522
kono
parents:
diff changeset
523 procedure Append
kono
parents:
diff changeset
524 (Source : in out Unbounded_String;
kono
parents:
diff changeset
525 New_Item : Unbounded_String)
kono
parents:
diff changeset
526 is
kono
parents:
diff changeset
527 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
528 NR : constant Shared_String_Access := New_Item.Reference;
kono
parents:
diff changeset
529 DL : constant Natural := SR.Last + NR.Last;
kono
parents:
diff changeset
530 DR : Shared_String_Access;
kono
parents:
diff changeset
531
kono
parents:
diff changeset
532 begin
kono
parents:
diff changeset
533 -- Source is an empty string, reuse New_Item data
kono
parents:
diff changeset
534
kono
parents:
diff changeset
535 if SR.Last = 0 then
kono
parents:
diff changeset
536 Reference (NR);
kono
parents:
diff changeset
537 Source.Reference := NR;
kono
parents:
diff changeset
538 Unreference (SR);
kono
parents:
diff changeset
539
kono
parents:
diff changeset
540 -- New_Item is empty string, nothing to do
kono
parents:
diff changeset
541
kono
parents:
diff changeset
542 elsif NR.Last = 0 then
kono
parents:
diff changeset
543 null;
kono
parents:
diff changeset
544
kono
parents:
diff changeset
545 -- Try to reuse existing shared string
kono
parents:
diff changeset
546
kono
parents:
diff changeset
547 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
548 SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
kono
parents:
diff changeset
549 SR.Last := DL;
kono
parents:
diff changeset
550
kono
parents:
diff changeset
551 -- Otherwise, allocate new one and fill it
kono
parents:
diff changeset
552
kono
parents:
diff changeset
553 else
kono
parents:
diff changeset
554 DR := Allocate (DL + DL / Growth_Factor);
kono
parents:
diff changeset
555 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
556 DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
kono
parents:
diff changeset
557 DR.Last := DL;
kono
parents:
diff changeset
558 Source.Reference := DR;
kono
parents:
diff changeset
559 Unreference (SR);
kono
parents:
diff changeset
560 end if;
kono
parents:
diff changeset
561 end Append;
kono
parents:
diff changeset
562
kono
parents:
diff changeset
563 procedure Append
kono
parents:
diff changeset
564 (Source : in out Unbounded_String;
kono
parents:
diff changeset
565 New_Item : String)
kono
parents:
diff changeset
566 is
kono
parents:
diff changeset
567 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
568 DL : constant Natural := SR.Last + New_Item'Length;
kono
parents:
diff changeset
569 DR : Shared_String_Access;
kono
parents:
diff changeset
570
kono
parents:
diff changeset
571 begin
kono
parents:
diff changeset
572 -- New_Item is an empty string, nothing to do
kono
parents:
diff changeset
573
kono
parents:
diff changeset
574 if New_Item'Length = 0 then
kono
parents:
diff changeset
575 null;
kono
parents:
diff changeset
576
kono
parents:
diff changeset
577 -- Try to reuse existing shared string
kono
parents:
diff changeset
578
kono
parents:
diff changeset
579 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
580 SR.Data (SR.Last + 1 .. DL) := New_Item;
kono
parents:
diff changeset
581 SR.Last := DL;
kono
parents:
diff changeset
582
kono
parents:
diff changeset
583 -- Otherwise, allocate new one and fill it
kono
parents:
diff changeset
584
kono
parents:
diff changeset
585 else
kono
parents:
diff changeset
586 DR := Allocate (DL + DL / Growth_Factor);
kono
parents:
diff changeset
587 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
588 DR.Data (SR.Last + 1 .. DL) := New_Item;
kono
parents:
diff changeset
589 DR.Last := DL;
kono
parents:
diff changeset
590 Source.Reference := DR;
kono
parents:
diff changeset
591 Unreference (SR);
kono
parents:
diff changeset
592 end if;
kono
parents:
diff changeset
593 end Append;
kono
parents:
diff changeset
594
kono
parents:
diff changeset
595 procedure Append
kono
parents:
diff changeset
596 (Source : in out Unbounded_String;
kono
parents:
diff changeset
597 New_Item : Character)
kono
parents:
diff changeset
598 is
kono
parents:
diff changeset
599 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
600 DL : constant Natural := SR.Last + 1;
kono
parents:
diff changeset
601 DR : Shared_String_Access;
kono
parents:
diff changeset
602
kono
parents:
diff changeset
603 begin
kono
parents:
diff changeset
604 -- Try to reuse existing shared string
kono
parents:
diff changeset
605
kono
parents:
diff changeset
606 if Can_Be_Reused (SR, SR.Last + 1) then
kono
parents:
diff changeset
607 SR.Data (SR.Last + 1) := New_Item;
kono
parents:
diff changeset
608 SR.Last := SR.Last + 1;
kono
parents:
diff changeset
609
kono
parents:
diff changeset
610 -- Otherwise, allocate new one and fill it
kono
parents:
diff changeset
611
kono
parents:
diff changeset
612 else
kono
parents:
diff changeset
613 DR := Allocate (DL + DL / Growth_Factor);
kono
parents:
diff changeset
614 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
615 DR.Data (DL) := New_Item;
kono
parents:
diff changeset
616 DR.Last := DL;
kono
parents:
diff changeset
617 Source.Reference := DR;
kono
parents:
diff changeset
618 Unreference (SR);
kono
parents:
diff changeset
619 end if;
kono
parents:
diff changeset
620 end Append;
kono
parents:
diff changeset
621
kono
parents:
diff changeset
622 -------------------
kono
parents:
diff changeset
623 -- Can_Be_Reused --
kono
parents:
diff changeset
624 -------------------
kono
parents:
diff changeset
625
kono
parents:
diff changeset
626 function Can_Be_Reused
kono
parents:
diff changeset
627 (Item : not null Shared_String_Access;
kono
parents:
diff changeset
628 Length : Natural) return Boolean
kono
parents:
diff changeset
629 is
kono
parents:
diff changeset
630 begin
kono
parents:
diff changeset
631 return
kono
parents:
diff changeset
632 System.Atomic_Counters.Is_One (Item.Counter)
kono
parents:
diff changeset
633 and then Item.Max_Length >= Length
kono
parents:
diff changeset
634 and then Item.Max_Length <=
kono
parents:
diff changeset
635 Aligned_Max_Length (Length + Length / Growth_Factor);
kono
parents:
diff changeset
636 end Can_Be_Reused;
kono
parents:
diff changeset
637
kono
parents:
diff changeset
638 -----------
kono
parents:
diff changeset
639 -- Count --
kono
parents:
diff changeset
640 -----------
kono
parents:
diff changeset
641
kono
parents:
diff changeset
642 function Count
kono
parents:
diff changeset
643 (Source : Unbounded_String;
kono
parents:
diff changeset
644 Pattern : String;
kono
parents:
diff changeset
645 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
kono
parents:
diff changeset
646 is
kono
parents:
diff changeset
647 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
648 begin
kono
parents:
diff changeset
649 return Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
kono
parents:
diff changeset
650 end Count;
kono
parents:
diff changeset
651
kono
parents:
diff changeset
652 function Count
kono
parents:
diff changeset
653 (Source : Unbounded_String;
kono
parents:
diff changeset
654 Pattern : String;
kono
parents:
diff changeset
655 Mapping : Maps.Character_Mapping_Function) return Natural
kono
parents:
diff changeset
656 is
kono
parents:
diff changeset
657 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
658 begin
kono
parents:
diff changeset
659 return Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
kono
parents:
diff changeset
660 end Count;
kono
parents:
diff changeset
661
kono
parents:
diff changeset
662 function Count
kono
parents:
diff changeset
663 (Source : Unbounded_String;
kono
parents:
diff changeset
664 Set : Maps.Character_Set) return Natural
kono
parents:
diff changeset
665 is
kono
parents:
diff changeset
666 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
667 begin
kono
parents:
diff changeset
668 return Search.Count (SR.Data (1 .. SR.Last), Set);
kono
parents:
diff changeset
669 end Count;
kono
parents:
diff changeset
670
kono
parents:
diff changeset
671 ------------
kono
parents:
diff changeset
672 -- Delete --
kono
parents:
diff changeset
673 ------------
kono
parents:
diff changeset
674
kono
parents:
diff changeset
675 function Delete
kono
parents:
diff changeset
676 (Source : Unbounded_String;
kono
parents:
diff changeset
677 From : Positive;
kono
parents:
diff changeset
678 Through : Natural) return Unbounded_String
kono
parents:
diff changeset
679 is
kono
parents:
diff changeset
680 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
681 DL : Natural;
kono
parents:
diff changeset
682 DR : Shared_String_Access;
kono
parents:
diff changeset
683
kono
parents:
diff changeset
684 begin
kono
parents:
diff changeset
685 -- Empty slice is deleted, use the same shared string
kono
parents:
diff changeset
686
kono
parents:
diff changeset
687 if From > Through then
kono
parents:
diff changeset
688 Reference (SR);
kono
parents:
diff changeset
689 DR := SR;
kono
parents:
diff changeset
690
kono
parents:
diff changeset
691 -- Index is out of range
kono
parents:
diff changeset
692
kono
parents:
diff changeset
693 elsif Through > SR.Last then
kono
parents:
diff changeset
694 raise Index_Error;
kono
parents:
diff changeset
695
kono
parents:
diff changeset
696 -- Compute size of the result
kono
parents:
diff changeset
697
kono
parents:
diff changeset
698 else
kono
parents:
diff changeset
699 DL := SR.Last - (Through - From + 1);
kono
parents:
diff changeset
700
kono
parents:
diff changeset
701 -- Result is an empty string, reuse shared empty string
kono
parents:
diff changeset
702
kono
parents:
diff changeset
703 if DL = 0 then
kono
parents:
diff changeset
704 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
705 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
706
kono
parents:
diff changeset
707 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
708
kono
parents:
diff changeset
709 else
kono
parents:
diff changeset
710 DR := Allocate (DL);
kono
parents:
diff changeset
711 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
kono
parents:
diff changeset
712 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
kono
parents:
diff changeset
713 DR.Last := DL;
kono
parents:
diff changeset
714 end if;
kono
parents:
diff changeset
715 end if;
kono
parents:
diff changeset
716
kono
parents:
diff changeset
717 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
718 end Delete;
kono
parents:
diff changeset
719
kono
parents:
diff changeset
720 procedure Delete
kono
parents:
diff changeset
721 (Source : in out Unbounded_String;
kono
parents:
diff changeset
722 From : Positive;
kono
parents:
diff changeset
723 Through : Natural)
kono
parents:
diff changeset
724 is
kono
parents:
diff changeset
725 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
726 DL : Natural;
kono
parents:
diff changeset
727 DR : Shared_String_Access;
kono
parents:
diff changeset
728
kono
parents:
diff changeset
729 begin
kono
parents:
diff changeset
730 -- Nothing changed, return
kono
parents:
diff changeset
731
kono
parents:
diff changeset
732 if From > Through then
kono
parents:
diff changeset
733 null;
kono
parents:
diff changeset
734
kono
parents:
diff changeset
735 -- Through is outside of the range
kono
parents:
diff changeset
736
kono
parents:
diff changeset
737 elsif Through > SR.Last then
kono
parents:
diff changeset
738 raise Index_Error;
kono
parents:
diff changeset
739
kono
parents:
diff changeset
740 else
kono
parents:
diff changeset
741 DL := SR.Last - (Through - From + 1);
kono
parents:
diff changeset
742
kono
parents:
diff changeset
743 -- Result is empty, reuse shared empty string
kono
parents:
diff changeset
744
kono
parents:
diff changeset
745 if DL = 0 then
kono
parents:
diff changeset
746 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
747 Source.Reference := Empty_Shared_String'Access;
kono
parents:
diff changeset
748 Unreference (SR);
kono
parents:
diff changeset
749
kono
parents:
diff changeset
750 -- Try to reuse existing shared string
kono
parents:
diff changeset
751
kono
parents:
diff changeset
752 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
753 SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
kono
parents:
diff changeset
754 SR.Last := DL;
kono
parents:
diff changeset
755
kono
parents:
diff changeset
756 -- Otherwise, allocate new shared string
kono
parents:
diff changeset
757
kono
parents:
diff changeset
758 else
kono
parents:
diff changeset
759 DR := Allocate (DL);
kono
parents:
diff changeset
760 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
kono
parents:
diff changeset
761 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
kono
parents:
diff changeset
762 DR.Last := DL;
kono
parents:
diff changeset
763 Source.Reference := DR;
kono
parents:
diff changeset
764 Unreference (SR);
kono
parents:
diff changeset
765 end if;
kono
parents:
diff changeset
766 end if;
kono
parents:
diff changeset
767 end Delete;
kono
parents:
diff changeset
768
kono
parents:
diff changeset
769 -------------
kono
parents:
diff changeset
770 -- Element --
kono
parents:
diff changeset
771 -------------
kono
parents:
diff changeset
772
kono
parents:
diff changeset
773 function Element
kono
parents:
diff changeset
774 (Source : Unbounded_String;
kono
parents:
diff changeset
775 Index : Positive) return Character
kono
parents:
diff changeset
776 is
kono
parents:
diff changeset
777 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
778 begin
kono
parents:
diff changeset
779 if Index <= SR.Last then
kono
parents:
diff changeset
780 return SR.Data (Index);
kono
parents:
diff changeset
781 else
kono
parents:
diff changeset
782 raise Index_Error;
kono
parents:
diff changeset
783 end if;
kono
parents:
diff changeset
784 end Element;
kono
parents:
diff changeset
785
kono
parents:
diff changeset
786 --------------
kono
parents:
diff changeset
787 -- Finalize --
kono
parents:
diff changeset
788 --------------
kono
parents:
diff changeset
789
kono
parents:
diff changeset
790 procedure Finalize (Object : in out Unbounded_String) is
kono
parents:
diff changeset
791 SR : constant not null Shared_String_Access := Object.Reference;
kono
parents:
diff changeset
792 begin
kono
parents:
diff changeset
793 if SR /= Null_Unbounded_String.Reference then
kono
parents:
diff changeset
794
kono
parents:
diff changeset
795 -- The same controlled object can be finalized several times for
kono
parents:
diff changeset
796 -- some reason. As per 7.6.1(24) this should have no ill effect,
kono
parents:
diff changeset
797 -- so we need to add a guard for the case of finalizing the same
kono
parents:
diff changeset
798 -- object twice.
kono
parents:
diff changeset
799
kono
parents:
diff changeset
800 -- We set the Object to the empty string so there will be no ill
kono
parents:
diff changeset
801 -- effects if a program references an already-finalized object.
kono
parents:
diff changeset
802
kono
parents:
diff changeset
803 Object.Reference := Null_Unbounded_String.Reference;
kono
parents:
diff changeset
804 Reference (Object.Reference);
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_String;
kono
parents:
diff changeset
815 Set : Maps.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_String_Access := Source.Reference;
kono
parents:
diff changeset
822 begin
kono
parents:
diff changeset
823 Search.Find_Token (SR.Data (From .. SR.Last), Set, Test, First, Last);
kono
parents:
diff changeset
824 end Find_Token;
kono
parents:
diff changeset
825
kono
parents:
diff changeset
826 procedure Find_Token
kono
parents:
diff changeset
827 (Source : Unbounded_String;
kono
parents:
diff changeset
828 Set : Maps.Character_Set;
kono
parents:
diff changeset
829 Test : Strings.Membership;
kono
parents:
diff changeset
830 First : out Positive;
kono
parents:
diff changeset
831 Last : out Natural)
kono
parents:
diff changeset
832 is
kono
parents:
diff changeset
833 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
834 begin
kono
parents:
diff changeset
835 Search.Find_Token (SR.Data (1 .. SR.Last), Set, Test, First, Last);
kono
parents:
diff changeset
836 end Find_Token;
kono
parents:
diff changeset
837
kono
parents:
diff changeset
838 ----------
kono
parents:
diff changeset
839 -- Free --
kono
parents:
diff changeset
840 ----------
kono
parents:
diff changeset
841
kono
parents:
diff changeset
842 procedure Free (X : in out String_Access) is
kono
parents:
diff changeset
843 procedure Deallocate is
kono
parents:
diff changeset
844 new Ada.Unchecked_Deallocation (String, String_Access);
kono
parents:
diff changeset
845 begin
kono
parents:
diff changeset
846 Deallocate (X);
kono
parents:
diff changeset
847 end Free;
kono
parents:
diff changeset
848
kono
parents:
diff changeset
849 ----------
kono
parents:
diff changeset
850 -- Head --
kono
parents:
diff changeset
851 ----------
kono
parents:
diff changeset
852
kono
parents:
diff changeset
853 function Head
kono
parents:
diff changeset
854 (Source : Unbounded_String;
kono
parents:
diff changeset
855 Count : Natural;
kono
parents:
diff changeset
856 Pad : Character := Space) return Unbounded_String
kono
parents:
diff changeset
857 is
kono
parents:
diff changeset
858 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
859 DR : Shared_String_Access;
kono
parents:
diff changeset
860
kono
parents:
diff changeset
861 begin
kono
parents:
diff changeset
862 -- Result is empty, reuse shared empty string
kono
parents:
diff changeset
863
kono
parents:
diff changeset
864 if Count = 0 then
kono
parents:
diff changeset
865 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
866 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
867
kono
parents:
diff changeset
868 -- Length of the string is the same as requested, reuse source shared
kono
parents:
diff changeset
869 -- string.
kono
parents:
diff changeset
870
kono
parents:
diff changeset
871 elsif Count = SR.Last then
kono
parents:
diff changeset
872 Reference (SR);
kono
parents:
diff changeset
873 DR := SR;
kono
parents:
diff changeset
874
kono
parents:
diff changeset
875 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
876
kono
parents:
diff changeset
877 else
kono
parents:
diff changeset
878 DR := Allocate (Count);
kono
parents:
diff changeset
879
kono
parents:
diff changeset
880 -- Length of the source string is more than requested, copy
kono
parents:
diff changeset
881 -- corresponding slice.
kono
parents:
diff changeset
882
kono
parents:
diff changeset
883 if Count < SR.Last then
kono
parents:
diff changeset
884 DR.Data (1 .. Count) := SR.Data (1 .. Count);
kono
parents:
diff changeset
885
kono
parents:
diff changeset
886 -- Length of the source string is less than requested, copy all
kono
parents:
diff changeset
887 -- contents and fill others by Pad character.
kono
parents:
diff changeset
888
kono
parents:
diff changeset
889 else
kono
parents:
diff changeset
890 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
891
kono
parents:
diff changeset
892 for J in SR.Last + 1 .. Count loop
kono
parents:
diff changeset
893 DR.Data (J) := Pad;
kono
parents:
diff changeset
894 end loop;
kono
parents:
diff changeset
895 end if;
kono
parents:
diff changeset
896
kono
parents:
diff changeset
897 DR.Last := Count;
kono
parents:
diff changeset
898 end if;
kono
parents:
diff changeset
899
kono
parents:
diff changeset
900 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
901 end Head;
kono
parents:
diff changeset
902
kono
parents:
diff changeset
903 procedure Head
kono
parents:
diff changeset
904 (Source : in out Unbounded_String;
kono
parents:
diff changeset
905 Count : Natural;
kono
parents:
diff changeset
906 Pad : Character := Space)
kono
parents:
diff changeset
907 is
kono
parents:
diff changeset
908 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
909 DR : Shared_String_Access;
kono
parents:
diff changeset
910
kono
parents:
diff changeset
911 begin
kono
parents:
diff changeset
912 -- Result is empty, reuse empty shared string
kono
parents:
diff changeset
913
kono
parents:
diff changeset
914 if Count = 0 then
kono
parents:
diff changeset
915 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
916 Source.Reference := Empty_Shared_String'Access;
kono
parents:
diff changeset
917 Unreference (SR);
kono
parents:
diff changeset
918
kono
parents:
diff changeset
919 -- Result is same as source string, reuse source shared string
kono
parents:
diff changeset
920
kono
parents:
diff changeset
921 elsif Count = SR.Last then
kono
parents:
diff changeset
922 null;
kono
parents:
diff changeset
923
kono
parents:
diff changeset
924 -- Try to reuse existing shared string
kono
parents:
diff changeset
925
kono
parents:
diff changeset
926 elsif Can_Be_Reused (SR, Count) then
kono
parents:
diff changeset
927 if Count > SR.Last then
kono
parents:
diff changeset
928 for J in SR.Last + 1 .. Count loop
kono
parents:
diff changeset
929 SR.Data (J) := Pad;
kono
parents:
diff changeset
930 end loop;
kono
parents:
diff changeset
931 end if;
kono
parents:
diff changeset
932
kono
parents:
diff changeset
933 SR.Last := Count;
kono
parents:
diff changeset
934
kono
parents:
diff changeset
935 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
936
kono
parents:
diff changeset
937 else
kono
parents:
diff changeset
938 DR := Allocate (Count);
kono
parents:
diff changeset
939
kono
parents:
diff changeset
940 -- Length of the source string is greater than requested, copy
kono
parents:
diff changeset
941 -- corresponding slice.
kono
parents:
diff changeset
942
kono
parents:
diff changeset
943 if Count < SR.Last then
kono
parents:
diff changeset
944 DR.Data (1 .. Count) := SR.Data (1 .. Count);
kono
parents:
diff changeset
945
kono
parents:
diff changeset
946 -- Length of the source string is less than requested, copy all
kono
parents:
diff changeset
947 -- existing data and fill remaining positions with Pad characters.
kono
parents:
diff changeset
948
kono
parents:
diff changeset
949 else
kono
parents:
diff changeset
950 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
951
kono
parents:
diff changeset
952 for J in SR.Last + 1 .. Count loop
kono
parents:
diff changeset
953 DR.Data (J) := Pad;
kono
parents:
diff changeset
954 end loop;
kono
parents:
diff changeset
955 end if;
kono
parents:
diff changeset
956
kono
parents:
diff changeset
957 DR.Last := Count;
kono
parents:
diff changeset
958 Source.Reference := DR;
kono
parents:
diff changeset
959 Unreference (SR);
kono
parents:
diff changeset
960 end if;
kono
parents:
diff changeset
961 end Head;
kono
parents:
diff changeset
962
kono
parents:
diff changeset
963 -----------
kono
parents:
diff changeset
964 -- Index --
kono
parents:
diff changeset
965 -----------
kono
parents:
diff changeset
966
kono
parents:
diff changeset
967 function Index
kono
parents:
diff changeset
968 (Source : Unbounded_String;
kono
parents:
diff changeset
969 Pattern : String;
kono
parents:
diff changeset
970 Going : Strings.Direction := Strings.Forward;
kono
parents:
diff changeset
971 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
kono
parents:
diff changeset
972 is
kono
parents:
diff changeset
973 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
974 begin
kono
parents:
diff changeset
975 return Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
kono
parents:
diff changeset
976 end Index;
kono
parents:
diff changeset
977
kono
parents:
diff changeset
978 function Index
kono
parents:
diff changeset
979 (Source : Unbounded_String;
kono
parents:
diff changeset
980 Pattern : String;
kono
parents:
diff changeset
981 Going : Direction := Forward;
kono
parents:
diff changeset
982 Mapping : Maps.Character_Mapping_Function) return Natural
kono
parents:
diff changeset
983 is
kono
parents:
diff changeset
984 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
985 begin
kono
parents:
diff changeset
986 return Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
kono
parents:
diff changeset
987 end Index;
kono
parents:
diff changeset
988
kono
parents:
diff changeset
989 function Index
kono
parents:
diff changeset
990 (Source : Unbounded_String;
kono
parents:
diff changeset
991 Set : Maps.Character_Set;
kono
parents:
diff changeset
992 Test : Strings.Membership := Strings.Inside;
kono
parents:
diff changeset
993 Going : Strings.Direction := Strings.Forward) return Natural
kono
parents:
diff changeset
994 is
kono
parents:
diff changeset
995 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
996 begin
kono
parents:
diff changeset
997 return Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going);
kono
parents:
diff changeset
998 end Index;
kono
parents:
diff changeset
999
kono
parents:
diff changeset
1000 function Index
kono
parents:
diff changeset
1001 (Source : Unbounded_String;
kono
parents:
diff changeset
1002 Pattern : String;
kono
parents:
diff changeset
1003 From : Positive;
kono
parents:
diff changeset
1004 Going : Direction := Forward;
kono
parents:
diff changeset
1005 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
kono
parents:
diff changeset
1006 is
kono
parents:
diff changeset
1007 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1008 begin
kono
parents:
diff changeset
1009 return Search.Index
kono
parents:
diff changeset
1010 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
kono
parents:
diff changeset
1011 end Index;
kono
parents:
diff changeset
1012
kono
parents:
diff changeset
1013 function Index
kono
parents:
diff changeset
1014 (Source : Unbounded_String;
kono
parents:
diff changeset
1015 Pattern : String;
kono
parents:
diff changeset
1016 From : Positive;
kono
parents:
diff changeset
1017 Going : Direction := Forward;
kono
parents:
diff changeset
1018 Mapping : Maps.Character_Mapping_Function) return Natural
kono
parents:
diff changeset
1019 is
kono
parents:
diff changeset
1020 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1021 begin
kono
parents:
diff changeset
1022 return Search.Index
kono
parents:
diff changeset
1023 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
kono
parents:
diff changeset
1024 end Index;
kono
parents:
diff changeset
1025
kono
parents:
diff changeset
1026 function Index
kono
parents:
diff changeset
1027 (Source : Unbounded_String;
kono
parents:
diff changeset
1028 Set : Maps.Character_Set;
kono
parents:
diff changeset
1029 From : Positive;
kono
parents:
diff changeset
1030 Test : Membership := Inside;
kono
parents:
diff changeset
1031 Going : Direction := Forward) return Natural
kono
parents:
diff changeset
1032 is
kono
parents:
diff changeset
1033 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1034 begin
kono
parents:
diff changeset
1035 return Search.Index (SR.Data (1 .. SR.Last), Set, From, Test, Going);
kono
parents:
diff changeset
1036 end Index;
kono
parents:
diff changeset
1037
kono
parents:
diff changeset
1038 ---------------------
kono
parents:
diff changeset
1039 -- Index_Non_Blank --
kono
parents:
diff changeset
1040 ---------------------
kono
parents:
diff changeset
1041
kono
parents:
diff changeset
1042 function Index_Non_Blank
kono
parents:
diff changeset
1043 (Source : Unbounded_String;
kono
parents:
diff changeset
1044 Going : Strings.Direction := Strings.Forward) return Natural
kono
parents:
diff changeset
1045 is
kono
parents:
diff changeset
1046 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1047 begin
kono
parents:
diff changeset
1048 return Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going);
kono
parents:
diff changeset
1049 end Index_Non_Blank;
kono
parents:
diff changeset
1050
kono
parents:
diff changeset
1051 function Index_Non_Blank
kono
parents:
diff changeset
1052 (Source : Unbounded_String;
kono
parents:
diff changeset
1053 From : Positive;
kono
parents:
diff changeset
1054 Going : Direction := Forward) return Natural
kono
parents:
diff changeset
1055 is
kono
parents:
diff changeset
1056 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1057 begin
kono
parents:
diff changeset
1058 return Search.Index_Non_Blank (SR.Data (1 .. SR.Last), From, Going);
kono
parents:
diff changeset
1059 end Index_Non_Blank;
kono
parents:
diff changeset
1060
kono
parents:
diff changeset
1061 ----------------
kono
parents:
diff changeset
1062 -- Initialize --
kono
parents:
diff changeset
1063 ----------------
kono
parents:
diff changeset
1064
kono
parents:
diff changeset
1065 procedure Initialize (Object : in out Unbounded_String) is
kono
parents:
diff changeset
1066 begin
kono
parents:
diff changeset
1067 Reference (Object.Reference);
kono
parents:
diff changeset
1068 end Initialize;
kono
parents:
diff changeset
1069
kono
parents:
diff changeset
1070 ------------
kono
parents:
diff changeset
1071 -- Insert --
kono
parents:
diff changeset
1072 ------------
kono
parents:
diff changeset
1073
kono
parents:
diff changeset
1074 function Insert
kono
parents:
diff changeset
1075 (Source : Unbounded_String;
kono
parents:
diff changeset
1076 Before : Positive;
kono
parents:
diff changeset
1077 New_Item : String) return Unbounded_String
kono
parents:
diff changeset
1078 is
kono
parents:
diff changeset
1079 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1080 DL : constant Natural := SR.Last + New_Item'Length;
kono
parents:
diff changeset
1081 DR : Shared_String_Access;
kono
parents:
diff changeset
1082
kono
parents:
diff changeset
1083 begin
kono
parents:
diff changeset
1084 -- Check index first
kono
parents:
diff changeset
1085
kono
parents:
diff changeset
1086 if Before > SR.Last + 1 then
kono
parents:
diff changeset
1087 raise Index_Error;
kono
parents:
diff changeset
1088 end if;
kono
parents:
diff changeset
1089
kono
parents:
diff changeset
1090 -- Result is empty, reuse empty shared string
kono
parents:
diff changeset
1091
kono
parents:
diff changeset
1092 if DL = 0 then
kono
parents:
diff changeset
1093 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1094 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
1095
kono
parents:
diff changeset
1096 -- Inserted string is empty, reuse source shared string
kono
parents:
diff changeset
1097
kono
parents:
diff changeset
1098 elsif New_Item'Length = 0 then
kono
parents:
diff changeset
1099 Reference (SR);
kono
parents:
diff changeset
1100 DR := SR;
kono
parents:
diff changeset
1101
kono
parents:
diff changeset
1102 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
1103
kono
parents:
diff changeset
1104 else
kono
parents:
diff changeset
1105 DR := Allocate (DL + DL / Growth_Factor);
kono
parents:
diff changeset
1106 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
kono
parents:
diff changeset
1107 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
kono
parents:
diff changeset
1108 DR.Data (Before + New_Item'Length .. DL) :=
kono
parents:
diff changeset
1109 SR.Data (Before .. SR.Last);
kono
parents:
diff changeset
1110 DR.Last := DL;
kono
parents:
diff changeset
1111 end if;
kono
parents:
diff changeset
1112
kono
parents:
diff changeset
1113 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1114 end Insert;
kono
parents:
diff changeset
1115
kono
parents:
diff changeset
1116 procedure Insert
kono
parents:
diff changeset
1117 (Source : in out Unbounded_String;
kono
parents:
diff changeset
1118 Before : Positive;
kono
parents:
diff changeset
1119 New_Item : String)
kono
parents:
diff changeset
1120 is
kono
parents:
diff changeset
1121 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1122 DL : constant Natural := SR.Last + New_Item'Length;
kono
parents:
diff changeset
1123 DR : Shared_String_Access;
kono
parents:
diff changeset
1124
kono
parents:
diff changeset
1125 begin
kono
parents:
diff changeset
1126 -- Check bounds
kono
parents:
diff changeset
1127
kono
parents:
diff changeset
1128 if Before > SR.Last + 1 then
kono
parents:
diff changeset
1129 raise Index_Error;
kono
parents:
diff changeset
1130 end if;
kono
parents:
diff changeset
1131
kono
parents:
diff changeset
1132 -- Result is empty string, reuse empty shared string
kono
parents:
diff changeset
1133
kono
parents:
diff changeset
1134 if DL = 0 then
kono
parents:
diff changeset
1135 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1136 Source.Reference := Empty_Shared_String'Access;
kono
parents:
diff changeset
1137 Unreference (SR);
kono
parents:
diff changeset
1138
kono
parents:
diff changeset
1139 -- Inserted string is empty, nothing to do
kono
parents:
diff changeset
1140
kono
parents:
diff changeset
1141 elsif New_Item'Length = 0 then
kono
parents:
diff changeset
1142 null;
kono
parents:
diff changeset
1143
kono
parents:
diff changeset
1144 -- Try to reuse existing shared string first
kono
parents:
diff changeset
1145
kono
parents:
diff changeset
1146 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
1147 SR.Data (Before + New_Item'Length .. DL) :=
kono
parents:
diff changeset
1148 SR.Data (Before .. SR.Last);
kono
parents:
diff changeset
1149 SR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
kono
parents:
diff changeset
1150 SR.Last := DL;
kono
parents:
diff changeset
1151
kono
parents:
diff changeset
1152 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
1153
kono
parents:
diff changeset
1154 else
kono
parents:
diff changeset
1155 DR := Allocate (DL + DL / Growth_Factor);
kono
parents:
diff changeset
1156 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
kono
parents:
diff changeset
1157 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
kono
parents:
diff changeset
1158 DR.Data (Before + New_Item'Length .. DL) :=
kono
parents:
diff changeset
1159 SR.Data (Before .. SR.Last);
kono
parents:
diff changeset
1160 DR.Last := DL;
kono
parents:
diff changeset
1161 Source.Reference := DR;
kono
parents:
diff changeset
1162 Unreference (SR);
kono
parents:
diff changeset
1163 end if;
kono
parents:
diff changeset
1164 end Insert;
kono
parents:
diff changeset
1165
kono
parents:
diff changeset
1166 ------------
kono
parents:
diff changeset
1167 -- Length --
kono
parents:
diff changeset
1168 ------------
kono
parents:
diff changeset
1169
kono
parents:
diff changeset
1170 function Length (Source : Unbounded_String) return Natural is
kono
parents:
diff changeset
1171 begin
kono
parents:
diff changeset
1172 return Source.Reference.Last;
kono
parents:
diff changeset
1173 end Length;
kono
parents:
diff changeset
1174
kono
parents:
diff changeset
1175 ---------------
kono
parents:
diff changeset
1176 -- Overwrite --
kono
parents:
diff changeset
1177 ---------------
kono
parents:
diff changeset
1178
kono
parents:
diff changeset
1179 function Overwrite
kono
parents:
diff changeset
1180 (Source : Unbounded_String;
kono
parents:
diff changeset
1181 Position : Positive;
kono
parents:
diff changeset
1182 New_Item : String) return Unbounded_String
kono
parents:
diff changeset
1183 is
kono
parents:
diff changeset
1184 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1185 DL : Natural;
kono
parents:
diff changeset
1186 DR : Shared_String_Access;
kono
parents:
diff changeset
1187
kono
parents:
diff changeset
1188 begin
kono
parents:
diff changeset
1189 -- Check bounds
kono
parents:
diff changeset
1190
kono
parents:
diff changeset
1191 if Position > SR.Last + 1 then
kono
parents:
diff changeset
1192 raise Index_Error;
kono
parents:
diff changeset
1193 end if;
kono
parents:
diff changeset
1194
kono
parents:
diff changeset
1195 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
kono
parents:
diff changeset
1196
kono
parents:
diff changeset
1197 -- Result is empty string, reuse empty shared string
kono
parents:
diff changeset
1198
kono
parents:
diff changeset
1199 if DL = 0 then
kono
parents:
diff changeset
1200 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1201 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
1202
kono
parents:
diff changeset
1203 -- Result is same as source string, reuse source shared string
kono
parents:
diff changeset
1204
kono
parents:
diff changeset
1205 elsif New_Item'Length = 0 then
kono
parents:
diff changeset
1206 Reference (SR);
kono
parents:
diff changeset
1207 DR := SR;
kono
parents:
diff changeset
1208
kono
parents:
diff changeset
1209 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
1210
kono
parents:
diff changeset
1211 else
kono
parents:
diff changeset
1212 DR := Allocate (DL);
kono
parents:
diff changeset
1213 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
kono
parents:
diff changeset
1214 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
kono
parents:
diff changeset
1215 DR.Data (Position + New_Item'Length .. DL) :=
kono
parents:
diff changeset
1216 SR.Data (Position + New_Item'Length .. SR.Last);
kono
parents:
diff changeset
1217 DR.Last := DL;
kono
parents:
diff changeset
1218 end if;
kono
parents:
diff changeset
1219
kono
parents:
diff changeset
1220 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1221 end Overwrite;
kono
parents:
diff changeset
1222
kono
parents:
diff changeset
1223 procedure Overwrite
kono
parents:
diff changeset
1224 (Source : in out Unbounded_String;
kono
parents:
diff changeset
1225 Position : Positive;
kono
parents:
diff changeset
1226 New_Item : String)
kono
parents:
diff changeset
1227 is
kono
parents:
diff changeset
1228 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1229 DL : Natural;
kono
parents:
diff changeset
1230 DR : Shared_String_Access;
kono
parents:
diff changeset
1231
kono
parents:
diff changeset
1232 begin
kono
parents:
diff changeset
1233 -- Bounds check
kono
parents:
diff changeset
1234
kono
parents:
diff changeset
1235 if Position > SR.Last + 1 then
kono
parents:
diff changeset
1236 raise Index_Error;
kono
parents:
diff changeset
1237 end if;
kono
parents:
diff changeset
1238
kono
parents:
diff changeset
1239 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
kono
parents:
diff changeset
1240
kono
parents:
diff changeset
1241 -- Result is empty string, reuse empty shared string
kono
parents:
diff changeset
1242
kono
parents:
diff changeset
1243 if DL = 0 then
kono
parents:
diff changeset
1244 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1245 Source.Reference := Empty_Shared_String'Access;
kono
parents:
diff changeset
1246 Unreference (SR);
kono
parents:
diff changeset
1247
kono
parents:
diff changeset
1248 -- String unchanged, nothing to do
kono
parents:
diff changeset
1249
kono
parents:
diff changeset
1250 elsif New_Item'Length = 0 then
kono
parents:
diff changeset
1251 null;
kono
parents:
diff changeset
1252
kono
parents:
diff changeset
1253 -- Try to reuse existing shared string
kono
parents:
diff changeset
1254
kono
parents:
diff changeset
1255 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
1256 SR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
kono
parents:
diff changeset
1257 SR.Last := DL;
kono
parents:
diff changeset
1258
kono
parents:
diff changeset
1259 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1260
kono
parents:
diff changeset
1261 else
kono
parents:
diff changeset
1262 DR := Allocate (DL);
kono
parents:
diff changeset
1263 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
kono
parents:
diff changeset
1264 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
kono
parents:
diff changeset
1265 DR.Data (Position + New_Item'Length .. DL) :=
kono
parents:
diff changeset
1266 SR.Data (Position + New_Item'Length .. SR.Last);
kono
parents:
diff changeset
1267 DR.Last := DL;
kono
parents:
diff changeset
1268 Source.Reference := DR;
kono
parents:
diff changeset
1269 Unreference (SR);
kono
parents:
diff changeset
1270 end if;
kono
parents:
diff changeset
1271 end Overwrite;
kono
parents:
diff changeset
1272
kono
parents:
diff changeset
1273 ---------------
kono
parents:
diff changeset
1274 -- Reference --
kono
parents:
diff changeset
1275 ---------------
kono
parents:
diff changeset
1276
kono
parents:
diff changeset
1277 procedure Reference (Item : not null Shared_String_Access) is
kono
parents:
diff changeset
1278 begin
kono
parents:
diff changeset
1279 System.Atomic_Counters.Increment (Item.Counter);
kono
parents:
diff changeset
1280 end Reference;
kono
parents:
diff changeset
1281
kono
parents:
diff changeset
1282 ---------------------
kono
parents:
diff changeset
1283 -- Replace_Element --
kono
parents:
diff changeset
1284 ---------------------
kono
parents:
diff changeset
1285
kono
parents:
diff changeset
1286 procedure Replace_Element
kono
parents:
diff changeset
1287 (Source : in out Unbounded_String;
kono
parents:
diff changeset
1288 Index : Positive;
kono
parents:
diff changeset
1289 By : Character)
kono
parents:
diff changeset
1290 is
kono
parents:
diff changeset
1291 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1292 DR : Shared_String_Access;
kono
parents:
diff changeset
1293
kono
parents:
diff changeset
1294 begin
kono
parents:
diff changeset
1295 -- Bounds check
kono
parents:
diff changeset
1296
kono
parents:
diff changeset
1297 if Index <= SR.Last then
kono
parents:
diff changeset
1298
kono
parents:
diff changeset
1299 -- Try to reuse existing shared string
kono
parents:
diff changeset
1300
kono
parents:
diff changeset
1301 if Can_Be_Reused (SR, SR.Last) then
kono
parents:
diff changeset
1302 SR.Data (Index) := By;
kono
parents:
diff changeset
1303
kono
parents:
diff changeset
1304 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1305
kono
parents:
diff changeset
1306 else
kono
parents:
diff changeset
1307 DR := Allocate (SR.Last);
kono
parents:
diff changeset
1308 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
1309 DR.Data (Index) := By;
kono
parents:
diff changeset
1310 DR.Last := SR.Last;
kono
parents:
diff changeset
1311 Source.Reference := DR;
kono
parents:
diff changeset
1312 Unreference (SR);
kono
parents:
diff changeset
1313 end if;
kono
parents:
diff changeset
1314
kono
parents:
diff changeset
1315 else
kono
parents:
diff changeset
1316 raise Index_Error;
kono
parents:
diff changeset
1317 end if;
kono
parents:
diff changeset
1318 end Replace_Element;
kono
parents:
diff changeset
1319
kono
parents:
diff changeset
1320 -------------------
kono
parents:
diff changeset
1321 -- Replace_Slice --
kono
parents:
diff changeset
1322 -------------------
kono
parents:
diff changeset
1323
kono
parents:
diff changeset
1324 function Replace_Slice
kono
parents:
diff changeset
1325 (Source : Unbounded_String;
kono
parents:
diff changeset
1326 Low : Positive;
kono
parents:
diff changeset
1327 High : Natural;
kono
parents:
diff changeset
1328 By : String) return Unbounded_String
kono
parents:
diff changeset
1329 is
kono
parents:
diff changeset
1330 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1331 DL : Natural;
kono
parents:
diff changeset
1332 DR : Shared_String_Access;
kono
parents:
diff changeset
1333
kono
parents:
diff changeset
1334 begin
kono
parents:
diff changeset
1335 -- Check bounds
kono
parents:
diff changeset
1336
kono
parents:
diff changeset
1337 if Low > SR.Last + 1 then
kono
parents:
diff changeset
1338 raise Index_Error;
kono
parents:
diff changeset
1339 end if;
kono
parents:
diff changeset
1340
kono
parents:
diff changeset
1341 -- Do replace operation when removed slice is not empty
kono
parents:
diff changeset
1342
kono
parents:
diff changeset
1343 if High >= Low then
kono
parents:
diff changeset
1344 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
kono
parents:
diff changeset
1345 -- This is the number of characters remaining in the string after
kono
parents:
diff changeset
1346 -- replacing the slice.
kono
parents:
diff changeset
1347
kono
parents:
diff changeset
1348 -- Result is empty string, reuse empty shared string
kono
parents:
diff changeset
1349
kono
parents:
diff changeset
1350 if DL = 0 then
kono
parents:
diff changeset
1351 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1352 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
1353
kono
parents:
diff changeset
1354 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1355
kono
parents:
diff changeset
1356 else
kono
parents:
diff changeset
1357 DR := Allocate (DL);
kono
parents:
diff changeset
1358 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
kono
parents:
diff changeset
1359 DR.Data (Low .. Low + By'Length - 1) := By;
kono
parents:
diff changeset
1360 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
kono
parents:
diff changeset
1361 DR.Last := DL;
kono
parents:
diff changeset
1362 end if;
kono
parents:
diff changeset
1363
kono
parents:
diff changeset
1364 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1365
kono
parents:
diff changeset
1366 -- Otherwise just insert string
kono
parents:
diff changeset
1367
kono
parents:
diff changeset
1368 else
kono
parents:
diff changeset
1369 return Insert (Source, Low, By);
kono
parents:
diff changeset
1370 end if;
kono
parents:
diff changeset
1371 end Replace_Slice;
kono
parents:
diff changeset
1372
kono
parents:
diff changeset
1373 procedure Replace_Slice
kono
parents:
diff changeset
1374 (Source : in out Unbounded_String;
kono
parents:
diff changeset
1375 Low : Positive;
kono
parents:
diff changeset
1376 High : Natural;
kono
parents:
diff changeset
1377 By : String)
kono
parents:
diff changeset
1378 is
kono
parents:
diff changeset
1379 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1380 DL : Natural;
kono
parents:
diff changeset
1381 DR : Shared_String_Access;
kono
parents:
diff changeset
1382
kono
parents:
diff changeset
1383 begin
kono
parents:
diff changeset
1384 -- Bounds check
kono
parents:
diff changeset
1385
kono
parents:
diff changeset
1386 if Low > SR.Last + 1 then
kono
parents:
diff changeset
1387 raise Index_Error;
kono
parents:
diff changeset
1388 end if;
kono
parents:
diff changeset
1389
kono
parents:
diff changeset
1390 -- Do replace operation only when replaced slice is not empty
kono
parents:
diff changeset
1391
kono
parents:
diff changeset
1392 if High >= Low then
kono
parents:
diff changeset
1393 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
kono
parents:
diff changeset
1394 -- This is the number of characters remaining in the string after
kono
parents:
diff changeset
1395 -- replacing the slice.
kono
parents:
diff changeset
1396
kono
parents:
diff changeset
1397 -- Result is empty string, reuse empty shared string
kono
parents:
diff changeset
1398
kono
parents:
diff changeset
1399 if DL = 0 then
kono
parents:
diff changeset
1400 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1401 Source.Reference := Empty_Shared_String'Access;
kono
parents:
diff changeset
1402 Unreference (SR);
kono
parents:
diff changeset
1403
kono
parents:
diff changeset
1404 -- Try to reuse existing shared string
kono
parents:
diff changeset
1405
kono
parents:
diff changeset
1406 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
1407 SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
kono
parents:
diff changeset
1408 SR.Data (Low .. Low + By'Length - 1) := By;
kono
parents:
diff changeset
1409 SR.Last := DL;
kono
parents:
diff changeset
1410
kono
parents:
diff changeset
1411 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1412
kono
parents:
diff changeset
1413 else
kono
parents:
diff changeset
1414 DR := Allocate (DL);
kono
parents:
diff changeset
1415 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
kono
parents:
diff changeset
1416 DR.Data (Low .. Low + By'Length - 1) := By;
kono
parents:
diff changeset
1417 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
kono
parents:
diff changeset
1418 DR.Last := DL;
kono
parents:
diff changeset
1419 Source.Reference := DR;
kono
parents:
diff changeset
1420 Unreference (SR);
kono
parents:
diff changeset
1421 end if;
kono
parents:
diff changeset
1422
kono
parents:
diff changeset
1423 -- Otherwise just insert item
kono
parents:
diff changeset
1424
kono
parents:
diff changeset
1425 else
kono
parents:
diff changeset
1426 Insert (Source, Low, By);
kono
parents:
diff changeset
1427 end if;
kono
parents:
diff changeset
1428 end Replace_Slice;
kono
parents:
diff changeset
1429
kono
parents:
diff changeset
1430 --------------------------
kono
parents:
diff changeset
1431 -- Set_Unbounded_String --
kono
parents:
diff changeset
1432 --------------------------
kono
parents:
diff changeset
1433
kono
parents:
diff changeset
1434 procedure Set_Unbounded_String
kono
parents:
diff changeset
1435 (Target : out Unbounded_String;
kono
parents:
diff changeset
1436 Source : String)
kono
parents:
diff changeset
1437 is
kono
parents:
diff changeset
1438 TR : constant Shared_String_Access := Target.Reference;
kono
parents:
diff changeset
1439 DR : Shared_String_Access;
kono
parents:
diff changeset
1440
kono
parents:
diff changeset
1441 begin
kono
parents:
diff changeset
1442 -- In case of empty string, reuse empty shared string
kono
parents:
diff changeset
1443
kono
parents:
diff changeset
1444 if Source'Length = 0 then
kono
parents:
diff changeset
1445 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1446 Target.Reference := Empty_Shared_String'Access;
kono
parents:
diff changeset
1447
kono
parents:
diff changeset
1448 else
kono
parents:
diff changeset
1449 -- Try to reuse existing shared string
kono
parents:
diff changeset
1450
kono
parents:
diff changeset
1451 if Can_Be_Reused (TR, Source'Length) then
kono
parents:
diff changeset
1452 Reference (TR);
kono
parents:
diff changeset
1453 DR := TR;
kono
parents:
diff changeset
1454
kono
parents:
diff changeset
1455 -- Otherwise allocate new shared string
kono
parents:
diff changeset
1456
kono
parents:
diff changeset
1457 else
kono
parents:
diff changeset
1458 DR := Allocate (Source'Length);
kono
parents:
diff changeset
1459 Target.Reference := DR;
kono
parents:
diff changeset
1460 end if;
kono
parents:
diff changeset
1461
kono
parents:
diff changeset
1462 DR.Data (1 .. Source'Length) := Source;
kono
parents:
diff changeset
1463 DR.Last := Source'Length;
kono
parents:
diff changeset
1464 end if;
kono
parents:
diff changeset
1465
kono
parents:
diff changeset
1466 Unreference (TR);
kono
parents:
diff changeset
1467 end Set_Unbounded_String;
kono
parents:
diff changeset
1468
kono
parents:
diff changeset
1469 -----------
kono
parents:
diff changeset
1470 -- Slice --
kono
parents:
diff changeset
1471 -----------
kono
parents:
diff changeset
1472
kono
parents:
diff changeset
1473 function Slice
kono
parents:
diff changeset
1474 (Source : Unbounded_String;
kono
parents:
diff changeset
1475 Low : Positive;
kono
parents:
diff changeset
1476 High : Natural) return String
kono
parents:
diff changeset
1477 is
kono
parents:
diff changeset
1478 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1479
kono
parents:
diff changeset
1480 begin
kono
parents:
diff changeset
1481 -- Note: test of High > Length is in accordance with AI95-00128
kono
parents:
diff changeset
1482
kono
parents:
diff changeset
1483 if Low > SR.Last + 1 or else High > SR.Last then
kono
parents:
diff changeset
1484 raise Index_Error;
kono
parents:
diff changeset
1485
kono
parents:
diff changeset
1486 else
kono
parents:
diff changeset
1487 return SR.Data (Low .. High);
kono
parents:
diff changeset
1488 end if;
kono
parents:
diff changeset
1489 end Slice;
kono
parents:
diff changeset
1490
kono
parents:
diff changeset
1491 ----------
kono
parents:
diff changeset
1492 -- Tail --
kono
parents:
diff changeset
1493 ----------
kono
parents:
diff changeset
1494
kono
parents:
diff changeset
1495 function Tail
kono
parents:
diff changeset
1496 (Source : Unbounded_String;
kono
parents:
diff changeset
1497 Count : Natural;
kono
parents:
diff changeset
1498 Pad : Character := Space) return Unbounded_String
kono
parents:
diff changeset
1499 is
kono
parents:
diff changeset
1500 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1501 DR : Shared_String_Access;
kono
parents:
diff changeset
1502
kono
parents:
diff changeset
1503 begin
kono
parents:
diff changeset
1504 -- For empty result reuse empty shared string
kono
parents:
diff changeset
1505
kono
parents:
diff changeset
1506 if Count = 0 then
kono
parents:
diff changeset
1507 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1508 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
1509
kono
parents:
diff changeset
1510 -- Result is whole source string, reuse source shared string
kono
parents:
diff changeset
1511
kono
parents:
diff changeset
1512 elsif Count = SR.Last then
kono
parents:
diff changeset
1513 Reference (SR);
kono
parents:
diff changeset
1514 DR := SR;
kono
parents:
diff changeset
1515
kono
parents:
diff changeset
1516 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1517
kono
parents:
diff changeset
1518 else
kono
parents:
diff changeset
1519 DR := Allocate (Count);
kono
parents:
diff changeset
1520
kono
parents:
diff changeset
1521 if Count < SR.Last then
kono
parents:
diff changeset
1522 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
kono
parents:
diff changeset
1523
kono
parents:
diff changeset
1524 else
kono
parents:
diff changeset
1525 for J in 1 .. Count - SR.Last loop
kono
parents:
diff changeset
1526 DR.Data (J) := Pad;
kono
parents:
diff changeset
1527 end loop;
kono
parents:
diff changeset
1528
kono
parents:
diff changeset
1529 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
1530 end if;
kono
parents:
diff changeset
1531
kono
parents:
diff changeset
1532 DR.Last := Count;
kono
parents:
diff changeset
1533 end if;
kono
parents:
diff changeset
1534
kono
parents:
diff changeset
1535 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1536 end Tail;
kono
parents:
diff changeset
1537
kono
parents:
diff changeset
1538 procedure Tail
kono
parents:
diff changeset
1539 (Source : in out Unbounded_String;
kono
parents:
diff changeset
1540 Count : Natural;
kono
parents:
diff changeset
1541 Pad : Character := Space)
kono
parents:
diff changeset
1542 is
kono
parents:
diff changeset
1543 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1544 DR : Shared_String_Access;
kono
parents:
diff changeset
1545
kono
parents:
diff changeset
1546 procedure Common
kono
parents:
diff changeset
1547 (SR : Shared_String_Access;
kono
parents:
diff changeset
1548 DR : Shared_String_Access;
kono
parents:
diff changeset
1549 Count : Natural);
kono
parents:
diff changeset
1550 -- Common code of tail computation. SR/DR can point to the same object
kono
parents:
diff changeset
1551
kono
parents:
diff changeset
1552 ------------
kono
parents:
diff changeset
1553 -- Common --
kono
parents:
diff changeset
1554 ------------
kono
parents:
diff changeset
1555
kono
parents:
diff changeset
1556 procedure Common
kono
parents:
diff changeset
1557 (SR : Shared_String_Access;
kono
parents:
diff changeset
1558 DR : Shared_String_Access;
kono
parents:
diff changeset
1559 Count : Natural) is
kono
parents:
diff changeset
1560 begin
kono
parents:
diff changeset
1561 if Count < SR.Last then
kono
parents:
diff changeset
1562 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
kono
parents:
diff changeset
1563
kono
parents:
diff changeset
1564 else
kono
parents:
diff changeset
1565 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
kono
parents:
diff changeset
1566
kono
parents:
diff changeset
1567 for J in 1 .. Count - SR.Last loop
kono
parents:
diff changeset
1568 DR.Data (J) := Pad;
kono
parents:
diff changeset
1569 end loop;
kono
parents:
diff changeset
1570 end if;
kono
parents:
diff changeset
1571
kono
parents:
diff changeset
1572 DR.Last := Count;
kono
parents:
diff changeset
1573 end Common;
kono
parents:
diff changeset
1574
kono
parents:
diff changeset
1575 begin
kono
parents:
diff changeset
1576 -- Result is empty string, reuse empty shared string
kono
parents:
diff changeset
1577
kono
parents:
diff changeset
1578 if Count = 0 then
kono
parents:
diff changeset
1579 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1580 Source.Reference := Empty_Shared_String'Access;
kono
parents:
diff changeset
1581 Unreference (SR);
kono
parents:
diff changeset
1582
kono
parents:
diff changeset
1583 -- Length of the result is the same as length of the source string,
kono
parents:
diff changeset
1584 -- reuse source shared string.
kono
parents:
diff changeset
1585
kono
parents:
diff changeset
1586 elsif Count = SR.Last then
kono
parents:
diff changeset
1587 null;
kono
parents:
diff changeset
1588
kono
parents:
diff changeset
1589 -- Try to reuse existing shared string
kono
parents:
diff changeset
1590
kono
parents:
diff changeset
1591 elsif Can_Be_Reused (SR, Count) then
kono
parents:
diff changeset
1592 Common (SR, SR, Count);
kono
parents:
diff changeset
1593
kono
parents:
diff changeset
1594 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1595
kono
parents:
diff changeset
1596 else
kono
parents:
diff changeset
1597 DR := Allocate (Count);
kono
parents:
diff changeset
1598 Common (SR, DR, Count);
kono
parents:
diff changeset
1599 Source.Reference := DR;
kono
parents:
diff changeset
1600 Unreference (SR);
kono
parents:
diff changeset
1601 end if;
kono
parents:
diff changeset
1602 end Tail;
kono
parents:
diff changeset
1603
kono
parents:
diff changeset
1604 ---------------
kono
parents:
diff changeset
1605 -- To_String --
kono
parents:
diff changeset
1606 ---------------
kono
parents:
diff changeset
1607
kono
parents:
diff changeset
1608 function To_String (Source : Unbounded_String) return String is
kono
parents:
diff changeset
1609 begin
kono
parents:
diff changeset
1610 return Source.Reference.Data (1 .. Source.Reference.Last);
kono
parents:
diff changeset
1611 end To_String;
kono
parents:
diff changeset
1612
kono
parents:
diff changeset
1613 -------------------------
kono
parents:
diff changeset
1614 -- To_Unbounded_String --
kono
parents:
diff changeset
1615 -------------------------
kono
parents:
diff changeset
1616
kono
parents:
diff changeset
1617 function To_Unbounded_String (Source : String) return Unbounded_String is
kono
parents:
diff changeset
1618 DR : Shared_String_Access;
kono
parents:
diff changeset
1619
kono
parents:
diff changeset
1620 begin
kono
parents:
diff changeset
1621 if Source'Length = 0 then
kono
parents:
diff changeset
1622 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1623 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
1624
kono
parents:
diff changeset
1625 else
kono
parents:
diff changeset
1626 DR := Allocate (Source'Length);
kono
parents:
diff changeset
1627 DR.Data (1 .. Source'Length) := Source;
kono
parents:
diff changeset
1628 DR.Last := Source'Length;
kono
parents:
diff changeset
1629 end if;
kono
parents:
diff changeset
1630
kono
parents:
diff changeset
1631 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1632 end To_Unbounded_String;
kono
parents:
diff changeset
1633
kono
parents:
diff changeset
1634 function To_Unbounded_String (Length : Natural) return Unbounded_String is
kono
parents:
diff changeset
1635 DR : Shared_String_Access;
kono
parents:
diff changeset
1636
kono
parents:
diff changeset
1637 begin
kono
parents:
diff changeset
1638 if Length = 0 then
kono
parents:
diff changeset
1639 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1640 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
1641
kono
parents:
diff changeset
1642 else
kono
parents:
diff changeset
1643 DR := Allocate (Length);
kono
parents:
diff changeset
1644 DR.Last := 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_String;
kono
parents:
diff changeset
1649
kono
parents:
diff changeset
1650 ---------------
kono
parents:
diff changeset
1651 -- Translate --
kono
parents:
diff changeset
1652 ---------------
kono
parents:
diff changeset
1653
kono
parents:
diff changeset
1654 function Translate
kono
parents:
diff changeset
1655 (Source : Unbounded_String;
kono
parents:
diff changeset
1656 Mapping : Maps.Character_Mapping) return Unbounded_String
kono
parents:
diff changeset
1657 is
kono
parents:
diff changeset
1658 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1659 DR : Shared_String_Access;
kono
parents:
diff changeset
1660
kono
parents:
diff changeset
1661 begin
kono
parents:
diff changeset
1662 -- Nothing to translate, reuse empty shared string
kono
parents:
diff changeset
1663
kono
parents:
diff changeset
1664 if SR.Last = 0 then
kono
parents:
diff changeset
1665 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1666 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
1667
kono
parents:
diff changeset
1668 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
1669
kono
parents:
diff changeset
1670 else
kono
parents:
diff changeset
1671 DR := Allocate (SR.Last);
kono
parents:
diff changeset
1672
kono
parents:
diff changeset
1673 for J in 1 .. SR.Last loop
kono
parents:
diff changeset
1674 DR.Data (J) := Value (Mapping, SR.Data (J));
kono
parents:
diff changeset
1675 end loop;
kono
parents:
diff changeset
1676
kono
parents:
diff changeset
1677 DR.Last := SR.Last;
kono
parents:
diff changeset
1678 end if;
kono
parents:
diff changeset
1679
kono
parents:
diff changeset
1680 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1681 end Translate;
kono
parents:
diff changeset
1682
kono
parents:
diff changeset
1683 procedure Translate
kono
parents:
diff changeset
1684 (Source : in out Unbounded_String;
kono
parents:
diff changeset
1685 Mapping : Maps.Character_Mapping)
kono
parents:
diff changeset
1686 is
kono
parents:
diff changeset
1687 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1688 DR : Shared_String_Access;
kono
parents:
diff changeset
1689
kono
parents:
diff changeset
1690 begin
kono
parents:
diff changeset
1691 -- Nothing to translate
kono
parents:
diff changeset
1692
kono
parents:
diff changeset
1693 if SR.Last = 0 then
kono
parents:
diff changeset
1694 null;
kono
parents:
diff changeset
1695
kono
parents:
diff changeset
1696 -- Try to reuse shared string
kono
parents:
diff changeset
1697
kono
parents:
diff changeset
1698 elsif Can_Be_Reused (SR, SR.Last) then
kono
parents:
diff changeset
1699 for J in 1 .. SR.Last loop
kono
parents:
diff changeset
1700 SR.Data (J) := Value (Mapping, SR.Data (J));
kono
parents:
diff changeset
1701 end loop;
kono
parents:
diff changeset
1702
kono
parents:
diff changeset
1703 -- Otherwise, allocate new shared string
kono
parents:
diff changeset
1704
kono
parents:
diff changeset
1705 else
kono
parents:
diff changeset
1706 DR := Allocate (SR.Last);
kono
parents:
diff changeset
1707
kono
parents:
diff changeset
1708 for J in 1 .. SR.Last loop
kono
parents:
diff changeset
1709 DR.Data (J) := Value (Mapping, SR.Data (J));
kono
parents:
diff changeset
1710 end loop;
kono
parents:
diff changeset
1711
kono
parents:
diff changeset
1712 DR.Last := SR.Last;
kono
parents:
diff changeset
1713 Source.Reference := DR;
kono
parents:
diff changeset
1714 Unreference (SR);
kono
parents:
diff changeset
1715 end if;
kono
parents:
diff changeset
1716 end Translate;
kono
parents:
diff changeset
1717
kono
parents:
diff changeset
1718 function Translate
kono
parents:
diff changeset
1719 (Source : Unbounded_String;
kono
parents:
diff changeset
1720 Mapping : Maps.Character_Mapping_Function) return Unbounded_String
kono
parents:
diff changeset
1721 is
kono
parents:
diff changeset
1722 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1723 DR : Shared_String_Access;
kono
parents:
diff changeset
1724
kono
parents:
diff changeset
1725 begin
kono
parents:
diff changeset
1726 -- Nothing to translate, reuse empty shared string
kono
parents:
diff changeset
1727
kono
parents:
diff changeset
1728 if SR.Last = 0 then
kono
parents:
diff changeset
1729 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1730 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
1731
kono
parents:
diff changeset
1732 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
1733
kono
parents:
diff changeset
1734 else
kono
parents:
diff changeset
1735 DR := Allocate (SR.Last);
kono
parents:
diff changeset
1736
kono
parents:
diff changeset
1737 for J in 1 .. SR.Last loop
kono
parents:
diff changeset
1738 DR.Data (J) := Mapping.all (SR.Data (J));
kono
parents:
diff changeset
1739 end loop;
kono
parents:
diff changeset
1740
kono
parents:
diff changeset
1741 DR.Last := SR.Last;
kono
parents:
diff changeset
1742 end if;
kono
parents:
diff changeset
1743
kono
parents:
diff changeset
1744 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1745
kono
parents:
diff changeset
1746 exception
kono
parents:
diff changeset
1747 when others =>
kono
parents:
diff changeset
1748 Unreference (DR);
kono
parents:
diff changeset
1749
kono
parents:
diff changeset
1750 raise;
kono
parents:
diff changeset
1751 end Translate;
kono
parents:
diff changeset
1752
kono
parents:
diff changeset
1753 procedure Translate
kono
parents:
diff changeset
1754 (Source : in out Unbounded_String;
kono
parents:
diff changeset
1755 Mapping : Maps.Character_Mapping_Function)
kono
parents:
diff changeset
1756 is
kono
parents:
diff changeset
1757 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1758 DR : Shared_String_Access;
kono
parents:
diff changeset
1759
kono
parents:
diff changeset
1760 begin
kono
parents:
diff changeset
1761 -- Nothing to translate
kono
parents:
diff changeset
1762
kono
parents:
diff changeset
1763 if SR.Last = 0 then
kono
parents:
diff changeset
1764 null;
kono
parents:
diff changeset
1765
kono
parents:
diff changeset
1766 -- Try to reuse shared string
kono
parents:
diff changeset
1767
kono
parents:
diff changeset
1768 elsif Can_Be_Reused (SR, SR.Last) then
kono
parents:
diff changeset
1769 for J in 1 .. SR.Last loop
kono
parents:
diff changeset
1770 SR.Data (J) := Mapping.all (SR.Data (J));
kono
parents:
diff changeset
1771 end loop;
kono
parents:
diff changeset
1772
kono
parents:
diff changeset
1773 -- Otherwise allocate new shared string and fill it
kono
parents:
diff changeset
1774
kono
parents:
diff changeset
1775 else
kono
parents:
diff changeset
1776 DR := Allocate (SR.Last);
kono
parents:
diff changeset
1777
kono
parents:
diff changeset
1778 for J in 1 .. SR.Last loop
kono
parents:
diff changeset
1779 DR.Data (J) := Mapping.all (SR.Data (J));
kono
parents:
diff changeset
1780 end loop;
kono
parents:
diff changeset
1781
kono
parents:
diff changeset
1782 DR.Last := SR.Last;
kono
parents:
diff changeset
1783 Source.Reference := DR;
kono
parents:
diff changeset
1784 Unreference (SR);
kono
parents:
diff changeset
1785 end if;
kono
parents:
diff changeset
1786
kono
parents:
diff changeset
1787 exception
kono
parents:
diff changeset
1788 when others =>
kono
parents:
diff changeset
1789 if DR /= null then
kono
parents:
diff changeset
1790 Unreference (DR);
kono
parents:
diff changeset
1791 end if;
kono
parents:
diff changeset
1792
kono
parents:
diff changeset
1793 raise;
kono
parents:
diff changeset
1794 end Translate;
kono
parents:
diff changeset
1795
kono
parents:
diff changeset
1796 ----------
kono
parents:
diff changeset
1797 -- Trim --
kono
parents:
diff changeset
1798 ----------
kono
parents:
diff changeset
1799
kono
parents:
diff changeset
1800 function Trim
kono
parents:
diff changeset
1801 (Source : Unbounded_String;
kono
parents:
diff changeset
1802 Side : Trim_End) return Unbounded_String
kono
parents:
diff changeset
1803 is
kono
parents:
diff changeset
1804 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1805 DL : Natural;
kono
parents:
diff changeset
1806 DR : Shared_String_Access;
kono
parents:
diff changeset
1807 Low : Natural;
kono
parents:
diff changeset
1808 High : Natural;
kono
parents:
diff changeset
1809
kono
parents:
diff changeset
1810 begin
kono
parents:
diff changeset
1811 Low := Index_Non_Blank (Source, Forward);
kono
parents:
diff changeset
1812
kono
parents:
diff changeset
1813 -- All blanks, reuse empty shared string
kono
parents:
diff changeset
1814
kono
parents:
diff changeset
1815 if Low = 0 then
kono
parents:
diff changeset
1816 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1817 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
1818
kono
parents:
diff changeset
1819 else
kono
parents:
diff changeset
1820 case Side is
kono
parents:
diff changeset
1821 when Left =>
kono
parents:
diff changeset
1822 High := SR.Last;
kono
parents:
diff changeset
1823 DL := SR.Last - Low + 1;
kono
parents:
diff changeset
1824
kono
parents:
diff changeset
1825 when Right =>
kono
parents:
diff changeset
1826 Low := 1;
kono
parents:
diff changeset
1827 High := Index_Non_Blank (Source, Backward);
kono
parents:
diff changeset
1828 DL := High;
kono
parents:
diff changeset
1829
kono
parents:
diff changeset
1830 when Both =>
kono
parents:
diff changeset
1831 High := Index_Non_Blank (Source, Backward);
kono
parents:
diff changeset
1832 DL := High - Low + 1;
kono
parents:
diff changeset
1833 end case;
kono
parents:
diff changeset
1834
kono
parents:
diff changeset
1835 -- Length of the result is the same as length of the source string,
kono
parents:
diff changeset
1836 -- reuse source shared string.
kono
parents:
diff changeset
1837
kono
parents:
diff changeset
1838 if DL = SR.Last then
kono
parents:
diff changeset
1839 Reference (SR);
kono
parents:
diff changeset
1840 DR := SR;
kono
parents:
diff changeset
1841
kono
parents:
diff changeset
1842 -- Otherwise, allocate new shared string
kono
parents:
diff changeset
1843
kono
parents:
diff changeset
1844 else
kono
parents:
diff changeset
1845 DR := Allocate (DL);
kono
parents:
diff changeset
1846 DR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
1847 DR.Last := DL;
kono
parents:
diff changeset
1848 end if;
kono
parents:
diff changeset
1849 end if;
kono
parents:
diff changeset
1850
kono
parents:
diff changeset
1851 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1852 end Trim;
kono
parents:
diff changeset
1853
kono
parents:
diff changeset
1854 procedure Trim
kono
parents:
diff changeset
1855 (Source : in out Unbounded_String;
kono
parents:
diff changeset
1856 Side : Trim_End)
kono
parents:
diff changeset
1857 is
kono
parents:
diff changeset
1858 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1859 DL : Natural;
kono
parents:
diff changeset
1860 DR : Shared_String_Access;
kono
parents:
diff changeset
1861 Low : Natural;
kono
parents:
diff changeset
1862 High : Natural;
kono
parents:
diff changeset
1863
kono
parents:
diff changeset
1864 begin
kono
parents:
diff changeset
1865 Low := Index_Non_Blank (Source, Forward);
kono
parents:
diff changeset
1866
kono
parents:
diff changeset
1867 -- All blanks, reuse empty shared string
kono
parents:
diff changeset
1868
kono
parents:
diff changeset
1869 if Low = 0 then
kono
parents:
diff changeset
1870 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1871 Source.Reference := Empty_Shared_String'Access;
kono
parents:
diff changeset
1872 Unreference (SR);
kono
parents:
diff changeset
1873
kono
parents:
diff changeset
1874 else
kono
parents:
diff changeset
1875 case Side is
kono
parents:
diff changeset
1876 when Left =>
kono
parents:
diff changeset
1877 High := SR.Last;
kono
parents:
diff changeset
1878 DL := SR.Last - Low + 1;
kono
parents:
diff changeset
1879
kono
parents:
diff changeset
1880 when Right =>
kono
parents:
diff changeset
1881 Low := 1;
kono
parents:
diff changeset
1882 High := Index_Non_Blank (Source, Backward);
kono
parents:
diff changeset
1883 DL := High;
kono
parents:
diff changeset
1884
kono
parents:
diff changeset
1885 when Both =>
kono
parents:
diff changeset
1886 High := Index_Non_Blank (Source, Backward);
kono
parents:
diff changeset
1887 DL := High - Low + 1;
kono
parents:
diff changeset
1888 end case;
kono
parents:
diff changeset
1889
kono
parents:
diff changeset
1890 -- Length of the result is the same as length of the source string,
kono
parents:
diff changeset
1891 -- nothing to do.
kono
parents:
diff changeset
1892
kono
parents:
diff changeset
1893 if DL = SR.Last then
kono
parents:
diff changeset
1894 null;
kono
parents:
diff changeset
1895
kono
parents:
diff changeset
1896 -- Try to reuse existing shared string
kono
parents:
diff changeset
1897
kono
parents:
diff changeset
1898 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
1899 SR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
1900 SR.Last := DL;
kono
parents:
diff changeset
1901
kono
parents:
diff changeset
1902 -- Otherwise, allocate new shared string
kono
parents:
diff changeset
1903
kono
parents:
diff changeset
1904 else
kono
parents:
diff changeset
1905 DR := Allocate (DL);
kono
parents:
diff changeset
1906 DR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
1907 DR.Last := DL;
kono
parents:
diff changeset
1908 Source.Reference := DR;
kono
parents:
diff changeset
1909 Unreference (SR);
kono
parents:
diff changeset
1910 end if;
kono
parents:
diff changeset
1911 end if;
kono
parents:
diff changeset
1912 end Trim;
kono
parents:
diff changeset
1913
kono
parents:
diff changeset
1914 function Trim
kono
parents:
diff changeset
1915 (Source : Unbounded_String;
kono
parents:
diff changeset
1916 Left : Maps.Character_Set;
kono
parents:
diff changeset
1917 Right : Maps.Character_Set) return Unbounded_String
kono
parents:
diff changeset
1918 is
kono
parents:
diff changeset
1919 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1920 DL : Natural;
kono
parents:
diff changeset
1921 DR : Shared_String_Access;
kono
parents:
diff changeset
1922 Low : Natural;
kono
parents:
diff changeset
1923 High : Natural;
kono
parents:
diff changeset
1924
kono
parents:
diff changeset
1925 begin
kono
parents:
diff changeset
1926 Low := Index (Source, Left, Outside, Forward);
kono
parents:
diff changeset
1927
kono
parents:
diff changeset
1928 -- Source includes only characters from Left set, reuse empty shared
kono
parents:
diff changeset
1929 -- string.
kono
parents:
diff changeset
1930
kono
parents:
diff changeset
1931 if Low = 0 then
kono
parents:
diff changeset
1932 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1933 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
1934
kono
parents:
diff changeset
1935 else
kono
parents:
diff changeset
1936 High := Index (Source, Right, Outside, Backward);
kono
parents:
diff changeset
1937 DL := Integer'Max (0, High - Low + 1);
kono
parents:
diff changeset
1938
kono
parents:
diff changeset
1939 -- Source includes only characters from Right set or result string
kono
parents:
diff changeset
1940 -- is empty, reuse empty shared string.
kono
parents:
diff changeset
1941
kono
parents:
diff changeset
1942 if High = 0 or else DL = 0 then
kono
parents:
diff changeset
1943 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1944 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
1945
kono
parents:
diff changeset
1946 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
1947
kono
parents:
diff changeset
1948 else
kono
parents:
diff changeset
1949 DR := Allocate (DL);
kono
parents:
diff changeset
1950 DR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
1951 DR.Last := DL;
kono
parents:
diff changeset
1952 end if;
kono
parents:
diff changeset
1953 end if;
kono
parents:
diff changeset
1954
kono
parents:
diff changeset
1955 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
1956 end Trim;
kono
parents:
diff changeset
1957
kono
parents:
diff changeset
1958 procedure Trim
kono
parents:
diff changeset
1959 (Source : in out Unbounded_String;
kono
parents:
diff changeset
1960 Left : Maps.Character_Set;
kono
parents:
diff changeset
1961 Right : Maps.Character_Set)
kono
parents:
diff changeset
1962 is
kono
parents:
diff changeset
1963 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
1964 DL : Natural;
kono
parents:
diff changeset
1965 DR : Shared_String_Access;
kono
parents:
diff changeset
1966 Low : Natural;
kono
parents:
diff changeset
1967 High : Natural;
kono
parents:
diff changeset
1968
kono
parents:
diff changeset
1969 begin
kono
parents:
diff changeset
1970 Low := Index (Source, Left, Outside, Forward);
kono
parents:
diff changeset
1971
kono
parents:
diff changeset
1972 -- Source includes only characters from Left set, reuse empty shared
kono
parents:
diff changeset
1973 -- string.
kono
parents:
diff changeset
1974
kono
parents:
diff changeset
1975 if Low = 0 then
kono
parents:
diff changeset
1976 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1977 Source.Reference := Empty_Shared_String'Access;
kono
parents:
diff changeset
1978 Unreference (SR);
kono
parents:
diff changeset
1979
kono
parents:
diff changeset
1980 else
kono
parents:
diff changeset
1981 High := Index (Source, Right, Outside, Backward);
kono
parents:
diff changeset
1982 DL := Integer'Max (0, High - Low + 1);
kono
parents:
diff changeset
1983
kono
parents:
diff changeset
1984 -- Source includes only characters from Right set or result string
kono
parents:
diff changeset
1985 -- is empty, reuse empty shared string.
kono
parents:
diff changeset
1986
kono
parents:
diff changeset
1987 if High = 0 or else DL = 0 then
kono
parents:
diff changeset
1988 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
1989 Source.Reference := Empty_Shared_String'Access;
kono
parents:
diff changeset
1990 Unreference (SR);
kono
parents:
diff changeset
1991
kono
parents:
diff changeset
1992 -- Try to reuse existing shared string
kono
parents:
diff changeset
1993
kono
parents:
diff changeset
1994 elsif Can_Be_Reused (SR, DL) then
kono
parents:
diff changeset
1995 SR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
1996 SR.Last := DL;
kono
parents:
diff changeset
1997
kono
parents:
diff changeset
1998 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
1999
kono
parents:
diff changeset
2000 else
kono
parents:
diff changeset
2001 DR := Allocate (DL);
kono
parents:
diff changeset
2002 DR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
2003 DR.Last := DL;
kono
parents:
diff changeset
2004 Source.Reference := DR;
kono
parents:
diff changeset
2005 Unreference (SR);
kono
parents:
diff changeset
2006 end if;
kono
parents:
diff changeset
2007 end if;
kono
parents:
diff changeset
2008 end Trim;
kono
parents:
diff changeset
2009
kono
parents:
diff changeset
2010 ---------------------
kono
parents:
diff changeset
2011 -- Unbounded_Slice --
kono
parents:
diff changeset
2012 ---------------------
kono
parents:
diff changeset
2013
kono
parents:
diff changeset
2014 function Unbounded_Slice
kono
parents:
diff changeset
2015 (Source : Unbounded_String;
kono
parents:
diff changeset
2016 Low : Positive;
kono
parents:
diff changeset
2017 High : Natural) return Unbounded_String
kono
parents:
diff changeset
2018 is
kono
parents:
diff changeset
2019 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
2020 DL : Natural;
kono
parents:
diff changeset
2021 DR : Shared_String_Access;
kono
parents:
diff changeset
2022
kono
parents:
diff changeset
2023 begin
kono
parents:
diff changeset
2024 -- Check bounds
kono
parents:
diff changeset
2025
kono
parents:
diff changeset
2026 if Low > SR.Last + 1 or else High > SR.Last then
kono
parents:
diff changeset
2027 raise Index_Error;
kono
parents:
diff changeset
2028
kono
parents:
diff changeset
2029 -- Result is empty slice, reuse empty shared string
kono
parents:
diff changeset
2030
kono
parents:
diff changeset
2031 elsif Low > High then
kono
parents:
diff changeset
2032 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
2033 DR := Empty_Shared_String'Access;
kono
parents:
diff changeset
2034
kono
parents:
diff changeset
2035 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
2036
kono
parents:
diff changeset
2037 else
kono
parents:
diff changeset
2038 DL := High - Low + 1;
kono
parents:
diff changeset
2039 DR := Allocate (DL);
kono
parents:
diff changeset
2040 DR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
2041 DR.Last := DL;
kono
parents:
diff changeset
2042 end if;
kono
parents:
diff changeset
2043
kono
parents:
diff changeset
2044 return (AF.Controlled with Reference => DR);
kono
parents:
diff changeset
2045 end Unbounded_Slice;
kono
parents:
diff changeset
2046
kono
parents:
diff changeset
2047 procedure Unbounded_Slice
kono
parents:
diff changeset
2048 (Source : Unbounded_String;
kono
parents:
diff changeset
2049 Target : out Unbounded_String;
kono
parents:
diff changeset
2050 Low : Positive;
kono
parents:
diff changeset
2051 High : Natural)
kono
parents:
diff changeset
2052 is
kono
parents:
diff changeset
2053 SR : constant Shared_String_Access := Source.Reference;
kono
parents:
diff changeset
2054 TR : constant Shared_String_Access := Target.Reference;
kono
parents:
diff changeset
2055 DL : Natural;
kono
parents:
diff changeset
2056 DR : Shared_String_Access;
kono
parents:
diff changeset
2057
kono
parents:
diff changeset
2058 begin
kono
parents:
diff changeset
2059 -- Check bounds
kono
parents:
diff changeset
2060
kono
parents:
diff changeset
2061 if Low > SR.Last + 1 or else High > SR.Last then
kono
parents:
diff changeset
2062 raise Index_Error;
kono
parents:
diff changeset
2063
kono
parents:
diff changeset
2064 -- Result is empty slice, reuse empty shared string
kono
parents:
diff changeset
2065
kono
parents:
diff changeset
2066 elsif Low > High then
kono
parents:
diff changeset
2067 Reference (Empty_Shared_String'Access);
kono
parents:
diff changeset
2068 Target.Reference := Empty_Shared_String'Access;
kono
parents:
diff changeset
2069 Unreference (TR);
kono
parents:
diff changeset
2070
kono
parents:
diff changeset
2071 else
kono
parents:
diff changeset
2072 DL := High - Low + 1;
kono
parents:
diff changeset
2073
kono
parents:
diff changeset
2074 -- Try to reuse existing shared string
kono
parents:
diff changeset
2075
kono
parents:
diff changeset
2076 if Can_Be_Reused (TR, DL) then
kono
parents:
diff changeset
2077 TR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
2078 TR.Last := DL;
kono
parents:
diff changeset
2079
kono
parents:
diff changeset
2080 -- Otherwise, allocate new shared string and fill it
kono
parents:
diff changeset
2081
kono
parents:
diff changeset
2082 else
kono
parents:
diff changeset
2083 DR := Allocate (DL);
kono
parents:
diff changeset
2084 DR.Data (1 .. DL) := SR.Data (Low .. High);
kono
parents:
diff changeset
2085 DR.Last := DL;
kono
parents:
diff changeset
2086 Target.Reference := DR;
kono
parents:
diff changeset
2087 Unreference (TR);
kono
parents:
diff changeset
2088 end if;
kono
parents:
diff changeset
2089 end if;
kono
parents:
diff changeset
2090 end Unbounded_Slice;
kono
parents:
diff changeset
2091
kono
parents:
diff changeset
2092 -----------------
kono
parents:
diff changeset
2093 -- Unreference --
kono
parents:
diff changeset
2094 -----------------
kono
parents:
diff changeset
2095
kono
parents:
diff changeset
2096 procedure Unreference (Item : not null Shared_String_Access) is
kono
parents:
diff changeset
2097
kono
parents:
diff changeset
2098 procedure Free is
kono
parents:
diff changeset
2099 new Ada.Unchecked_Deallocation (Shared_String, Shared_String_Access);
kono
parents:
diff changeset
2100
kono
parents:
diff changeset
2101 Aux : Shared_String_Access := Item;
kono
parents:
diff changeset
2102
kono
parents:
diff changeset
2103 begin
kono
parents:
diff changeset
2104 if System.Atomic_Counters.Decrement (Aux.Counter) then
kono
parents:
diff changeset
2105
kono
parents:
diff changeset
2106 -- Reference counter of Empty_Shared_String should never reach
kono
parents:
diff changeset
2107 -- zero. We check here in case it wraps around.
kono
parents:
diff changeset
2108
kono
parents:
diff changeset
2109 if Aux /= Empty_Shared_String'Access then
kono
parents:
diff changeset
2110 Free (Aux);
kono
parents:
diff changeset
2111 end if;
kono
parents:
diff changeset
2112 end if;
kono
parents:
diff changeset
2113 end Unreference;
kono
parents:
diff changeset
2114
kono
parents:
diff changeset
2115 end Ada.Strings.Unbounded;