Mercurial > hg > CbC > CbC_gcc

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

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