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