1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . S T R I N G S . U N B O U N D E D --
9 -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada.Strings.Search;
33 with Ada.Unchecked_Deallocation;
35 package body Ada.Strings.Unbounded is
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 the
56 -- allocated memory segments to use memory effectively by Append/Insert/etc
64 (Left : Unbounded_String;
65 Right : Unbounded_String) return Unbounded_String
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;
73 -- Result is an empty string, reuse shared empty string
76 Reference (Empty_Shared_String'Access);
77 DR := Empty_Shared_String'Access;
79 -- Left string is empty, return Right string
81 elsif LR.Last = 0 then
85 -- Right string is empty, return Left string
87 elsif RR.Last = 0 then
91 -- Otherwise, allocate new shared string and fill data
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);
100 return (AF.Controlled with Reference => DR);
104 (Left : Unbounded_String;
105 Right : String) return Unbounded_String
107 LR : constant Shared_String_Access := Left.Reference;
108 DL : constant Natural := LR.Last + Right'Length;
109 DR : Shared_String_Access;
112 -- Result is an empty string, reuse shared empty string
115 Reference (Empty_Shared_String'Access);
116 DR := Empty_Shared_String'Access;
118 -- Right is an empty string, return Left string
120 elsif Right'Length = 0 then
124 -- Otherwise, allocate new shared string and fill it
128 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
129 DR.Data (LR.Last + 1 .. DL) := Right;
133 return (AF.Controlled with Reference => DR);
138 Right : Unbounded_String) return Unbounded_String
140 RR : constant Shared_String_Access := Right.Reference;
141 DL : constant Natural := Left'Length + RR.Last;
142 DR : Shared_String_Access;
145 -- Result is an empty string, reuse shared one
148 Reference (Empty_Shared_String'Access);
149 DR := Empty_Shared_String'Access;
151 -- Left is empty string, return Right string
153 elsif Left'Length = 0 then
157 -- Otherwise, allocate new shared string and fill it
161 DR.Data (1 .. Left'Length) := Left;
162 DR.Data (Left'Length + 1 .. DL) := RR.Data (1 .. RR.Last);
166 return (AF.Controlled with Reference => DR);
170 (Left : Unbounded_String;
171 Right : Character) return Unbounded_String
173 LR : constant Shared_String_Access := Left.Reference;
174 DL : constant Natural := LR.Last + 1;
175 DR : Shared_String_Access;
179 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
180 DR.Data (DL) := Right;
183 return (AF.Controlled with Reference => DR);
188 Right : Unbounded_String) return Unbounded_String
190 RR : constant Shared_String_Access := Right.Reference;
191 DL : constant Natural := 1 + RR.Last;
192 DR : Shared_String_Access;
197 DR.Data (2 .. DL) := RR.Data (1 .. RR.Last);
200 return (AF.Controlled with Reference => DR);
209 Right : Character) return Unbounded_String
211 DR : Shared_String_Access;
214 -- Result is an empty string, reuse shared empty string
217 Reference (Empty_Shared_String'Access);
218 DR := Empty_Shared_String'Access;
220 -- Otherwise, allocate new shared string and fill it
223 DR := Allocate (Left);
225 for J in 1 .. Left loop
226 DR.Data (J) := Right;
232 return (AF.Controlled with Reference => DR);
237 Right : String) return Unbounded_String
239 DL : constant Natural := Left * Right'Length;
240 DR : Shared_String_Access;
244 -- Result is an empty string, reuse shared empty string
247 Reference (Empty_Shared_String'Access);
248 DR := Empty_Shared_String'Access;
250 -- Otherwise, allocate new shared string and fill it
256 for J in 1 .. Left loop
257 DR.Data (K .. K + Right'Length - 1) := Right;
258 K := K + Right'Length;
264 return (AF.Controlled with Reference => DR);
269 Right : Unbounded_String) return Unbounded_String
271 RR : constant Shared_String_Access := Right.Reference;
272 DL : constant Natural := Left * RR.Last;
273 DR : Shared_String_Access;
277 -- Result is an empty string, reuse shared empty string
280 Reference (Empty_Shared_String'Access);
281 DR := Empty_Shared_String'Access;
283 -- Coefficient is one, just return string itself
289 -- Otherwise, allocate new shared string and fill it
295 for J in 1 .. Left loop
296 DR.Data (K .. K + RR.Last - 1) := RR.Data (1 .. RR.Last);
303 return (AF.Controlled with Reference => DR);
311 (Left : Unbounded_String;
312 Right : Unbounded_String) return Boolean
314 LR : constant Shared_String_Access := Left.Reference;
315 RR : constant Shared_String_Access := Right.Reference;
317 return LR.Data (1 .. LR.Last) < RR.Data (1 .. RR.Last);
321 (Left : Unbounded_String;
322 Right : String) return Boolean
324 LR : constant Shared_String_Access := Left.Reference;
326 return LR.Data (1 .. LR.Last) < Right;
331 Right : Unbounded_String) return Boolean
333 RR : constant Shared_String_Access := Right.Reference;
335 return Left < RR.Data (1 .. RR.Last);
343 (Left : Unbounded_String;
344 Right : Unbounded_String) return Boolean
346 LR : constant Shared_String_Access := Left.Reference;
347 RR : constant Shared_String_Access := Right.Reference;
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);
356 (Left : Unbounded_String;
357 Right : String) return Boolean
359 LR : constant Shared_String_Access := Left.Reference;
361 return LR.Data (1 .. LR.Last) <= Right;
366 Right : Unbounded_String) return Boolean
368 RR : constant Shared_String_Access := Right.Reference;
370 return Left <= RR.Data (1 .. RR.Last);
378 (Left : Unbounded_String;
379 Right : Unbounded_String) return Boolean
381 LR : constant Shared_String_Access := Left.Reference;
382 RR : constant Shared_String_Access := Right.Reference;
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
390 (Left : Unbounded_String;
391 Right : String) return Boolean
393 LR : constant Shared_String_Access := Left.Reference;
395 return LR.Data (1 .. LR.Last) = Right;
400 Right : Unbounded_String) return Boolean
402 RR : constant Shared_String_Access := Right.Reference;
404 return Left = RR.Data (1 .. RR.Last);
412 (Left : Unbounded_String;
413 Right : Unbounded_String) return Boolean
415 LR : constant Shared_String_Access := Left.Reference;
416 RR : constant Shared_String_Access := Right.Reference;
418 return LR.Data (1 .. LR.Last) > RR.Data (1 .. RR.Last);
422 (Left : Unbounded_String;
423 Right : String) return Boolean
425 LR : constant Shared_String_Access := Left.Reference;
427 return LR.Data (1 .. LR.Last) > Right;
432 Right : Unbounded_String) return Boolean
434 RR : constant Shared_String_Access := Right.Reference;
436 return Left > RR.Data (1 .. RR.Last);
444 (Left : Unbounded_String;
445 Right : Unbounded_String) return Boolean
447 LR : constant Shared_String_Access := Left.Reference;
448 RR : constant Shared_String_Access := Right.Reference;
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);
457 (Left : Unbounded_String;
458 Right : String) return Boolean
460 LR : constant Shared_String_Access := Left.Reference;
462 return LR.Data (1 .. LR.Last) >= Right;
467 Right : Unbounded_String) return Boolean
469 RR : constant Shared_String_Access := Right.Reference;
471 return Left >= RR.Data (1 .. RR.Last);
478 procedure Adjust (Object : in out Unbounded_String) is
480 Reference (Object.Reference);
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_String'Size / Standard'Storage_Unit;
490 -- Total size of all static components
494 ((Static_Size + Max_Length - 1) / Min_Mul_Alloc + 2) * Min_Mul_Alloc
496 end Aligned_Max_Length;
502 function Allocate (Max_Length : Natural) return Shared_String_Access is
504 -- Empty string requested, return shared empty string
506 if Max_Length = 0 then
507 Reference (Empty_Shared_String'Access);
508 return Empty_Shared_String'Access;
510 -- Otherwise, allocate requested space (and probably some more room)
513 return new Shared_String (Aligned_Max_Length (Max_Length));
522 (Source : in out Unbounded_String;
523 New_Item : Unbounded_String)
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;
531 -- Source is an empty string, reuse New_Item data
535 Source.Reference := NR;
538 -- New_Item is empty string, nothing to do
540 elsif NR.Last = 0 then
543 -- Try to reuse existing shared string
545 elsif Can_Be_Reused (SR, DL) then
546 SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
549 -- Otherwise, allocate new one and fill it
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);
556 Source.Reference := DR;
562 (Source : in out Unbounded_String;
565 SR : constant Shared_String_Access := Source.Reference;
566 DL : constant Natural := SR.Last + New_Item'Length;
567 DR : Shared_String_Access;
570 -- New_Item is an empty string, nothing to do
572 if New_Item'Length = 0 then
575 -- Try to reuse existing shared string
577 elsif Can_Be_Reused (SR, DL) then
578 SR.Data (SR.Last + 1 .. DL) := New_Item;
581 -- Otherwise, allocate new one and fill it
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;
588 Source.Reference := DR;
594 (Source : in out Unbounded_String;
595 New_Item : Character)
597 SR : constant Shared_String_Access := Source.Reference;
598 DL : constant Natural := SR.Last + 1;
599 DR : Shared_String_Access;
602 -- Try to reuse existing shared string
604 if Can_Be_Reused (SR, SR.Last + 1) then
605 SR.Data (SR.Last + 1) := New_Item;
606 SR.Last := SR.Last + 1;
608 -- Otherwise, allocate new one and fill it
611 DR := Allocate (DL + DL / Growth_Factor);
612 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
613 DR.Data (DL) := New_Item;
615 Source.Reference := DR;
624 function Can_Be_Reused
625 (Item : Shared_String_Access;
626 Length : Natural) return Boolean is
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);
640 (Source : Unbounded_String;
642 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
644 SR : constant Shared_String_Access := Source.Reference;
646 return Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
650 (Source : Unbounded_String;
652 Mapping : Maps.Character_Mapping_Function) return Natural
654 SR : constant Shared_String_Access := Source.Reference;
656 return Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
660 (Source : Unbounded_String;
661 Set : Maps.Character_Set) return Natural
663 SR : constant Shared_String_Access := Source.Reference;
665 return Search.Count (SR.Data (1 .. SR.Last), Set);
673 (Source : Unbounded_String;
675 Through : Natural) return Unbounded_String
677 SR : constant Shared_String_Access := Source.Reference;
679 DR : Shared_String_Access;
682 -- Empty slice is deleted, use the same shared string
684 if From > Through then
688 -- Index is out of range
690 elsif Through > SR.Last then
693 -- Compute size of the result
696 DL := SR.Last - (Through - From + 1);
698 -- Result is an empty string, reuse shared empty string
701 Reference (Empty_Shared_String'Access);
702 DR := Empty_Shared_String'Access;
704 -- Otherwise, allocate new shared string and fill it
708 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
709 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
714 return (AF.Controlled with Reference => DR);
718 (Source : in out Unbounded_String;
722 SR : constant Shared_String_Access := Source.Reference;
724 DR : Shared_String_Access;
727 -- Nothing changed, return
729 if From > Through then
732 -- Through is outside of the range
734 elsif Through > SR.Last then
738 DL := SR.Last - (Through - From + 1);
740 -- Result is empty, reuse shared empty string
743 Reference (Empty_Shared_String'Access);
744 Source.Reference := Empty_Shared_String'Access;
747 -- Try to reuse existing shared string
749 elsif Can_Be_Reused (SR, DL) then
750 SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
753 -- Otherwise, allocate new shared string
757 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
758 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
760 Source.Reference := DR;
771 (Source : Unbounded_String;
772 Index : Positive) return Character
774 SR : constant Shared_String_Access := Source.Reference;
776 if Index <= SR.Last then
777 return SR.Data (Index);
787 procedure Finalize (Object : in out Unbounded_String) is
788 SR : constant Shared_String_Access := Object.Reference;
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
798 Object.Reference := null;
808 (Source : Unbounded_String;
809 Set : Maps.Character_Set;
811 Test : Strings.Membership;
812 First : out Positive;
815 SR : constant Shared_String_Access := Source.Reference;
817 Search.Find_Token (SR.Data (From .. SR.Last), Set, Test, First, Last);
821 (Source : Unbounded_String;
822 Set : Maps.Character_Set;
823 Test : Strings.Membership;
824 First : out Positive;
827 SR : constant Shared_String_Access := Source.Reference;
829 Search.Find_Token (SR.Data (1 .. SR.Last), Set, Test, First, Last);
836 procedure Free (X : in out String_Access) is
837 procedure Deallocate is
838 new Ada.Unchecked_Deallocation (String, String_Access);
848 (Source : Unbounded_String;
850 Pad : Character := Space) return Unbounded_String
852 SR : constant Shared_String_Access := Source.Reference;
853 DR : Shared_String_Access;
856 -- Result is empty, reuse shared empty string
859 Reference (Empty_Shared_String'Access);
860 DR := Empty_Shared_String'Access;
862 -- Length of the string is the same as requested, reuse source shared
865 elsif Count = SR.Last then
869 -- Otherwise, allocate new shared string and fill it
872 DR := Allocate (Count);
874 -- Length of the source string is more than requested, copy
875 -- corresponding slice.
877 if Count < SR.Last then
878 DR.Data (1 .. Count) := SR.Data (1 .. Count);
880 -- Length of the source string is less then requested, copy all
881 -- contents and fill others by Pad character.
884 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
886 for J in SR.Last + 1 .. Count loop
894 return (AF.Controlled with Reference => DR);
898 (Source : in out Unbounded_String;
900 Pad : Character := Space)
902 SR : constant Shared_String_Access := Source.Reference;
903 DR : Shared_String_Access;
906 -- Result is empty, reuse empty shared string
909 Reference (Empty_Shared_String'Access);
910 Source.Reference := Empty_Shared_String'Access;
913 -- Result is same as source string, reuse source shared string
915 elsif Count = SR.Last then
918 -- Try to reuse existing shared string
920 elsif Can_Be_Reused (SR, Count) then
921 if Count > SR.Last then
922 for J in SR.Last + 1 .. Count loop
929 -- Otherwise, allocate new shared string and fill it
932 DR := Allocate (Count);
934 -- Length of the source string is greater then requested, copy
935 -- corresponding slice.
937 if Count < SR.Last then
938 DR.Data (1 .. Count) := SR.Data (1 .. Count);
940 -- Length of the source string is less the requested, copy all
941 -- existing data and fill remaining positions with Pad characters.
944 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
946 for J in SR.Last + 1 .. Count loop
952 Source.Reference := DR;
962 (Source : Unbounded_String;
964 Going : Strings.Direction := Strings.Forward;
965 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
967 SR : constant Shared_String_Access := Source.Reference;
969 return Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
973 (Source : Unbounded_String;
975 Going : Direction := Forward;
976 Mapping : Maps.Character_Mapping_Function) return Natural
978 SR : constant Shared_String_Access := Source.Reference;
980 return Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
984 (Source : Unbounded_String;
985 Set : Maps.Character_Set;
986 Test : Strings.Membership := Strings.Inside;
987 Going : Strings.Direction := Strings.Forward) return Natural
989 SR : constant Shared_String_Access := Source.Reference;
991 return Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going);
995 (Source : Unbounded_String;
998 Going : Direction := Forward;
999 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
1001 SR : constant Shared_String_Access := Source.Reference;
1004 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1008 (Source : Unbounded_String;
1011 Going : Direction := Forward;
1012 Mapping : Maps.Character_Mapping_Function) return Natural
1014 SR : constant Shared_String_Access := Source.Reference;
1017 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1021 (Source : Unbounded_String;
1022 Set : Maps.Character_Set;
1024 Test : Membership := Inside;
1025 Going : Direction := Forward) return Natural
1027 SR : constant Shared_String_Access := Source.Reference;
1029 return Search.Index (SR.Data (1 .. SR.Last), Set, From, Test, Going);
1032 ---------------------
1033 -- Index_Non_Blank --
1034 ---------------------
1036 function Index_Non_Blank
1037 (Source : Unbounded_String;
1038 Going : Strings.Direction := Strings.Forward) return Natural
1040 SR : constant Shared_String_Access := Source.Reference;
1042 return Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going);
1043 end Index_Non_Blank;
1045 function Index_Non_Blank
1046 (Source : Unbounded_String;
1048 Going : Direction := Forward) return Natural
1050 SR : constant Shared_String_Access := Source.Reference;
1052 return Search.Index_Non_Blank (SR.Data (1 .. SR.Last), From, Going);
1053 end Index_Non_Blank;
1059 procedure Initialize (Object : in out Unbounded_String) is
1061 Reference (Object.Reference);
1069 (Source : Unbounded_String;
1071 New_Item : String) return Unbounded_String
1073 SR : constant Shared_String_Access := Source.Reference;
1074 DL : constant Natural := SR.Last + New_Item'Length;
1075 DR : Shared_String_Access;
1078 -- Check index first
1080 if Before > SR.Last + 1 then
1084 -- Result is empty, reuse empty shared string
1087 Reference (Empty_Shared_String'Access);
1088 DR := Empty_Shared_String'Access;
1090 -- Inserted string is empty, reuse source shared string
1092 elsif New_Item'Length = 0 then
1096 -- Otherwise, allocate new shared string and fill it
1099 DR := Allocate (DL + DL /Growth_Factor);
1100 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1101 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1102 DR.Data (Before + New_Item'Length .. DL) :=
1103 SR.Data (Before .. SR.Last);
1107 return (AF.Controlled with Reference => DR);
1111 (Source : in out Unbounded_String;
1115 SR : constant Shared_String_Access := Source.Reference;
1116 DL : constant Natural := SR.Last + New_Item'Length;
1117 DR : Shared_String_Access;
1122 if Before > SR.Last + 1 then
1126 -- Result is empty string, reuse empty shared string
1129 Reference (Empty_Shared_String'Access);
1130 Source.Reference := Empty_Shared_String'Access;
1133 -- Inserted string is empty, nothing to do
1135 elsif New_Item'Length = 0 then
1138 -- Try to reuse existing shared string first
1140 elsif Can_Be_Reused (SR, DL) then
1141 SR.Data (Before + New_Item'Length .. DL) :=
1142 SR.Data (Before .. SR.Last);
1143 SR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1146 -- Otherwise, allocate new shared string and fill it
1149 DR := Allocate (DL + DL / Growth_Factor);
1150 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1151 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1152 DR.Data (Before + New_Item'Length .. DL) :=
1153 SR.Data (Before .. SR.Last);
1155 Source.Reference := DR;
1164 function Length (Source : Unbounded_String) return Natural is
1166 return Source.Reference.Last;
1174 (Source : Unbounded_String;
1175 Position : Positive;
1176 New_Item : String) return Unbounded_String
1178 SR : constant Shared_String_Access := Source.Reference;
1180 DR : Shared_String_Access;
1185 if Position > SR.Last + 1 then
1189 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1191 -- Result is empty string, reuse empty shared string
1194 Reference (Empty_Shared_String'Access);
1195 DR := Empty_Shared_String'Access;
1197 -- Result is same as source string, reuse source shared string
1199 elsif New_Item'Length = 0 then
1203 -- Otherwise, allocate new shared string and fill it
1206 DR := Allocate (DL);
1207 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1208 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1209 DR.Data (Position + New_Item'Length .. DL) :=
1210 SR.Data (Position + New_Item'Length .. SR.Last);
1214 return (AF.Controlled with Reference => DR);
1218 (Source : in out Unbounded_String;
1219 Position : Positive;
1222 SR : constant Shared_String_Access := Source.Reference;
1224 DR : Shared_String_Access;
1229 if Position > SR.Last + 1 then
1233 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1235 -- Result is empty string, reuse empty shared string
1238 Reference (Empty_Shared_String'Access);
1239 Source.Reference := Empty_Shared_String'Access;
1242 -- String unchanged, nothing to do
1244 elsif New_Item'Length = 0 then
1247 -- Try to reuse existing shared string
1249 elsif Can_Be_Reused (SR, DL) then
1250 SR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1253 -- Otherwise allocate new shared string and fill it
1256 DR := Allocate (DL);
1257 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1258 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1259 DR.Data (Position + New_Item'Length .. DL) :=
1260 SR.Data (Position + New_Item'Length .. SR.Last);
1262 Source.Reference := DR;
1271 procedure Reference (Item : not null Shared_String_Access) is
1273 System.Atomic_Counters.Increment (Item.Counter);
1276 ---------------------
1277 -- Replace_Element --
1278 ---------------------
1280 procedure Replace_Element
1281 (Source : in out Unbounded_String;
1285 SR : constant Shared_String_Access := Source.Reference;
1286 DR : Shared_String_Access;
1291 if Index <= SR.Last then
1293 -- Try to reuse existing shared string
1295 if Can_Be_Reused (SR, SR.Last) then
1296 SR.Data (Index) := By;
1298 -- Otherwise allocate new shared string and fill it
1301 DR := Allocate (SR.Last);
1302 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
1303 DR.Data (Index) := By;
1305 Source.Reference := DR;
1312 end Replace_Element;
1318 function Replace_Slice
1319 (Source : Unbounded_String;
1322 By : String) return Unbounded_String
1324 SR : constant Shared_String_Access := Source.Reference;
1326 DR : Shared_String_Access;
1331 if Low > SR.Last + 1 then
1335 -- Do replace operation when removed slice is not empty
1338 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
1339 -- This is the number of characters remaining in the string after
1340 -- replacing the slice.
1342 -- Result is empty string, reuse empty shared string
1345 Reference (Empty_Shared_String'Access);
1346 DR := Empty_Shared_String'Access;
1348 -- Otherwise allocate new shared string and fill it
1351 DR := Allocate (DL);
1352 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1353 DR.Data (Low .. Low + By'Length - 1) := By;
1354 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1358 return (AF.Controlled with Reference => DR);
1360 -- Otherwise just insert string
1363 return Insert (Source, Low, By);
1367 procedure Replace_Slice
1368 (Source : in out Unbounded_String;
1373 SR : constant Shared_String_Access := Source.Reference;
1375 DR : Shared_String_Access;
1380 if Low > SR.Last + 1 then
1384 -- Do replace operation only when replaced slice is not empty
1387 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
1388 -- This is the number of characters remaining in the string after
1389 -- replacing the slice.
1391 -- Result is empty string, reuse empty shared string
1394 Reference (Empty_Shared_String'Access);
1395 Source.Reference := Empty_Shared_String'Access;
1398 -- Try to reuse existing shared string
1400 elsif Can_Be_Reused (SR, DL) then
1401 SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1402 SR.Data (Low .. Low + By'Length - 1) := By;
1405 -- Otherwise allocate new shared string and fill it
1408 DR := Allocate (DL);
1409 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1410 DR.Data (Low .. Low + By'Length - 1) := By;
1411 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1413 Source.Reference := DR;
1417 -- Otherwise just insert item
1420 Insert (Source, Low, By);
1424 --------------------------
1425 -- Set_Unbounded_String --
1426 --------------------------
1428 procedure Set_Unbounded_String
1429 (Target : out Unbounded_String;
1432 TR : constant Shared_String_Access := Target.Reference;
1433 DR : Shared_String_Access;
1436 -- In case of empty string, reuse empty shared string
1438 if Source'Length = 0 then
1439 Reference (Empty_Shared_String'Access);
1440 Target.Reference := Empty_Shared_String'Access;
1443 -- Try to reuse existing shared string
1445 if Can_Be_Reused (TR, Source'Length) then
1449 -- Otherwise allocate new shared string
1452 DR := Allocate (Source'Length);
1453 Target.Reference := DR;
1456 DR.Data (1 .. Source'Length) := Source;
1457 DR.Last := Source'Length;
1461 end Set_Unbounded_String;
1468 (Source : Unbounded_String;
1470 High : Natural) return String
1472 SR : constant Shared_String_Access := Source.Reference;
1475 -- Note: test of High > Length is in accordance with AI95-00128
1477 if Low > SR.Last + 1 or else High > SR.Last then
1481 return SR.Data (Low .. High);
1490 (Source : Unbounded_String;
1492 Pad : Character := Space) return Unbounded_String
1494 SR : constant Shared_String_Access := Source.Reference;
1495 DR : Shared_String_Access;
1498 -- For empty result reuse empty shared string
1501 Reference (Empty_Shared_String'Access);
1502 DR := Empty_Shared_String'Access;
1504 -- Result is whole source string, reuse source shared string
1506 elsif Count = SR.Last then
1510 -- Otherwise allocate new shared string and fill it
1513 DR := Allocate (Count);
1515 if Count < SR.Last then
1516 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1519 for J in 1 .. Count - SR.Last loop
1523 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1529 return (AF.Controlled with Reference => DR);
1533 (Source : in out Unbounded_String;
1535 Pad : Character := Space)
1537 SR : constant Shared_String_Access := Source.Reference;
1538 DR : Shared_String_Access;
1541 (SR : Shared_String_Access;
1542 DR : Shared_String_Access;
1544 -- Common code of tail computation. SR/DR can point to the same object
1551 (SR : Shared_String_Access;
1552 DR : Shared_String_Access;
1555 if Count < SR.Last then
1556 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1559 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1561 for J in 1 .. Count - SR.Last loop
1570 -- Result is empty string, reuse empty shared string
1573 Reference (Empty_Shared_String'Access);
1574 Source.Reference := Empty_Shared_String'Access;
1577 -- Length of the result is the same as length of the source string,
1578 -- reuse source shared string.
1580 elsif Count = SR.Last then
1583 -- Try to reuse existing shared string
1585 elsif Can_Be_Reused (SR, Count) then
1586 Common (SR, SR, Count);
1588 -- Otherwise allocate new shared string and fill it
1591 DR := Allocate (Count);
1592 Common (SR, DR, Count);
1593 Source.Reference := DR;
1602 function To_String (Source : Unbounded_String) return String is
1604 return Source.Reference.Data (1 .. Source.Reference.Last);
1607 -------------------------
1608 -- To_Unbounded_String --
1609 -------------------------
1611 function To_Unbounded_String (Source : String) return Unbounded_String is
1612 DR : constant Shared_String_Access := Allocate (Source'Length);
1614 DR.Data (1 .. Source'Length) := Source;
1615 DR.Last := Source'Length;
1616 return (AF.Controlled with Reference => DR);
1617 end To_Unbounded_String;
1619 function To_Unbounded_String (Length : Natural) return Unbounded_String is
1620 DR : constant Shared_String_Access := Allocate (Length);
1623 return (AF.Controlled with Reference => DR);
1624 end To_Unbounded_String;
1631 (Source : Unbounded_String;
1632 Mapping : Maps.Character_Mapping) return Unbounded_String
1634 SR : constant Shared_String_Access := Source.Reference;
1635 DR : Shared_String_Access;
1638 -- Nothing to translate, reuse empty shared string
1641 Reference (Empty_Shared_String'Access);
1642 DR := Empty_Shared_String'Access;
1644 -- Otherwise, allocate new shared string and fill it
1647 DR := Allocate (SR.Last);
1649 for J in 1 .. SR.Last loop
1650 DR.Data (J) := Value (Mapping, SR.Data (J));
1656 return (AF.Controlled with Reference => DR);
1660 (Source : in out Unbounded_String;
1661 Mapping : Maps.Character_Mapping)
1663 SR : constant Shared_String_Access := Source.Reference;
1664 DR : Shared_String_Access;
1667 -- Nothing to translate
1672 -- Try to reuse shared string
1674 elsif Can_Be_Reused (SR, SR.Last) then
1675 for J in 1 .. SR.Last loop
1676 SR.Data (J) := Value (Mapping, SR.Data (J));
1679 -- Otherwise, allocate new shared string
1682 DR := Allocate (SR.Last);
1684 for J in 1 .. SR.Last loop
1685 DR.Data (J) := Value (Mapping, SR.Data (J));
1689 Source.Reference := DR;
1695 (Source : Unbounded_String;
1696 Mapping : Maps.Character_Mapping_Function) return Unbounded_String
1698 SR : constant Shared_String_Access := Source.Reference;
1699 DR : Shared_String_Access;
1702 -- Nothing to translate, reuse empty shared string
1705 Reference (Empty_Shared_String'Access);
1706 DR := Empty_Shared_String'Access;
1708 -- Otherwise, allocate new shared string and fill it
1711 DR := Allocate (SR.Last);
1713 for J in 1 .. SR.Last loop
1714 DR.Data (J) := Mapping.all (SR.Data (J));
1720 return (AF.Controlled with Reference => DR);
1730 (Source : in out Unbounded_String;
1731 Mapping : Maps.Character_Mapping_Function)
1733 SR : constant Shared_String_Access := Source.Reference;
1734 DR : Shared_String_Access;
1737 -- Nothing to translate
1742 -- Try to reuse shared string
1744 elsif Can_Be_Reused (SR, SR.Last) then
1745 for J in 1 .. SR.Last loop
1746 SR.Data (J) := Mapping.all (SR.Data (J));
1749 -- Otherwise allocate new shared string and fill it
1752 DR := Allocate (SR.Last);
1754 for J in 1 .. SR.Last loop
1755 DR.Data (J) := Mapping.all (SR.Data (J));
1759 Source.Reference := DR;
1777 (Source : Unbounded_String;
1778 Side : Trim_End) return Unbounded_String
1780 SR : constant Shared_String_Access := Source.Reference;
1782 DR : Shared_String_Access;
1787 Low := Index_Non_Blank (Source, Forward);
1789 -- All blanks, reuse empty shared string
1792 Reference (Empty_Shared_String'Access);
1793 DR := Empty_Shared_String'Access;
1799 DL := SR.Last - Low + 1;
1803 High := Index_Non_Blank (Source, Backward);
1807 High := Index_Non_Blank (Source, Backward);
1808 DL := High - Low + 1;
1811 -- Length of the result is the same as length of the source string,
1812 -- reuse source shared string.
1814 if DL = SR.Last then
1818 -- Otherwise, allocate new shared string
1821 DR := Allocate (DL);
1822 DR.Data (1 .. DL) := SR.Data (Low .. High);
1827 return (AF.Controlled with Reference => DR);
1831 (Source : in out Unbounded_String;
1834 SR : constant Shared_String_Access := Source.Reference;
1836 DR : Shared_String_Access;
1841 Low := Index_Non_Blank (Source, Forward);
1843 -- All blanks, reuse empty shared string
1846 Reference (Empty_Shared_String'Access);
1847 Source.Reference := Empty_Shared_String'Access;
1854 DL := SR.Last - Low + 1;
1858 High := Index_Non_Blank (Source, Backward);
1862 High := Index_Non_Blank (Source, Backward);
1863 DL := High - Low + 1;
1866 -- Length of the result is the same as length of the source string,
1869 if DL = SR.Last then
1872 -- Try to reuse existing shared string
1874 elsif Can_Be_Reused (SR, DL) then
1875 SR.Data (1 .. DL) := SR.Data (Low .. High);
1878 -- Otherwise, allocate new shared string
1881 DR := Allocate (DL);
1882 DR.Data (1 .. DL) := SR.Data (Low .. High);
1884 Source.Reference := DR;
1891 (Source : Unbounded_String;
1892 Left : Maps.Character_Set;
1893 Right : Maps.Character_Set) return Unbounded_String
1895 SR : constant Shared_String_Access := Source.Reference;
1897 DR : Shared_String_Access;
1902 Low := Index (Source, Left, Outside, Forward);
1904 -- Source includes only characters from Left set, reuse empty shared
1908 Reference (Empty_Shared_String'Access);
1909 DR := Empty_Shared_String'Access;
1912 High := Index (Source, Right, Outside, Backward);
1913 DL := Integer'Max (0, High - Low + 1);
1915 -- Source includes only characters from Right set or result string
1916 -- is empty, reuse empty shared string.
1918 if High = 0 or else DL = 0 then
1919 Reference (Empty_Shared_String'Access);
1920 DR := Empty_Shared_String'Access;
1922 -- Otherwise, allocate new shared string and fill it
1925 DR := Allocate (DL);
1926 DR.Data (1 .. DL) := SR.Data (Low .. High);
1931 return (AF.Controlled with Reference => DR);
1935 (Source : in out Unbounded_String;
1936 Left : Maps.Character_Set;
1937 Right : Maps.Character_Set)
1939 SR : constant Shared_String_Access := Source.Reference;
1941 DR : Shared_String_Access;
1946 Low := Index (Source, Left, Outside, Forward);
1948 -- Source includes only characters from Left set, reuse empty shared
1952 Reference (Empty_Shared_String'Access);
1953 Source.Reference := Empty_Shared_String'Access;
1957 High := Index (Source, Right, Outside, Backward);
1958 DL := Integer'Max (0, High - Low + 1);
1960 -- Source includes only characters from Right set or result string
1961 -- is empty, reuse empty shared string.
1963 if High = 0 or else DL = 0 then
1964 Reference (Empty_Shared_String'Access);
1965 Source.Reference := Empty_Shared_String'Access;
1968 -- Try to reuse existing shared string
1970 elsif Can_Be_Reused (SR, DL) then
1971 SR.Data (1 .. DL) := SR.Data (Low .. High);
1974 -- Otherwise, allocate new shared string and fill it
1977 DR := Allocate (DL);
1978 DR.Data (1 .. DL) := SR.Data (Low .. High);
1980 Source.Reference := DR;
1986 ---------------------
1987 -- Unbounded_Slice --
1988 ---------------------
1990 function Unbounded_Slice
1991 (Source : Unbounded_String;
1993 High : Natural) return Unbounded_String
1995 SR : constant Shared_String_Access := Source.Reference;
1997 DR : Shared_String_Access;
2002 if Low > SR.Last + 1 or else High > SR.Last then
2005 -- Result is empty slice, reuse empty shared string
2007 elsif Low > High then
2008 Reference (Empty_Shared_String'Access);
2009 DR := Empty_Shared_String'Access;
2011 -- Otherwise, allocate new shared string and fill it
2014 DL := High - Low + 1;
2015 DR := Allocate (DL);
2016 DR.Data (1 .. DL) := SR.Data (Low .. High);
2020 return (AF.Controlled with Reference => DR);
2021 end Unbounded_Slice;
2023 procedure Unbounded_Slice
2024 (Source : Unbounded_String;
2025 Target : out Unbounded_String;
2029 SR : constant Shared_String_Access := Source.Reference;
2030 TR : constant Shared_String_Access := Target.Reference;
2032 DR : Shared_String_Access;
2037 if Low > SR.Last + 1 or else High > SR.Last then
2040 -- Result is empty slice, reuse empty shared string
2042 elsif Low > High then
2043 Reference (Empty_Shared_String'Access);
2044 Target.Reference := Empty_Shared_String'Access;
2048 DL := High - Low + 1;
2050 -- Try to reuse existing shared string
2052 if Can_Be_Reused (TR, DL) then
2053 TR.Data (1 .. DL) := SR.Data (Low .. High);
2056 -- Otherwise, allocate new shared string and fill it
2059 DR := Allocate (DL);
2060 DR.Data (1 .. DL) := SR.Data (Low .. High);
2062 Target.Reference := DR;
2066 end Unbounded_Slice;
2072 procedure Unreference (Item : not null Shared_String_Access) is
2075 new Ada.Unchecked_Deallocation (Shared_String, Shared_String_Access);
2077 Aux : Shared_String_Access := Item;
2080 if System.Atomic_Counters.Decrement (Aux.Counter) then
2082 -- Reference counter of Empty_Shared_String must never reach zero
2084 pragma Assert (Aux /= Empty_Shared_String'Access);
2090 end Ada.Strings.Unbounded;