Implement -mmemcpy-strategy= and -mmemset-strategy= options
[official-gcc.git] / gcc / ada / a-stwiun-shared.adb
blob6c3be54083c47912bbc93180dd38f0f295efa11c
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . S T R I N G S . W I D E _ U N B O U N D E D --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2012, 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 ------------------------------------------------------------------------------
32 with Ada.Strings.Wide_Search;
33 with Ada.Unchecked_Deallocation;
35 package body Ada.Strings.Wide_Unbounded is
37 use Ada.Strings.Wide_Maps;
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.
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.
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.
59 ---------
60 -- "&" --
61 ---------
63 function "&"
64 (Left : Unbounded_Wide_String;
65 Right : Unbounded_Wide_String) return Unbounded_Wide_String
67 LR : constant Shared_Wide_String_Access := Left.Reference;
68 RR : constant Shared_Wide_String_Access := Right.Reference;
69 DL : constant Natural := LR.Last + RR.Last;
70 DR : Shared_Wide_String_Access;
72 begin
73 -- Result is an empty string, reuse shared empty string
75 if DL = 0 then
76 Reference (Empty_Shared_Wide_String'Access);
77 DR := Empty_Shared_Wide_String'Access;
79 -- Left string is empty, return Rigth string
81 elsif LR.Last = 0 then
82 Reference (RR);
83 DR := RR;
85 -- Right string is empty, return Left string
87 elsif RR.Last = 0 then
88 Reference (LR);
89 DR := LR;
91 -- Overwise, allocate new shared string and fill data
93 else
94 DR := Allocate (LR.Last + RR.Last);
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;
100 return (AF.Controlled with Reference => DR);
101 end "&";
103 function "&"
104 (Left : Unbounded_Wide_String;
105 Right : Wide_String) return Unbounded_Wide_String
107 LR : constant Shared_Wide_String_Access := Left.Reference;
108 DL : constant Natural := LR.Last + Right'Length;
109 DR : Shared_Wide_String_Access;
111 begin
112 -- Result is an empty string, reuse shared empty string
114 if DL = 0 then
115 Reference (Empty_Shared_Wide_String'Access);
116 DR := Empty_Shared_Wide_String'Access;
118 -- Right is an empty string, return Left string
120 elsif Right'Length = 0 then
121 Reference (LR);
122 DR := LR;
124 -- Otherwise, allocate new shared string and fill it
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;
133 return (AF.Controlled with Reference => DR);
134 end "&";
136 function "&"
137 (Left : Wide_String;
138 Right : Unbounded_Wide_String) return Unbounded_Wide_String
140 RR : constant Shared_Wide_String_Access := Right.Reference;
141 DL : constant Natural := Left'Length + RR.Last;
142 DR : Shared_Wide_String_Access;
144 begin
145 -- Result is an empty string, reuse shared one
147 if DL = 0 then
148 Reference (Empty_Shared_Wide_String'Access);
149 DR := Empty_Shared_Wide_String'Access;
151 -- Left is empty string, return Right string
153 elsif Left'Length = 0 then
154 Reference (RR);
155 DR := RR;
157 -- Otherwise, allocate new shared string and fill it
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;
166 return (AF.Controlled with Reference => DR);
167 end "&";
169 function "&"
170 (Left : Unbounded_Wide_String;
171 Right : Wide_Character) return Unbounded_Wide_String
173 LR : constant Shared_Wide_String_Access := Left.Reference;
174 DL : constant Natural := LR.Last + 1;
175 DR : Shared_Wide_String_Access;
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;
183 return (AF.Controlled with Reference => DR);
184 end "&";
186 function "&"
187 (Left : Wide_Character;
188 Right : Unbounded_Wide_String) return Unbounded_Wide_String
190 RR : constant Shared_Wide_String_Access := Right.Reference;
191 DL : constant Natural := 1 + RR.Last;
192 DR : Shared_Wide_String_Access;
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;
200 return (AF.Controlled with Reference => DR);
201 end "&";
203 ---------
204 -- "*" --
205 ---------
207 function "*"
208 (Left : Natural;
209 Right : Wide_Character) return Unbounded_Wide_String
211 DR : Shared_Wide_String_Access;
213 begin
214 -- Result is an empty string, reuse shared empty string
216 if Left = 0 then
217 Reference (Empty_Shared_Wide_String'Access);
218 DR := Empty_Shared_Wide_String'Access;
220 -- Otherwise, allocate new shared string and fill it
222 else
223 DR := Allocate (Left);
225 for J in 1 .. Left loop
226 DR.Data (J) := Right;
227 end loop;
229 DR.Last := Left;
230 end if;
232 return (AF.Controlled with Reference => DR);
233 end "*";
235 function "*"
236 (Left : Natural;
237 Right : Wide_String) return Unbounded_Wide_String
239 DL : constant Natural := Left * Right'Length;
240 DR : Shared_Wide_String_Access;
241 K : Positive;
243 begin
244 -- Result is an empty string, reuse shared empty string
246 if DL = 0 then
247 Reference (Empty_Shared_Wide_String'Access);
248 DR := Empty_Shared_Wide_String'Access;
250 -- Otherwise, allocate new shared string and fill it
252 else
253 DR := Allocate (DL);
254 K := 1;
256 for J in 1 .. Left loop
257 DR.Data (K .. K + Right'Length - 1) := Right;
258 K := K + Right'Length;
259 end loop;
261 DR.Last := DL;
262 end if;
264 return (AF.Controlled with Reference => DR);
265 end "*";
267 function "*"
268 (Left : Natural;
269 Right : Unbounded_Wide_String) return Unbounded_Wide_String
271 RR : constant Shared_Wide_String_Access := Right.Reference;
272 DL : constant Natural := Left * RR.Last;
273 DR : Shared_Wide_String_Access;
274 K : Positive;
276 begin
277 -- Result is an empty string, reuse shared empty string
279 if DL = 0 then
280 Reference (Empty_Shared_Wide_String'Access);
281 DR := Empty_Shared_Wide_String'Access;
283 -- Coefficient is one, just return string itself
285 elsif Left = 1 then
286 Reference (RR);
287 DR := RR;
289 -- Otherwise, allocate new shared string and fill it
291 else
292 DR := Allocate (DL);
293 K := 1;
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;
300 DR.Last := DL;
301 end if;
303 return (AF.Controlled with Reference => DR);
304 end "*";
306 ---------
307 -- "<" --
308 ---------
310 function "<"
311 (Left : Unbounded_Wide_String;
312 Right : Unbounded_Wide_String) return Boolean
314 LR : constant Shared_Wide_String_Access := Left.Reference;
315 RR : constant Shared_Wide_String_Access := Right.Reference;
316 begin
317 return LR.Data (1 .. LR.Last) < RR.Data (1 .. RR.Last);
318 end "<";
320 function "<"
321 (Left : Unbounded_Wide_String;
322 Right : Wide_String) return Boolean
324 LR : constant Shared_Wide_String_Access := Left.Reference;
325 begin
326 return LR.Data (1 .. LR.Last) < Right;
327 end "<";
329 function "<"
330 (Left : Wide_String;
331 Right : Unbounded_Wide_String) return Boolean
333 RR : constant Shared_Wide_String_Access := Right.Reference;
334 begin
335 return Left < RR.Data (1 .. RR.Last);
336 end "<";
338 ----------
339 -- "<=" --
340 ----------
342 function "<="
343 (Left : Unbounded_Wide_String;
344 Right : Unbounded_Wide_String) return Boolean
346 LR : constant Shared_Wide_String_Access := Left.Reference;
347 RR : constant Shared_Wide_String_Access := Right.Reference;
349 begin
350 -- LR = RR means two strings shares shared string, thus they are equal
352 return LR = RR or else LR.Data (1 .. LR.Last) <= RR.Data (1 .. RR.Last);
353 end "<=";
355 function "<="
356 (Left : Unbounded_Wide_String;
357 Right : Wide_String) return Boolean
359 LR : constant Shared_Wide_String_Access := Left.Reference;
360 begin
361 return LR.Data (1 .. LR.Last) <= Right;
362 end "<=";
364 function "<="
365 (Left : Wide_String;
366 Right : Unbounded_Wide_String) return Boolean
368 RR : constant Shared_Wide_String_Access := Right.Reference;
369 begin
370 return Left <= RR.Data (1 .. RR.Last);
371 end "<=";
373 ---------
374 -- "=" --
375 ---------
377 function "="
378 (Left : Unbounded_Wide_String;
379 Right : Unbounded_Wide_String) return Boolean
381 LR : constant Shared_Wide_String_Access := Left.Reference;
382 RR : constant Shared_Wide_String_Access := Right.Reference;
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 "=";
389 function "="
390 (Left : Unbounded_Wide_String;
391 Right : Wide_String) return Boolean
393 LR : constant Shared_Wide_String_Access := Left.Reference;
394 begin
395 return LR.Data (1 .. LR.Last) = Right;
396 end "=";
398 function "="
399 (Left : Wide_String;
400 Right : Unbounded_Wide_String) return Boolean
402 RR : constant Shared_Wide_String_Access := Right.Reference;
403 begin
404 return Left = RR.Data (1 .. RR.Last);
405 end "=";
407 ---------
408 -- ">" --
409 ---------
411 function ">"
412 (Left : Unbounded_Wide_String;
413 Right : Unbounded_Wide_String) return Boolean
415 LR : constant Shared_Wide_String_Access := Left.Reference;
416 RR : constant Shared_Wide_String_Access := Right.Reference;
417 begin
418 return LR.Data (1 .. LR.Last) > RR.Data (1 .. RR.Last);
419 end ">";
421 function ">"
422 (Left : Unbounded_Wide_String;
423 Right : Wide_String) return Boolean
425 LR : constant Shared_Wide_String_Access := Left.Reference;
426 begin
427 return LR.Data (1 .. LR.Last) > Right;
428 end ">";
430 function ">"
431 (Left : Wide_String;
432 Right : Unbounded_Wide_String) return Boolean
434 RR : constant Shared_Wide_String_Access := Right.Reference;
435 begin
436 return Left > RR.Data (1 .. RR.Last);
437 end ">";
439 ----------
440 -- ">=" --
441 ----------
443 function ">="
444 (Left : Unbounded_Wide_String;
445 Right : Unbounded_Wide_String) return Boolean
447 LR : constant Shared_Wide_String_Access := Left.Reference;
448 RR : constant Shared_Wide_String_Access := Right.Reference;
450 begin
451 -- LR = RR means two strings shares shared string, thus they are equal
453 return LR = RR or else LR.Data (1 .. LR.Last) >= RR.Data (1 .. RR.Last);
454 end ">=";
456 function ">="
457 (Left : Unbounded_Wide_String;
458 Right : Wide_String) return Boolean
460 LR : constant Shared_Wide_String_Access := Left.Reference;
461 begin
462 return LR.Data (1 .. LR.Last) >= Right;
463 end ">=";
465 function ">="
466 (Left : Wide_String;
467 Right : Unbounded_Wide_String) return Boolean
469 RR : constant Shared_Wide_String_Access := Right.Reference;
470 begin
471 return Left >= RR.Data (1 .. RR.Last);
472 end ">=";
474 ------------
475 -- Adjust --
476 ------------
478 procedure Adjust (Object : in out Unbounded_Wide_String) is
479 begin
480 Reference (Object.Reference);
481 end Adjust;
483 ------------------------
484 -- Aligned_Max_Length --
485 ------------------------
487 function Aligned_Max_Length (Max_Length : Natural) return Natural is
488 Static_Size : constant Natural :=
489 Empty_Shared_Wide_String'Size / Standard'Storage_Unit;
490 -- Total size of all static components
492 Element_Size : constant Natural :=
493 Wide_Character'Size / Standard'Storage_Unit;
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;
501 --------------
502 -- Allocate --
503 --------------
505 function Allocate (Max_Length : Natural) return Shared_Wide_String_Access is
506 begin
507 -- Empty string requested, return shared empty string
509 if Max_Length = 0 then
510 Reference (Empty_Shared_Wide_String'Access);
511 return Empty_Shared_Wide_String'Access;
513 -- Otherwise, allocate requested space (and probably some more room)
515 else
516 return new Shared_Wide_String (Aligned_Max_Length (Max_Length));
517 end if;
518 end Allocate;
520 ------------
521 -- Append --
522 ------------
524 procedure Append
525 (Source : in out Unbounded_Wide_String;
526 New_Item : Unbounded_Wide_String)
528 SR : constant Shared_Wide_String_Access := Source.Reference;
529 NR : constant Shared_Wide_String_Access := New_Item.Reference;
530 DL : constant Natural := SR.Last + NR.Last;
531 DR : Shared_Wide_String_Access;
533 begin
534 -- Source is an empty string, reuse New_Item data
536 if SR.Last = 0 then
537 Reference (NR);
538 Source.Reference := NR;
539 Unreference (SR);
541 -- New_Item is empty string, nothing to do
543 elsif NR.Last = 0 then
544 null;
546 -- Try to reuse existent shared string
548 elsif Can_Be_Reused (SR, DL) then
549 SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
550 SR.Last := DL;
552 -- Otherwise, allocate new one and fill it
554 else
555 DR := Allocate (DL + DL / Growth_Factor);
556 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
557 DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
558 DR.Last := DL;
559 Source.Reference := DR;
560 Unreference (SR);
561 end if;
562 end Append;
564 procedure Append
565 (Source : in out Unbounded_Wide_String;
566 New_Item : Wide_String)
568 SR : constant Shared_Wide_String_Access := Source.Reference;
569 DL : constant Natural := SR.Last + New_Item'Length;
570 DR : Shared_Wide_String_Access;
572 begin
573 -- New_Item is an empty string, nothing to do
575 if New_Item'Length = 0 then
576 null;
578 -- Try to reuse existing shared string
580 elsif Can_Be_Reused (SR, DL) then
581 SR.Data (SR.Last + 1 .. DL) := New_Item;
582 SR.Last := DL;
584 -- Otherwise, allocate new one and fill it
586 else
587 DR := Allocate (DL + DL / Growth_Factor);
588 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
589 DR.Data (SR.Last + 1 .. DL) := New_Item;
590 DR.Last := DL;
591 Source.Reference := DR;
592 Unreference (SR);
593 end if;
594 end Append;
596 procedure Append
597 (Source : in out Unbounded_Wide_String;
598 New_Item : Wide_Character)
600 SR : constant Shared_Wide_String_Access := Source.Reference;
601 DL : constant Natural := SR.Last + 1;
602 DR : Shared_Wide_String_Access;
604 begin
605 -- Try to reuse existing shared string
607 if Can_Be_Reused (SR, SR.Last + 1) then
608 SR.Data (SR.Last + 1) := New_Item;
609 SR.Last := SR.Last + 1;
611 -- Otherwise, allocate new one and fill it
613 else
614 DR := Allocate (DL + DL / Growth_Factor);
615 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
616 DR.Data (DL) := New_Item;
617 DR.Last := DL;
618 Source.Reference := DR;
619 Unreference (SR);
620 end if;
621 end Append;
623 -------------------
624 -- Can_Be_Reused --
625 -------------------
627 function Can_Be_Reused
628 (Item : Shared_Wide_String_Access;
629 Length : Natural) return Boolean is
630 begin
631 return
632 System.Atomic_Counters.Is_One (Item.Counter)
633 and then Item.Max_Length >= Length
634 and then Item.Max_Length <=
635 Aligned_Max_Length (Length + Length / Growth_Factor);
636 end Can_Be_Reused;
638 -----------
639 -- Count --
640 -----------
642 function Count
643 (Source : Unbounded_Wide_String;
644 Pattern : Wide_String;
645 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
646 return Natural
648 SR : constant Shared_Wide_String_Access := Source.Reference;
649 begin
650 return Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
651 end Count;
653 function Count
654 (Source : Unbounded_Wide_String;
655 Pattern : Wide_String;
656 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
658 SR : constant Shared_Wide_String_Access := Source.Reference;
659 begin
660 return Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
661 end Count;
663 function Count
664 (Source : Unbounded_Wide_String;
665 Set : Wide_Maps.Wide_Character_Set) return Natural
667 SR : constant Shared_Wide_String_Access := Source.Reference;
668 begin
669 return Wide_Search.Count (SR.Data (1 .. SR.Last), Set);
670 end Count;
672 ------------
673 -- Delete --
674 ------------
676 function Delete
677 (Source : Unbounded_Wide_String;
678 From : Positive;
679 Through : Natural) return Unbounded_Wide_String
681 SR : constant Shared_Wide_String_Access := Source.Reference;
682 DL : Natural;
683 DR : Shared_Wide_String_Access;
685 begin
686 -- Empty slice is deleted, use the same shared string
688 if From > Through then
689 Reference (SR);
690 DR := SR;
692 -- Index is out of range
694 elsif Through > SR.Last then
695 raise Index_Error;
697 -- Compute size of the result
699 else
700 DL := SR.Last - (Through - From + 1);
702 -- Result is an empty string, reuse shared empty string
704 if DL = 0 then
705 Reference (Empty_Shared_Wide_String'Access);
706 DR := Empty_Shared_Wide_String'Access;
708 -- Otherwise, allocate new shared string and fill it
710 else
711 DR := Allocate (DL);
712 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
713 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
714 DR.Last := DL;
715 end if;
716 end if;
718 return (AF.Controlled with Reference => DR);
719 end Delete;
721 procedure Delete
722 (Source : in out Unbounded_Wide_String;
723 From : Positive;
724 Through : Natural)
726 SR : constant Shared_Wide_String_Access := Source.Reference;
727 DL : Natural;
728 DR : Shared_Wide_String_Access;
730 begin
731 -- Nothing changed, return
733 if From > Through then
734 null;
736 -- Through is outside of the range
738 elsif Through > SR.Last then
739 raise Index_Error;
741 else
742 DL := SR.Last - (Through - From + 1);
744 -- Result is empty, reuse shared empty string
746 if DL = 0 then
747 Reference (Empty_Shared_Wide_String'Access);
748 Source.Reference := Empty_Shared_Wide_String'Access;
749 Unreference (SR);
751 -- Try to reuse existent shared string
753 elsif Can_Be_Reused (SR, DL) then
754 SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
755 SR.Last := DL;
757 -- Otherwise, allocate new shared string
759 else
760 DR := Allocate (DL);
761 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
762 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
763 DR.Last := DL;
764 Source.Reference := DR;
765 Unreference (SR);
766 end if;
767 end if;
768 end Delete;
770 -------------
771 -- Element --
772 -------------
774 function Element
775 (Source : Unbounded_Wide_String;
776 Index : Positive) return Wide_Character
778 SR : constant Shared_Wide_String_Access := Source.Reference;
779 begin
780 if Index <= SR.Last then
781 return SR.Data (Index);
782 else
783 raise Index_Error;
784 end if;
785 end Element;
787 --------------
788 -- Finalize --
789 --------------
791 procedure Finalize (Object : in out Unbounded_Wide_String) is
792 SR : constant Shared_Wide_String_Access := Object.Reference;
794 begin
795 if SR /= null then
797 -- The same controlled object can be finalized several times for
798 -- some reason. As per 7.6.1(24) this should have no ill effect,
799 -- so we need to add a guard for the case of finalizing the same
800 -- object twice.
802 Object.Reference := null;
803 Unreference (SR);
804 end if;
805 end Finalize;
807 ----------------
808 -- Find_Token --
809 ----------------
811 procedure Find_Token
812 (Source : Unbounded_Wide_String;
813 Set : Wide_Maps.Wide_Character_Set;
814 From : Positive;
815 Test : Strings.Membership;
816 First : out Positive;
817 Last : out Natural)
819 SR : constant Shared_Wide_String_Access := Source.Reference;
820 begin
821 Wide_Search.Find_Token
822 (SR.Data (From .. SR.Last), Set, Test, First, Last);
823 end Find_Token;
825 procedure Find_Token
826 (Source : Unbounded_Wide_String;
827 Set : Wide_Maps.Wide_Character_Set;
828 Test : Strings.Membership;
829 First : out Positive;
830 Last : out Natural)
832 SR : constant Shared_Wide_String_Access := Source.Reference;
833 begin
834 Wide_Search.Find_Token
835 (SR.Data (1 .. SR.Last), Set, Test, First, Last);
836 end Find_Token;
838 ----------
839 -- Free --
840 ----------
842 procedure Free (X : in out Wide_String_Access) is
843 procedure Deallocate is
844 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
845 begin
846 Deallocate (X);
847 end Free;
849 ----------
850 -- Head --
851 ----------
853 function Head
854 (Source : Unbounded_Wide_String;
855 Count : Natural;
856 Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String
858 SR : constant Shared_Wide_String_Access := Source.Reference;
859 DR : Shared_Wide_String_Access;
861 begin
862 -- Result is empty, reuse shared empty string
864 if Count = 0 then
865 Reference (Empty_Shared_Wide_String'Access);
866 DR := Empty_Shared_Wide_String'Access;
868 -- Length of the string is the same as requested, reuse source shared
869 -- string.
871 elsif Count = SR.Last then
872 Reference (SR);
873 DR := SR;
875 -- Otherwise, allocate new shared string and fill it
877 else
878 DR := Allocate (Count);
880 -- Length of the source string is more than requested, copy
881 -- corresponding slice.
883 if Count < SR.Last then
884 DR.Data (1 .. Count) := SR.Data (1 .. Count);
886 -- Length of the source string is less than requested, copy all
887 -- contents and fill others by Pad character.
889 else
890 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
892 for J in SR.Last + 1 .. Count loop
893 DR.Data (J) := Pad;
894 end loop;
895 end if;
897 DR.Last := Count;
898 end if;
900 return (AF.Controlled with Reference => DR);
901 end Head;
903 procedure Head
904 (Source : in out Unbounded_Wide_String;
905 Count : Natural;
906 Pad : Wide_Character := Wide_Space)
908 SR : constant Shared_Wide_String_Access := Source.Reference;
909 DR : Shared_Wide_String_Access;
911 begin
912 -- Result is empty, reuse empty shared string
914 if Count = 0 then
915 Reference (Empty_Shared_Wide_String'Access);
916 Source.Reference := Empty_Shared_Wide_String'Access;
917 Unreference (SR);
919 -- Result is same with source string, reuse source shared string
921 elsif Count = SR.Last then
922 null;
924 -- Try to reuse existent shared string
926 elsif Can_Be_Reused (SR, Count) then
927 if Count > SR.Last then
928 for J in SR.Last + 1 .. Count loop
929 SR.Data (J) := Pad;
930 end loop;
931 end if;
933 SR.Last := Count;
935 -- Otherwise, allocate new shared string and fill it
937 else
938 DR := Allocate (Count);
940 -- Length of the source string is greater than requested, copy
941 -- corresponding slice.
943 if Count < SR.Last then
944 DR.Data (1 .. Count) := SR.Data (1 .. Count);
946 -- Length of the source string is less than requested, copy all
947 -- exists data and fill others by Pad character.
949 else
950 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
952 for J in SR.Last + 1 .. Count loop
953 DR.Data (J) := Pad;
954 end loop;
955 end if;
957 DR.Last := Count;
958 Source.Reference := DR;
959 Unreference (SR);
960 end if;
961 end Head;
963 -----------
964 -- Index --
965 -----------
967 function Index
968 (Source : Unbounded_Wide_String;
969 Pattern : Wide_String;
970 Going : Strings.Direction := Strings.Forward;
971 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
972 return Natural
974 SR : constant Shared_Wide_String_Access := Source.Reference;
975 begin
976 return Wide_Search.Index
977 (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
978 end Index;
980 function Index
981 (Source : Unbounded_Wide_String;
982 Pattern : Wide_String;
983 Going : Direction := Forward;
984 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
986 SR : constant Shared_Wide_String_Access := Source.Reference;
987 begin
988 return Wide_Search.Index
989 (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
990 end Index;
992 function Index
993 (Source : Unbounded_Wide_String;
994 Set : Wide_Maps.Wide_Character_Set;
995 Test : Strings.Membership := Strings.Inside;
996 Going : Strings.Direction := Strings.Forward) return Natural
998 SR : constant Shared_Wide_String_Access := Source.Reference;
999 begin
1000 return Wide_Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going);
1001 end Index;
1003 function Index
1004 (Source : Unbounded_Wide_String;
1005 Pattern : Wide_String;
1006 From : Positive;
1007 Going : Direction := Forward;
1008 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
1009 return Natural
1011 SR : constant Shared_Wide_String_Access := Source.Reference;
1012 begin
1013 return Wide_Search.Index
1014 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1015 end Index;
1017 function Index
1018 (Source : Unbounded_Wide_String;
1019 Pattern : Wide_String;
1020 From : Positive;
1021 Going : Direction := Forward;
1022 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
1024 SR : constant Shared_Wide_String_Access := Source.Reference;
1025 begin
1026 return Wide_Search.Index
1027 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1028 end Index;
1030 function Index
1031 (Source : Unbounded_Wide_String;
1032 Set : Wide_Maps.Wide_Character_Set;
1033 From : Positive;
1034 Test : Membership := Inside;
1035 Going : Direction := Forward) return Natural
1037 SR : constant Shared_Wide_String_Access := Source.Reference;
1038 begin
1039 return Wide_Search.Index
1040 (SR.Data (1 .. SR.Last), Set, From, Test, Going);
1041 end Index;
1043 ---------------------
1044 -- Index_Non_Blank --
1045 ---------------------
1047 function Index_Non_Blank
1048 (Source : Unbounded_Wide_String;
1049 Going : Strings.Direction := Strings.Forward) return Natural
1051 SR : constant Shared_Wide_String_Access := Source.Reference;
1052 begin
1053 return Wide_Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going);
1054 end Index_Non_Blank;
1056 function Index_Non_Blank
1057 (Source : Unbounded_Wide_String;
1058 From : Positive;
1059 Going : Direction := Forward) return Natural
1061 SR : constant Shared_Wide_String_Access := Source.Reference;
1062 begin
1063 return Wide_Search.Index_Non_Blank
1064 (SR.Data (1 .. SR.Last), From, Going);
1065 end Index_Non_Blank;
1067 ----------------
1068 -- Initialize --
1069 ----------------
1071 procedure Initialize (Object : in out Unbounded_Wide_String) is
1072 begin
1073 Reference (Object.Reference);
1074 end Initialize;
1076 ------------
1077 -- Insert --
1078 ------------
1080 function Insert
1081 (Source : Unbounded_Wide_String;
1082 Before : Positive;
1083 New_Item : Wide_String) return Unbounded_Wide_String
1085 SR : constant Shared_Wide_String_Access := Source.Reference;
1086 DL : constant Natural := SR.Last + New_Item'Length;
1087 DR : Shared_Wide_String_Access;
1089 begin
1090 -- Check index first
1092 if Before > SR.Last + 1 then
1093 raise Index_Error;
1094 end if;
1096 -- Result is empty, reuse empty shared string
1098 if DL = 0 then
1099 Reference (Empty_Shared_Wide_String'Access);
1100 DR := Empty_Shared_Wide_String'Access;
1102 -- Inserted string is empty, reuse source shared string
1104 elsif New_Item'Length = 0 then
1105 Reference (SR);
1106 DR := SR;
1108 -- Otherwise, allocate new shared string and fill it
1110 else
1111 DR := Allocate (DL + DL / Growth_Factor);
1112 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1113 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1114 DR.Data (Before + New_Item'Length .. DL) :=
1115 SR.Data (Before .. SR.Last);
1116 DR.Last := DL;
1117 end if;
1119 return (AF.Controlled with Reference => DR);
1120 end Insert;
1122 procedure Insert
1123 (Source : in out Unbounded_Wide_String;
1124 Before : Positive;
1125 New_Item : Wide_String)
1127 SR : constant Shared_Wide_String_Access := Source.Reference;
1128 DL : constant Natural := SR.Last + New_Item'Length;
1129 DR : Shared_Wide_String_Access;
1131 begin
1132 -- Check bounds
1134 if Before > SR.Last + 1 then
1135 raise Index_Error;
1136 end if;
1138 -- Result is empty string, reuse empty shared string
1140 if DL = 0 then
1141 Reference (Empty_Shared_Wide_String'Access);
1142 Source.Reference := Empty_Shared_Wide_String'Access;
1143 Unreference (SR);
1145 -- Inserted string is empty, nothing to do
1147 elsif New_Item'Length = 0 then
1148 null;
1150 -- Try to reuse existent shared string first
1152 elsif Can_Be_Reused (SR, DL) then
1153 SR.Data (Before + New_Item'Length .. DL) :=
1154 SR.Data (Before .. SR.Last);
1155 SR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1156 SR.Last := DL;
1158 -- Otherwise, allocate new shared string and fill it
1160 else
1161 DR := Allocate (DL + DL / Growth_Factor);
1162 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1163 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1164 DR.Data (Before + New_Item'Length .. DL) :=
1165 SR.Data (Before .. SR.Last);
1166 DR.Last := DL;
1167 Source.Reference := DR;
1168 Unreference (SR);
1169 end if;
1170 end Insert;
1172 ------------
1173 -- Length --
1174 ------------
1176 function Length (Source : Unbounded_Wide_String) return Natural is
1177 begin
1178 return Source.Reference.Last;
1179 end Length;
1181 ---------------
1182 -- Overwrite --
1183 ---------------
1185 function Overwrite
1186 (Source : Unbounded_Wide_String;
1187 Position : Positive;
1188 New_Item : Wide_String) return Unbounded_Wide_String
1190 SR : constant Shared_Wide_String_Access := Source.Reference;
1191 DL : Natural;
1192 DR : Shared_Wide_String_Access;
1194 begin
1195 -- Check bounds
1197 if Position > SR.Last + 1 then
1198 raise Index_Error;
1199 end if;
1201 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1203 -- Result is empty string, reuse empty shared string
1205 if DL = 0 then
1206 Reference (Empty_Shared_Wide_String'Access);
1207 DR := Empty_Shared_Wide_String'Access;
1209 -- Result is same with source string, reuse source shared string
1211 elsif New_Item'Length = 0 then
1212 Reference (SR);
1213 DR := SR;
1215 -- Otherwise, allocate new shared string and fill it
1217 else
1218 DR := Allocate (DL);
1219 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1220 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1221 DR.Data (Position + New_Item'Length .. DL) :=
1222 SR.Data (Position + New_Item'Length .. SR.Last);
1223 DR.Last := DL;
1224 end if;
1226 return (AF.Controlled with Reference => DR);
1227 end Overwrite;
1229 procedure Overwrite
1230 (Source : in out Unbounded_Wide_String;
1231 Position : Positive;
1232 New_Item : Wide_String)
1234 SR : constant Shared_Wide_String_Access := Source.Reference;
1235 DL : Natural;
1236 DR : Shared_Wide_String_Access;
1238 begin
1239 -- Bounds check
1241 if Position > SR.Last + 1 then
1242 raise Index_Error;
1243 end if;
1245 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1247 -- Result is empty string, reuse empty shared string
1249 if DL = 0 then
1250 Reference (Empty_Shared_Wide_String'Access);
1251 Source.Reference := Empty_Shared_Wide_String'Access;
1252 Unreference (SR);
1254 -- String unchanged, nothing to do
1256 elsif New_Item'Length = 0 then
1257 null;
1259 -- Try to reuse existent shared string
1261 elsif Can_Be_Reused (SR, DL) then
1262 SR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1263 SR.Last := DL;
1265 -- Otherwise allocate new shared string and fill it
1267 else
1268 DR := Allocate (DL);
1269 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1270 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1271 DR.Data (Position + New_Item'Length .. DL) :=
1272 SR.Data (Position + New_Item'Length .. SR.Last);
1273 DR.Last := DL;
1274 Source.Reference := DR;
1275 Unreference (SR);
1276 end if;
1277 end Overwrite;
1279 ---------------
1280 -- Reference --
1281 ---------------
1283 procedure Reference (Item : not null Shared_Wide_String_Access) is
1284 begin
1285 System.Atomic_Counters.Increment (Item.Counter);
1286 end Reference;
1288 ---------------------
1289 -- Replace_Element --
1290 ---------------------
1292 procedure Replace_Element
1293 (Source : in out Unbounded_Wide_String;
1294 Index : Positive;
1295 By : Wide_Character)
1297 SR : constant Shared_Wide_String_Access := Source.Reference;
1298 DR : Shared_Wide_String_Access;
1300 begin
1301 -- Bounds check
1303 if Index <= SR.Last then
1305 -- Try to reuse existent shared string
1307 if Can_Be_Reused (SR, SR.Last) then
1308 SR.Data (Index) := By;
1310 -- Otherwise allocate new shared string and fill it
1312 else
1313 DR := Allocate (SR.Last);
1314 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
1315 DR.Data (Index) := By;
1316 DR.Last := SR.Last;
1317 Source.Reference := DR;
1318 Unreference (SR);
1319 end if;
1321 else
1322 raise Index_Error;
1323 end if;
1324 end Replace_Element;
1326 -------------------
1327 -- Replace_Slice --
1328 -------------------
1330 function Replace_Slice
1331 (Source : Unbounded_Wide_String;
1332 Low : Positive;
1333 High : Natural;
1334 By : Wide_String) return Unbounded_Wide_String
1336 SR : constant Shared_Wide_String_Access := Source.Reference;
1337 DL : Natural;
1338 DR : Shared_Wide_String_Access;
1340 begin
1341 -- Check bounds
1343 if Low > SR.Last + 1 then
1344 raise Index_Error;
1345 end if;
1347 -- Do replace operation when removed slice is not empty
1349 if High >= Low then
1350 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
1351 -- This is the number of characters remaining in the string after
1352 -- replacing the slice.
1354 -- Result is empty string, reuse empty shared string
1356 if DL = 0 then
1357 Reference (Empty_Shared_Wide_String'Access);
1358 DR := Empty_Shared_Wide_String'Access;
1360 -- Otherwise allocate new shared string and fill it
1362 else
1363 DR := Allocate (DL);
1364 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1365 DR.Data (Low .. Low + By'Length - 1) := By;
1366 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1367 DR.Last := DL;
1368 end if;
1370 return (AF.Controlled with Reference => DR);
1372 -- Otherwise just insert string
1374 else
1375 return Insert (Source, Low, By);
1376 end if;
1377 end Replace_Slice;
1379 procedure Replace_Slice
1380 (Source : in out Unbounded_Wide_String;
1381 Low : Positive;
1382 High : Natural;
1383 By : Wide_String)
1385 SR : constant Shared_Wide_String_Access := Source.Reference;
1386 DL : Natural;
1387 DR : Shared_Wide_String_Access;
1389 begin
1390 -- Bounds check
1392 if Low > SR.Last + 1 then
1393 raise Index_Error;
1394 end if;
1396 -- Do replace operation only when replaced slice is not empty
1398 if High >= Low then
1399 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
1400 -- This is the number of characters remaining in the string after
1401 -- replacing the slice.
1403 -- Result is empty string, reuse empty shared string
1405 if DL = 0 then
1406 Reference (Empty_Shared_Wide_String'Access);
1407 Source.Reference := Empty_Shared_Wide_String'Access;
1408 Unreference (SR);
1410 -- Try to reuse existent shared string
1412 elsif Can_Be_Reused (SR, DL) then
1413 SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1414 SR.Data (Low .. Low + By'Length - 1) := By;
1415 SR.Last := DL;
1417 -- Otherwise allocate new shared string and fill it
1419 else
1420 DR := Allocate (DL);
1421 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1422 DR.Data (Low .. Low + By'Length - 1) := By;
1423 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1424 DR.Last := DL;
1425 Source.Reference := DR;
1426 Unreference (SR);
1427 end if;
1429 -- Otherwise just insert item
1431 else
1432 Insert (Source, Low, By);
1433 end if;
1434 end Replace_Slice;
1436 -------------------------------
1437 -- Set_Unbounded_Wide_String --
1438 -------------------------------
1440 procedure Set_Unbounded_Wide_String
1441 (Target : out Unbounded_Wide_String;
1442 Source : Wide_String)
1444 TR : constant Shared_Wide_String_Access := Target.Reference;
1445 DR : Shared_Wide_String_Access;
1447 begin
1448 -- In case of empty string, reuse empty shared string
1450 if Source'Length = 0 then
1451 Reference (Empty_Shared_Wide_String'Access);
1452 Target.Reference := Empty_Shared_Wide_String'Access;
1454 else
1455 -- Try to reuse existent shared string
1457 if Can_Be_Reused (TR, Source'Length) then
1458 Reference (TR);
1459 DR := TR;
1461 -- Otherwise allocate new shared string
1463 else
1464 DR := Allocate (Source'Length);
1465 Target.Reference := DR;
1466 end if;
1468 DR.Data (1 .. Source'Length) := Source;
1469 DR.Last := Source'Length;
1470 end if;
1472 Unreference (TR);
1473 end Set_Unbounded_Wide_String;
1475 -----------
1476 -- Slice --
1477 -----------
1479 function Slice
1480 (Source : Unbounded_Wide_String;
1481 Low : Positive;
1482 High : Natural) return Wide_String
1484 SR : constant Shared_Wide_String_Access := Source.Reference;
1486 begin
1487 -- Note: test of High > Length is in accordance with AI95-00128
1489 if Low > SR.Last + 1 or else High > SR.Last then
1490 raise Index_Error;
1492 else
1493 return SR.Data (Low .. High);
1494 end if;
1495 end Slice;
1497 ----------
1498 -- Tail --
1499 ----------
1501 function Tail
1502 (Source : Unbounded_Wide_String;
1503 Count : Natural;
1504 Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String
1506 SR : constant Shared_Wide_String_Access := Source.Reference;
1507 DR : Shared_Wide_String_Access;
1509 begin
1510 -- For empty result reuse empty shared string
1512 if Count = 0 then
1513 Reference (Empty_Shared_Wide_String'Access);
1514 DR := Empty_Shared_Wide_String'Access;
1516 -- Result is hole source string, reuse source shared string
1518 elsif Count = SR.Last then
1519 Reference (SR);
1520 DR := SR;
1522 -- Otherwise allocate new shared string and fill it
1524 else
1525 DR := Allocate (Count);
1527 if Count < SR.Last then
1528 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1530 else
1531 for J in 1 .. Count - SR.Last loop
1532 DR.Data (J) := Pad;
1533 end loop;
1535 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1536 end if;
1538 DR.Last := Count;
1539 end if;
1541 return (AF.Controlled with Reference => DR);
1542 end Tail;
1544 procedure Tail
1545 (Source : in out Unbounded_Wide_String;
1546 Count : Natural;
1547 Pad : Wide_Character := Wide_Space)
1549 SR : constant Shared_Wide_String_Access := Source.Reference;
1550 DR : Shared_Wide_String_Access;
1552 procedure Common
1553 (SR : Shared_Wide_String_Access;
1554 DR : Shared_Wide_String_Access;
1555 Count : Natural);
1556 -- Common code of tail computation. SR/DR can point to the same object
1558 ------------
1559 -- Common --
1560 ------------
1562 procedure Common
1563 (SR : Shared_Wide_String_Access;
1564 DR : Shared_Wide_String_Access;
1565 Count : Natural) is
1566 begin
1567 if Count < SR.Last then
1568 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1570 else
1571 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1573 for J in 1 .. Count - SR.Last loop
1574 DR.Data (J) := Pad;
1575 end loop;
1576 end if;
1578 DR.Last := Count;
1579 end Common;
1581 begin
1582 -- Result is empty string, reuse empty shared string
1584 if Count = 0 then
1585 Reference (Empty_Shared_Wide_String'Access);
1586 Source.Reference := Empty_Shared_Wide_String'Access;
1587 Unreference (SR);
1589 -- Length of the result is the same with length of the source string,
1590 -- reuse source shared string.
1592 elsif Count = SR.Last then
1593 null;
1595 -- Try to reuse existent shared string
1597 elsif Can_Be_Reused (SR, Count) then
1598 Common (SR, SR, Count);
1600 -- Otherwise allocate new shared string and fill it
1602 else
1603 DR := Allocate (Count);
1604 Common (SR, DR, Count);
1605 Source.Reference := DR;
1606 Unreference (SR);
1607 end if;
1608 end Tail;
1610 --------------------
1611 -- To_Wide_String --
1612 --------------------
1614 function To_Wide_String
1615 (Source : Unbounded_Wide_String) return Wide_String is
1616 begin
1617 return Source.Reference.Data (1 .. Source.Reference.Last);
1618 end To_Wide_String;
1620 ------------------------------
1621 -- To_Unbounded_Wide_String --
1622 ------------------------------
1624 function To_Unbounded_Wide_String
1625 (Source : Wide_String) return Unbounded_Wide_String
1627 DR : constant Shared_Wide_String_Access := Allocate (Source'Length);
1628 begin
1629 DR.Data (1 .. Source'Length) := Source;
1630 DR.Last := Source'Length;
1631 return (AF.Controlled with Reference => DR);
1632 end To_Unbounded_Wide_String;
1634 function To_Unbounded_Wide_String
1635 (Length : Natural) return Unbounded_Wide_String
1637 DR : constant Shared_Wide_String_Access := Allocate (Length);
1638 begin
1639 DR.Last := Length;
1640 return (AF.Controlled with Reference => DR);
1641 end To_Unbounded_Wide_String;
1643 ---------------
1644 -- Translate --
1645 ---------------
1647 function Translate
1648 (Source : Unbounded_Wide_String;
1649 Mapping : Wide_Maps.Wide_Character_Mapping) return Unbounded_Wide_String
1651 SR : constant Shared_Wide_String_Access := Source.Reference;
1652 DR : Shared_Wide_String_Access;
1654 begin
1655 -- Nothing to translate, reuse empty shared string
1657 if SR.Last = 0 then
1658 Reference (Empty_Shared_Wide_String'Access);
1659 DR := Empty_Shared_Wide_String'Access;
1661 -- Otherwise, allocate new shared string and fill it
1663 else
1664 DR := Allocate (SR.Last);
1666 for J in 1 .. SR.Last loop
1667 DR.Data (J) := Value (Mapping, SR.Data (J));
1668 end loop;
1670 DR.Last := SR.Last;
1671 end if;
1673 return (AF.Controlled with Reference => DR);
1674 end Translate;
1676 procedure Translate
1677 (Source : in out Unbounded_Wide_String;
1678 Mapping : Wide_Maps.Wide_Character_Mapping)
1680 SR : constant Shared_Wide_String_Access := Source.Reference;
1681 DR : Shared_Wide_String_Access;
1683 begin
1684 -- Nothing to translate
1686 if SR.Last = 0 then
1687 null;
1689 -- Try to reuse shared string
1691 elsif Can_Be_Reused (SR, SR.Last) then
1692 for J in 1 .. SR.Last loop
1693 SR.Data (J) := Value (Mapping, SR.Data (J));
1694 end loop;
1696 -- Otherwise, allocate new shared string
1698 else
1699 DR := Allocate (SR.Last);
1701 for J in 1 .. SR.Last loop
1702 DR.Data (J) := Value (Mapping, SR.Data (J));
1703 end loop;
1705 DR.Last := SR.Last;
1706 Source.Reference := DR;
1707 Unreference (SR);
1708 end if;
1709 end Translate;
1711 function Translate
1712 (Source : Unbounded_Wide_String;
1713 Mapping : Wide_Maps.Wide_Character_Mapping_Function)
1714 return Unbounded_Wide_String
1716 SR : constant Shared_Wide_String_Access := Source.Reference;
1717 DR : Shared_Wide_String_Access;
1719 begin
1720 -- Nothing to translate, reuse empty shared string
1722 if SR.Last = 0 then
1723 Reference (Empty_Shared_Wide_String'Access);
1724 DR := Empty_Shared_Wide_String'Access;
1726 -- Otherwise, allocate new shared string and fill it
1728 else
1729 DR := Allocate (SR.Last);
1731 for J in 1 .. SR.Last loop
1732 DR.Data (J) := Mapping.all (SR.Data (J));
1733 end loop;
1735 DR.Last := SR.Last;
1736 end if;
1738 return (AF.Controlled with Reference => DR);
1740 exception
1741 when others =>
1742 Unreference (DR);
1744 raise;
1745 end Translate;
1747 procedure Translate
1748 (Source : in out Unbounded_Wide_String;
1749 Mapping : Wide_Maps.Wide_Character_Mapping_Function)
1751 SR : constant Shared_Wide_String_Access := Source.Reference;
1752 DR : Shared_Wide_String_Access;
1754 begin
1755 -- Nothing to translate
1757 if SR.Last = 0 then
1758 null;
1760 -- Try to reuse shared string
1762 elsif Can_Be_Reused (SR, SR.Last) then
1763 for J in 1 .. SR.Last loop
1764 SR.Data (J) := Mapping.all (SR.Data (J));
1765 end loop;
1767 -- Otherwise allocate new shared string and fill it
1769 else
1770 DR := Allocate (SR.Last);
1772 for J in 1 .. SR.Last loop
1773 DR.Data (J) := Mapping.all (SR.Data (J));
1774 end loop;
1776 DR.Last := SR.Last;
1777 Source.Reference := DR;
1778 Unreference (SR);
1779 end if;
1781 exception
1782 when others =>
1783 if DR /= null then
1784 Unreference (DR);
1785 end if;
1787 raise;
1788 end Translate;
1790 ----------
1791 -- Trim --
1792 ----------
1794 function Trim
1795 (Source : Unbounded_Wide_String;
1796 Side : Trim_End) return Unbounded_Wide_String
1798 SR : constant Shared_Wide_String_Access := Source.Reference;
1799 DL : Natural;
1800 DR : Shared_Wide_String_Access;
1801 Low : Natural;
1802 High : Natural;
1804 begin
1805 Low := Index_Non_Blank (Source, Forward);
1807 -- All blanks, reuse empty shared string
1809 if Low = 0 then
1810 Reference (Empty_Shared_Wide_String'Access);
1811 DR := Empty_Shared_Wide_String'Access;
1813 else
1814 case Side is
1815 when Left =>
1816 High := SR.Last;
1817 DL := SR.Last - Low + 1;
1819 when Right =>
1820 Low := 1;
1821 High := Index_Non_Blank (Source, Backward);
1822 DL := High;
1824 when Both =>
1825 High := Index_Non_Blank (Source, Backward);
1826 DL := High - Low + 1;
1827 end case;
1829 -- Length of the result is the same as length of the source string,
1830 -- reuse source shared string.
1832 if DL = SR.Last then
1833 Reference (SR);
1834 DR := SR;
1836 -- Otherwise, allocate new shared string
1838 else
1839 DR := Allocate (DL);
1840 DR.Data (1 .. DL) := SR.Data (Low .. High);
1841 DR.Last := DL;
1842 end if;
1843 end if;
1845 return (AF.Controlled with Reference => DR);
1846 end Trim;
1848 procedure Trim
1849 (Source : in out Unbounded_Wide_String;
1850 Side : Trim_End)
1852 SR : constant Shared_Wide_String_Access := Source.Reference;
1853 DL : Natural;
1854 DR : Shared_Wide_String_Access;
1855 Low : Natural;
1856 High : Natural;
1858 begin
1859 Low := Index_Non_Blank (Source, Forward);
1861 -- All blanks, reuse empty shared string
1863 if Low = 0 then
1864 Reference (Empty_Shared_Wide_String'Access);
1865 Source.Reference := Empty_Shared_Wide_String'Access;
1866 Unreference (SR);
1868 else
1869 case Side is
1870 when Left =>
1871 High := SR.Last;
1872 DL := SR.Last - Low + 1;
1874 when Right =>
1875 Low := 1;
1876 High := Index_Non_Blank (Source, Backward);
1877 DL := High;
1879 when Both =>
1880 High := Index_Non_Blank (Source, Backward);
1881 DL := High - Low + 1;
1882 end case;
1884 -- Length of the result is the same as length of the source string,
1885 -- nothing to do.
1887 if DL = SR.Last then
1888 null;
1890 -- Try to reuse existent shared string
1892 elsif Can_Be_Reused (SR, DL) then
1893 SR.Data (1 .. DL) := SR.Data (Low .. High);
1894 SR.Last := DL;
1896 -- Otherwise, allocate new shared string
1898 else
1899 DR := Allocate (DL);
1900 DR.Data (1 .. DL) := SR.Data (Low .. High);
1901 DR.Last := DL;
1902 Source.Reference := DR;
1903 Unreference (SR);
1904 end if;
1905 end if;
1906 end Trim;
1908 function Trim
1909 (Source : Unbounded_Wide_String;
1910 Left : Wide_Maps.Wide_Character_Set;
1911 Right : Wide_Maps.Wide_Character_Set) return Unbounded_Wide_String
1913 SR : constant Shared_Wide_String_Access := Source.Reference;
1914 DL : Natural;
1915 DR : Shared_Wide_String_Access;
1916 Low : Natural;
1917 High : Natural;
1919 begin
1920 Low := Index (Source, Left, Outside, Forward);
1922 -- Source includes only characters from Left set, reuse empty shared
1923 -- string.
1925 if Low = 0 then
1926 Reference (Empty_Shared_Wide_String'Access);
1927 DR := Empty_Shared_Wide_String'Access;
1929 else
1930 High := Index (Source, Right, Outside, Backward);
1931 DL := Integer'Max (0, High - Low + 1);
1933 -- Source includes only characters from Right set or result string
1934 -- is empty, reuse empty shared string.
1936 if High = 0 or else DL = 0 then
1937 Reference (Empty_Shared_Wide_String'Access);
1938 DR := Empty_Shared_Wide_String'Access;
1940 -- Otherwise, allocate new shared string and fill it
1942 else
1943 DR := Allocate (DL);
1944 DR.Data (1 .. DL) := SR.Data (Low .. High);
1945 DR.Last := DL;
1946 end if;
1947 end if;
1949 return (AF.Controlled with Reference => DR);
1950 end Trim;
1952 procedure Trim
1953 (Source : in out Unbounded_Wide_String;
1954 Left : Wide_Maps.Wide_Character_Set;
1955 Right : Wide_Maps.Wide_Character_Set)
1957 SR : constant Shared_Wide_String_Access := Source.Reference;
1958 DL : Natural;
1959 DR : Shared_Wide_String_Access;
1960 Low : Natural;
1961 High : Natural;
1963 begin
1964 Low := Index (Source, Left, Outside, Forward);
1966 -- Source includes only characters from Left set, reuse empty shared
1967 -- string.
1969 if Low = 0 then
1970 Reference (Empty_Shared_Wide_String'Access);
1971 Source.Reference := Empty_Shared_Wide_String'Access;
1972 Unreference (SR);
1974 else
1975 High := Index (Source, Right, Outside, Backward);
1976 DL := Integer'Max (0, High - Low + 1);
1978 -- Source includes only characters from Right set or result string
1979 -- is empty, reuse empty shared string.
1981 if High = 0 or else DL = 0 then
1982 Reference (Empty_Shared_Wide_String'Access);
1983 Source.Reference := Empty_Shared_Wide_String'Access;
1984 Unreference (SR);
1986 -- Try to reuse existent shared string
1988 elsif Can_Be_Reused (SR, DL) then
1989 SR.Data (1 .. DL) := SR.Data (Low .. High);
1990 SR.Last := DL;
1992 -- Otherwise, allocate new shared string and fill it
1994 else
1995 DR := Allocate (DL);
1996 DR.Data (1 .. DL) := SR.Data (Low .. High);
1997 DR.Last := DL;
1998 Source.Reference := DR;
1999 Unreference (SR);
2000 end if;
2001 end if;
2002 end Trim;
2004 ---------------------
2005 -- Unbounded_Slice --
2006 ---------------------
2008 function Unbounded_Slice
2009 (Source : Unbounded_Wide_String;
2010 Low : Positive;
2011 High : Natural) return Unbounded_Wide_String
2013 SR : constant Shared_Wide_String_Access := Source.Reference;
2014 DL : Natural;
2015 DR : Shared_Wide_String_Access;
2017 begin
2018 -- Check bounds
2020 if Low > SR.Last + 1 or else High > SR.Last then
2021 raise Index_Error;
2023 -- Result is empty slice, reuse empty shared string
2025 elsif Low > High then
2026 Reference (Empty_Shared_Wide_String'Access);
2027 DR := Empty_Shared_Wide_String'Access;
2029 -- Otherwise, allocate new shared string and fill it
2031 else
2032 DL := High - Low + 1;
2033 DR := Allocate (DL);
2034 DR.Data (1 .. DL) := SR.Data (Low .. High);
2035 DR.Last := DL;
2036 end if;
2038 return (AF.Controlled with Reference => DR);
2039 end Unbounded_Slice;
2041 procedure Unbounded_Slice
2042 (Source : Unbounded_Wide_String;
2043 Target : out Unbounded_Wide_String;
2044 Low : Positive;
2045 High : Natural)
2047 SR : constant Shared_Wide_String_Access := Source.Reference;
2048 TR : constant Shared_Wide_String_Access := Target.Reference;
2049 DL : Natural;
2050 DR : Shared_Wide_String_Access;
2052 begin
2053 -- Check bounds
2055 if Low > SR.Last + 1 or else High > SR.Last then
2056 raise Index_Error;
2058 -- Result is empty slice, reuse empty shared string
2060 elsif Low > High then
2061 Reference (Empty_Shared_Wide_String'Access);
2062 Target.Reference := Empty_Shared_Wide_String'Access;
2063 Unreference (TR);
2065 else
2066 DL := High - Low + 1;
2068 -- Try to reuse existent shared string
2070 if Can_Be_Reused (TR, DL) then
2071 TR.Data (1 .. DL) := SR.Data (Low .. High);
2072 TR.Last := DL;
2074 -- Otherwise, allocate new shared string and fill it
2076 else
2077 DR := Allocate (DL);
2078 DR.Data (1 .. DL) := SR.Data (Low .. High);
2079 DR.Last := DL;
2080 Target.Reference := DR;
2081 Unreference (TR);
2082 end if;
2083 end if;
2084 end Unbounded_Slice;
2086 -----------------
2087 -- Unreference --
2088 -----------------
2090 procedure Unreference (Item : not null Shared_Wide_String_Access) is
2092 procedure Free is
2093 new Ada.Unchecked_Deallocation
2094 (Shared_Wide_String, Shared_Wide_String_Access);
2096 Aux : Shared_Wide_String_Access := Item;
2098 begin
2099 if System.Atomic_Counters.Decrement (Aux.Counter) then
2101 -- Reference counter of Empty_Shared_Wide_String must never reach
2102 -- zero.
2104 pragma Assert (Aux /= Empty_Shared_Wide_String'Access);
2106 Free (Aux);
2107 end if;
2108 end Unreference;
2110 end Ada.Strings.Wide_Unbounded;