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-2010, 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 procedure Sync_Add_And_Fetch
54 (Ptr : access Interfaces.Unsigned_32;
55 Value : Interfaces.Unsigned_32);
56 pragma Import (Intrinsic, Sync_Add_And_Fetch, "__sync_add_and_fetch_4");
58 function Sync_Sub_And_Fetch
59 (Ptr : access Interfaces.Unsigned_32;
60 Value : Interfaces.Unsigned_32) return Interfaces.Unsigned_32;
61 pragma Import (Intrinsic, Sync_Sub_And_Fetch, "__sync_sub_and_fetch_4");
63 function Aligned_Max_Length (Max_Length : Natural) return Natural;
64 -- Returns recommended length of the shared string which is greater or
65 -- equal to specified length. Calculation take in sense alignment of the
66 -- allocated memory segments to use memory effectively by Append/Insert/etc
74 (Left : Unbounded_String;
75 Right : Unbounded_String) return Unbounded_String
77 LR : constant Shared_String_Access := Left.Reference;
78 RR : constant Shared_String_Access := Right.Reference;
79 DL : constant Natural := LR.Last + RR.Last;
80 DR : Shared_String_Access;
83 -- Result is an empty string, reuse shared empty string
86 Reference (Empty_Shared_String'Access);
87 DR := Empty_Shared_String'Access;
89 -- Left string is empty, return Rigth string
91 elsif LR.Last = 0 then
95 -- Right string is empty, return Left string
97 elsif RR.Last = 0 then
101 -- Overwise, allocate new shared string and fill data
104 DR := Allocate (LR.Last + RR.Last);
105 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
106 DR.Data (LR.Last + 1 .. DL) := RR.Data (1 .. RR.Last);
110 return (AF.Controlled with Reference => DR);
114 (Left : Unbounded_String;
115 Right : String) return Unbounded_String
117 LR : constant Shared_String_Access := Left.Reference;
118 DL : constant Natural := LR.Last + Right'Length;
119 DR : Shared_String_Access;
122 -- Result is an empty string, reuse shared empty string
125 Reference (Empty_Shared_String'Access);
126 DR := Empty_Shared_String'Access;
128 -- Right is an empty string, return Left string
130 elsif Right'Length = 0 then
134 -- Otherwise, allocate new shared string and fill it
138 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
139 DR.Data (LR.Last + 1 .. DL) := Right;
143 return (AF.Controlled with Reference => DR);
148 Right : Unbounded_String) return Unbounded_String
150 RR : constant Shared_String_Access := Right.Reference;
151 DL : constant Natural := Left'Length + RR.Last;
152 DR : Shared_String_Access;
155 -- Result is an empty string, reuse shared one
158 Reference (Empty_Shared_String'Access);
159 DR := Empty_Shared_String'Access;
161 -- Left is empty string, return Right string
163 elsif Left'Length = 0 then
167 -- Otherwise, allocate new shared string and fill it
171 DR.Data (1 .. Left'Length) := Left;
172 DR.Data (Left'Length + 1 .. DL) := RR.Data (1 .. RR.Last);
176 return (AF.Controlled with Reference => DR);
180 (Left : Unbounded_String;
181 Right : Character) return Unbounded_String
183 LR : constant Shared_String_Access := Left.Reference;
184 DL : constant Natural := LR.Last + 1;
185 DR : Shared_String_Access;
189 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
190 DR.Data (DL) := Right;
193 return (AF.Controlled with Reference => DR);
198 Right : Unbounded_String) return Unbounded_String
200 RR : constant Shared_String_Access := Right.Reference;
201 DL : constant Natural := 1 + RR.Last;
202 DR : Shared_String_Access;
207 DR.Data (2 .. DL) := RR.Data (1 .. RR.Last);
210 return (AF.Controlled with Reference => DR);
219 Right : Character) return Unbounded_String
221 DR : Shared_String_Access;
224 -- Result is an empty string, reuse shared empty string
227 Reference (Empty_Shared_String'Access);
228 DR := Empty_Shared_String'Access;
230 -- Otherwise, allocate new shared string and fill it
233 DR := Allocate (Left);
235 for J in 1 .. Left loop
236 DR.Data (J) := Right;
242 return (AF.Controlled with Reference => DR);
247 Right : String) return Unbounded_String
249 DL : constant Natural := Left * Right'Length;
250 DR : Shared_String_Access;
254 -- Result is an empty string, reuse shared empty string
257 Reference (Empty_Shared_String'Access);
258 DR := Empty_Shared_String'Access;
260 -- Otherwise, allocate new shared string and fill it
266 for J in 1 .. Left loop
267 DR.Data (K .. K + Right'Length - 1) := Right;
268 K := K + Right'Length;
274 return (AF.Controlled with Reference => DR);
279 Right : Unbounded_String) return Unbounded_String
281 RR : constant Shared_String_Access := Right.Reference;
282 DL : constant Natural := Left * RR.Last;
283 DR : Shared_String_Access;
287 -- Result is an empty string, reuse shared empty string
290 Reference (Empty_Shared_String'Access);
291 DR := Empty_Shared_String'Access;
293 -- Coefficient is one, just return string itself
299 -- Otherwise, allocate new shared string and fill it
305 for J in 1 .. Left loop
306 DR.Data (K .. K + RR.Last - 1) := RR.Data (1 .. RR.Last);
313 return (AF.Controlled with Reference => DR);
321 (Left : Unbounded_String;
322 Right : Unbounded_String) return Boolean
324 LR : constant Shared_String_Access := Left.Reference;
325 RR : constant Shared_String_Access := Right.Reference;
327 return LR.Data (1 .. LR.Last) < RR.Data (1 .. RR.Last);
331 (Left : Unbounded_String;
332 Right : String) return Boolean
334 LR : constant Shared_String_Access := Left.Reference;
336 return LR.Data (1 .. LR.Last) < Right;
341 Right : Unbounded_String) return Boolean
343 RR : constant Shared_String_Access := Right.Reference;
345 return Left < RR.Data (1 .. RR.Last);
353 (Left : Unbounded_String;
354 Right : Unbounded_String) return Boolean
356 LR : constant Shared_String_Access := Left.Reference;
357 RR : constant Shared_String_Access := Right.Reference;
360 -- LR = RR means two strings shares shared string, thus they are equal
362 return LR = RR or else LR.Data (1 .. LR.Last) <= RR.Data (1 .. RR.Last);
366 (Left : Unbounded_String;
367 Right : String) return Boolean
369 LR : constant Shared_String_Access := Left.Reference;
371 return LR.Data (1 .. LR.Last) <= Right;
376 Right : Unbounded_String) return Boolean
378 RR : constant Shared_String_Access := Right.Reference;
380 return Left <= RR.Data (1 .. RR.Last);
388 (Left : Unbounded_String;
389 Right : Unbounded_String) return Boolean
391 LR : constant Shared_String_Access := Left.Reference;
392 RR : constant Shared_String_Access := Right.Reference;
395 return LR = RR or else LR.Data (1 .. LR.Last) = RR.Data (1 .. RR.Last);
396 -- LR = RR means two strings shares shared string, thus they are equal
400 (Left : Unbounded_String;
401 Right : String) return Boolean
403 LR : constant Shared_String_Access := Left.Reference;
405 return LR.Data (1 .. LR.Last) = Right;
410 Right : Unbounded_String) return Boolean
412 RR : constant Shared_String_Access := Right.Reference;
414 return Left = RR.Data (1 .. RR.Last);
422 (Left : Unbounded_String;
423 Right : Unbounded_String) return Boolean
425 LR : constant Shared_String_Access := Left.Reference;
426 RR : constant Shared_String_Access := Right.Reference;
428 return LR.Data (1 .. LR.Last) > RR.Data (1 .. RR.Last);
432 (Left : Unbounded_String;
433 Right : String) return Boolean
435 LR : constant Shared_String_Access := Left.Reference;
437 return LR.Data (1 .. LR.Last) > Right;
442 Right : Unbounded_String) return Boolean
444 RR : constant Shared_String_Access := Right.Reference;
446 return Left > RR.Data (1 .. RR.Last);
454 (Left : Unbounded_String;
455 Right : Unbounded_String) return Boolean
457 LR : constant Shared_String_Access := Left.Reference;
458 RR : constant Shared_String_Access := Right.Reference;
461 -- LR = RR means two strings shares shared string, thus they are equal
463 return LR = RR or else LR.Data (1 .. LR.Last) >= RR.Data (1 .. RR.Last);
467 (Left : Unbounded_String;
468 Right : String) return Boolean
470 LR : constant Shared_String_Access := Left.Reference;
472 return LR.Data (1 .. LR.Last) >= Right;
477 Right : Unbounded_String) return Boolean
479 RR : constant Shared_String_Access := Right.Reference;
481 return Left >= RR.Data (1 .. RR.Last);
488 procedure Adjust (Object : in out Unbounded_String) is
490 Reference (Object.Reference);
493 ------------------------
494 -- Aligned_Max_Length --
495 ------------------------
497 function Aligned_Max_Length (Max_Length : Natural) return Natural is
498 Static_Size : constant Natural :=
499 Empty_Shared_String'Size / Standard'Storage_Unit;
500 -- Total size of all static components
504 ((Static_Size + Max_Length - 1) / Min_Mul_Alloc + 2) * Min_Mul_Alloc
506 end Aligned_Max_Length;
512 function Allocate (Max_Length : Natural) return Shared_String_Access is
514 -- Empty string requested, return shared empty string
516 if Max_Length = 0 then
517 Reference (Empty_Shared_String'Access);
518 return Empty_Shared_String'Access;
520 -- Otherwise, allocate requested space (and probably some more room)
523 return new Shared_String (Aligned_Max_Length (Max_Length));
532 (Source : in out Unbounded_String;
533 New_Item : Unbounded_String)
535 SR : constant Shared_String_Access := Source.Reference;
536 NR : constant Shared_String_Access := New_Item.Reference;
537 DL : constant Natural := SR.Last + NR.Last;
538 DR : Shared_String_Access;
541 -- Source is an empty string, reuse New_Item data
545 Source.Reference := NR;
548 -- New_Item is empty string, nothing to do
550 elsif NR.Last = 0 then
553 -- Try to reuse existing shared string
555 elsif Can_Be_Reused (SR, DL) then
556 SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
559 -- Otherwise, allocate new one and fill it
562 DR := Allocate (DL + DL / Growth_Factor);
563 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
564 DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
566 Source.Reference := DR;
572 (Source : in out Unbounded_String;
575 SR : constant Shared_String_Access := Source.Reference;
576 DL : constant Natural := SR.Last + New_Item'Length;
577 DR : Shared_String_Access;
580 -- New_Item is an empty string, nothing to do
582 if New_Item'Length = 0 then
585 -- Try to reuse existing shared string
587 elsif Can_Be_Reused (SR, DL) then
588 SR.Data (SR.Last + 1 .. DL) := New_Item;
591 -- Otherwise, allocate new one and fill it
594 DR := Allocate (DL + DL / Growth_Factor);
595 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
596 DR.Data (SR.Last + 1 .. DL) := New_Item;
598 Source.Reference := DR;
604 (Source : in out Unbounded_String;
605 New_Item : Character)
607 SR : constant Shared_String_Access := Source.Reference;
608 DL : constant Natural := SR.Last + 1;
609 DR : Shared_String_Access;
612 -- Try to reuse existing shared string
614 if Can_Be_Reused (SR, SR.Last + 1) then
615 SR.Data (SR.Last + 1) := New_Item;
616 SR.Last := SR.Last + 1;
618 -- Otherwise, allocate new one and fill it
621 DR := Allocate (DL + DL / Growth_Factor);
622 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
623 DR.Data (DL) := New_Item;
625 Source.Reference := DR;
634 function Can_Be_Reused
635 (Item : Shared_String_Access;
636 Length : Natural) return Boolean
642 and then Item.Max_Length >= Length
643 and then Item.Max_Length <=
644 Aligned_Max_Length (Length + Length / Growth_Factor);
652 (Source : Unbounded_String;
654 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
656 SR : constant Shared_String_Access := Source.Reference;
658 return Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
662 (Source : Unbounded_String;
664 Mapping : Maps.Character_Mapping_Function) return Natural
666 SR : constant Shared_String_Access := Source.Reference;
668 return Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
672 (Source : Unbounded_String;
673 Set : Maps.Character_Set) return Natural
675 SR : constant Shared_String_Access := Source.Reference;
677 return Search.Count (SR.Data (1 .. SR.Last), Set);
685 (Source : Unbounded_String;
687 Through : Natural) return Unbounded_String
689 SR : constant Shared_String_Access := Source.Reference;
691 DR : Shared_String_Access;
694 -- Empty slice is deleted, use the same shared string
696 if From > Through then
700 -- Index is out of range
702 elsif Through > SR.Last then
705 -- Compute size of the result
708 DL := SR.Last - (Through - From + 1);
710 -- Result is an empty string, reuse shared empty string
713 Reference (Empty_Shared_String'Access);
714 DR := Empty_Shared_String'Access;
716 -- Otherwise, allocate new shared string and fill it
720 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
721 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
726 return (AF.Controlled with Reference => DR);
730 (Source : in out Unbounded_String;
734 SR : constant Shared_String_Access := Source.Reference;
736 DR : Shared_String_Access;
739 -- Nothing changed, return
741 if From > Through then
744 -- Through is outside of the range
746 elsif Through > SR.Last then
750 DL := SR.Last - (Through - From + 1);
752 -- Result is empty, reuse shared empty string
755 Reference (Empty_Shared_String'Access);
756 Source.Reference := Empty_Shared_String'Access;
759 -- Try to reuse existing shared string
761 elsif Can_Be_Reused (SR, DL) then
762 SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
765 -- Otherwise, allocate new shared string
769 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
770 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
772 Source.Reference := DR;
783 (Source : Unbounded_String;
784 Index : Positive) return Character
786 SR : constant Shared_String_Access := Source.Reference;
788 if Index <= SR.Last then
789 return SR.Data (Index);
799 procedure Finalize (Object : in out Unbounded_String) is
800 SR : constant Shared_String_Access := Object.Reference;
805 -- The same controlled object can be finalized several times for
806 -- some reason. As per 7.6.1(24) this should have no ill effect,
807 -- so we need to add a guard for the case of finalizing the same
810 Object.Reference := null;
820 (Source : Unbounded_String;
821 Set : Maps.Character_Set;
822 Test : Strings.Membership;
823 First : out Positive;
826 SR : constant Shared_String_Access := Source.Reference;
828 Search.Find_Token (SR.Data (1 .. SR.Last), Set, Test, First, Last);
835 procedure Free (X : in out String_Access) is
836 procedure Deallocate is
837 new Ada.Unchecked_Deallocation (String, String_Access);
847 (Source : Unbounded_String;
849 Pad : Character := Space) return Unbounded_String
851 SR : constant Shared_String_Access := Source.Reference;
852 DR : Shared_String_Access;
855 -- Result is empty, reuse shared empty string
858 Reference (Empty_Shared_String'Access);
859 DR := Empty_Shared_String'Access;
861 -- Length of the string is the same as requested, reuse source shared
864 elsif Count = SR.Last then
868 -- Otherwise, allocate new shared string and fill it
871 DR := Allocate (Count);
873 -- Length of the source string is more than requested, copy
874 -- corresponding slice.
876 if Count < SR.Last then
877 DR.Data (1 .. Count) := SR.Data (1 .. Count);
879 -- Length of the source string is less then requested, copy all
880 -- contents and fill others by Pad character.
883 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
885 for J in SR.Last + 1 .. Count loop
893 return (AF.Controlled with Reference => DR);
897 (Source : in out Unbounded_String;
899 Pad : Character := Space)
901 SR : constant Shared_String_Access := Source.Reference;
902 DR : Shared_String_Access;
905 -- Result is empty, reuse empty shared string
908 Reference (Empty_Shared_String'Access);
909 Source.Reference := Empty_Shared_String'Access;
912 -- Result is same as source string, reuse source shared string
914 elsif Count = SR.Last then
917 -- Try to reuse existing shared string
919 elsif Can_Be_Reused (SR, Count) then
920 if Count > SR.Last then
921 for J in SR.Last + 1 .. Count loop
928 -- Otherwise, allocate new shared string and fill it
931 DR := Allocate (Count);
933 -- Length of the source string is greater then requested, copy
934 -- corresponding slice.
936 if Count < SR.Last then
937 DR.Data (1 .. Count) := SR.Data (1 .. Count);
939 -- Length of the source string is less the requested, copy all
940 -- existing data and fill remaining positions with Pad characters.
943 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
945 for J in SR.Last + 1 .. Count loop
951 Source.Reference := DR;
961 (Source : Unbounded_String;
963 Going : Strings.Direction := Strings.Forward;
964 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
966 SR : constant Shared_String_Access := Source.Reference;
968 return Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
972 (Source : Unbounded_String;
974 Going : Direction := Forward;
975 Mapping : Maps.Character_Mapping_Function) return Natural
977 SR : constant Shared_String_Access := Source.Reference;
979 return Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
983 (Source : Unbounded_String;
984 Set : Maps.Character_Set;
985 Test : Strings.Membership := Strings.Inside;
986 Going : Strings.Direction := Strings.Forward) return Natural
988 SR : constant Shared_String_Access := Source.Reference;
990 return Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going);
994 (Source : Unbounded_String;
997 Going : Direction := Forward;
998 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
1000 SR : constant Shared_String_Access := Source.Reference;
1003 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1007 (Source : Unbounded_String;
1010 Going : Direction := Forward;
1011 Mapping : Maps.Character_Mapping_Function) return Natural
1013 SR : constant Shared_String_Access := Source.Reference;
1016 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1020 (Source : Unbounded_String;
1021 Set : Maps.Character_Set;
1023 Test : Membership := Inside;
1024 Going : Direction := Forward) return Natural
1026 SR : constant Shared_String_Access := Source.Reference;
1028 return Search.Index (SR.Data (1 .. SR.Last), Set, From, Test, Going);
1031 ---------------------
1032 -- Index_Non_Blank --
1033 ---------------------
1035 function Index_Non_Blank
1036 (Source : Unbounded_String;
1037 Going : Strings.Direction := Strings.Forward) return Natural
1039 SR : constant Shared_String_Access := Source.Reference;
1041 return Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going);
1042 end Index_Non_Blank;
1044 function Index_Non_Blank
1045 (Source : Unbounded_String;
1047 Going : Direction := Forward) return Natural
1049 SR : constant Shared_String_Access := Source.Reference;
1051 return Search.Index_Non_Blank (SR.Data (1 .. SR.Last), From, Going);
1052 end Index_Non_Blank;
1058 procedure Initialize (Object : in out Unbounded_String) is
1060 Reference (Object.Reference);
1068 (Source : Unbounded_String;
1070 New_Item : String) return Unbounded_String
1072 SR : constant Shared_String_Access := Source.Reference;
1073 DL : constant Natural := SR.Last + New_Item'Length;
1074 DR : Shared_String_Access;
1077 -- Check index first
1079 if Before > SR.Last + 1 then
1083 -- Result is empty, reuse empty shared string
1086 Reference (Empty_Shared_String'Access);
1087 DR := Empty_Shared_String'Access;
1089 -- Inserted string is empty, reuse source shared string
1091 elsif New_Item'Length = 0 then
1095 -- Otherwise, allocate new shared string and fill it
1098 DR := Allocate (DL + DL /Growth_Factor);
1099 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1100 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1101 DR.Data (Before + New_Item'Length .. DL) :=
1102 SR.Data (Before .. SR.Last);
1106 return (AF.Controlled with Reference => DR);
1110 (Source : in out Unbounded_String;
1114 SR : constant Shared_String_Access := Source.Reference;
1115 DL : constant Natural := SR.Last + New_Item'Length;
1116 DR : Shared_String_Access;
1121 if Before > SR.Last + 1 then
1125 -- Result is empty string, reuse empty shared string
1128 Reference (Empty_Shared_String'Access);
1129 Source.Reference := Empty_Shared_String'Access;
1132 -- Inserted string is empty, nothing to do
1134 elsif New_Item'Length = 0 then
1137 -- Try to reuse existing shared string first
1139 elsif Can_Be_Reused (SR, DL) then
1140 SR.Data (Before + New_Item'Length .. DL) :=
1141 SR.Data (Before .. SR.Last);
1142 SR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1145 -- Otherwise, allocate new shared string and fill it
1148 DR := Allocate (DL + DL / Growth_Factor);
1149 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1150 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1151 DR.Data (Before + New_Item'Length .. DL) :=
1152 SR.Data (Before .. SR.Last);
1154 Source.Reference := DR;
1163 function Length (Source : Unbounded_String) return Natural is
1165 return Source.Reference.Last;
1173 (Source : Unbounded_String;
1174 Position : Positive;
1175 New_Item : String) return Unbounded_String
1177 SR : constant Shared_String_Access := Source.Reference;
1179 DR : Shared_String_Access;
1184 if Position > SR.Last + 1 then
1188 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1190 -- Result is empty string, reuse empty shared string
1193 Reference (Empty_Shared_String'Access);
1194 DR := Empty_Shared_String'Access;
1196 -- Result is same as source string, reuse source shared string
1198 elsif New_Item'Length = 0 then
1202 -- Otherwise, allocate new shared string and fill it
1205 DR := Allocate (DL);
1206 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1207 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1208 DR.Data (Position + New_Item'Length .. DL) :=
1209 SR.Data (Position + New_Item'Length .. SR.Last);
1213 return (AF.Controlled with Reference => DR);
1217 (Source : in out Unbounded_String;
1218 Position : Positive;
1221 SR : constant Shared_String_Access := Source.Reference;
1223 DR : Shared_String_Access;
1228 if Position > SR.Last + 1 then
1232 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1234 -- Result is empty string, reuse empty shared string
1237 Reference (Empty_Shared_String'Access);
1238 Source.Reference := Empty_Shared_String'Access;
1241 -- String unchanged, nothing to do
1243 elsif New_Item'Length = 0 then
1246 -- Try to reuse existing shared string
1248 elsif Can_Be_Reused (SR, DL) then
1249 SR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1252 -- Otherwise allocate new shared string and fill it
1255 DR := Allocate (DL);
1256 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1257 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1258 DR.Data (Position + New_Item'Length .. DL) :=
1259 SR.Data (Position + New_Item'Length .. SR.Last);
1261 Source.Reference := DR;
1270 procedure Reference (Item : not null Shared_String_Access) is
1272 Sync_Add_And_Fetch (Item.Counter'Access, 1);
1275 ---------------------
1276 -- Replace_Element --
1277 ---------------------
1279 procedure Replace_Element
1280 (Source : in out Unbounded_String;
1284 SR : constant Shared_String_Access := Source.Reference;
1285 DR : Shared_String_Access;
1290 if Index <= SR.Last then
1292 -- Try to reuse existing shared string
1294 if Can_Be_Reused (SR, SR.Last) then
1295 SR.Data (Index) := By;
1297 -- Otherwise allocate new shared string and fill it
1300 DR := Allocate (SR.Last);
1301 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
1302 DR.Data (Index) := By;
1304 Source.Reference := DR;
1311 end Replace_Element;
1317 function Replace_Slice
1318 (Source : Unbounded_String;
1321 By : String) return Unbounded_String
1323 SR : constant Shared_String_Access := Source.Reference;
1325 DR : Shared_String_Access;
1330 if Low > SR.Last + 1 then
1334 -- Do replace operation when removed slice is not empty
1337 DL := By'Length + SR.Last + Low - High - 1;
1339 -- Result is empty string, reuse empty shared string
1342 Reference (Empty_Shared_String'Access);
1343 DR := Empty_Shared_String'Access;
1345 -- Otherwise allocate new shared string and fill it
1348 DR := Allocate (DL);
1349 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1350 DR.Data (Low .. Low + By'Length - 1) := By;
1351 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1355 return (AF.Controlled with Reference => DR);
1357 -- Otherwise just insert string
1360 return Insert (Source, Low, By);
1364 procedure Replace_Slice
1365 (Source : in out Unbounded_String;
1370 SR : constant Shared_String_Access := Source.Reference;
1372 DR : Shared_String_Access;
1377 if Low > SR.Last + 1 then
1381 -- Do replace operation only when replaced slice is not empty
1384 DL := By'Length + SR.Last + Low - High - 1;
1386 -- Result is empty string, reuse empty shared string
1389 Reference (Empty_Shared_String'Access);
1390 Source.Reference := Empty_Shared_String'Access;
1393 -- Try to reuse existing shared string
1395 elsif Can_Be_Reused (SR, DL) then
1396 SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1397 SR.Data (Low .. Low + By'Length - 1) := By;
1400 -- Otherwise allocate new shared string and fill it
1403 DR := Allocate (DL);
1404 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1405 DR.Data (Low .. Low + By'Length - 1) := By;
1406 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1408 Source.Reference := DR;
1412 -- Otherwise just insert item
1415 Insert (Source, Low, By);
1419 --------------------------
1420 -- Set_Unbounded_String --
1421 --------------------------
1423 procedure Set_Unbounded_String
1424 (Target : out Unbounded_String;
1427 TR : constant Shared_String_Access := Target.Reference;
1428 DR : Shared_String_Access;
1431 -- In case of empty string, reuse empty shared string
1433 if Source'Length = 0 then
1434 Reference (Empty_Shared_String'Access);
1435 Target.Reference := Empty_Shared_String'Access;
1438 -- Try to reuse existing shared string
1440 if Can_Be_Reused (TR, Source'Length) then
1444 -- Otherwise allocate new shared string
1447 DR := Allocate (Source'Length);
1448 Target.Reference := DR;
1451 DR.Data (1 .. Source'Length) := Source;
1452 DR.Last := Source'Length;
1456 end Set_Unbounded_String;
1463 (Source : Unbounded_String;
1465 High : Natural) return String
1467 SR : constant Shared_String_Access := Source.Reference;
1470 -- Note: test of High > Length is in accordance with AI95-00128
1472 if Low > SR.Last + 1 or else High > SR.Last then
1476 return SR.Data (Low .. High);
1485 (Source : Unbounded_String;
1487 Pad : Character := Space) return Unbounded_String
1489 SR : constant Shared_String_Access := Source.Reference;
1490 DR : Shared_String_Access;
1493 -- For empty result reuse empty shared string
1496 Reference (Empty_Shared_String'Access);
1497 DR := Empty_Shared_String'Access;
1499 -- Result is whole source string, reuse source shared string
1501 elsif Count = SR.Last then
1505 -- Otherwise allocate new shared string and fill it
1508 DR := Allocate (Count);
1510 if Count < SR.Last then
1511 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1514 for J in 1 .. Count - SR.Last loop
1518 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1524 return (AF.Controlled with Reference => DR);
1528 (Source : in out Unbounded_String;
1530 Pad : Character := Space)
1532 SR : constant Shared_String_Access := Source.Reference;
1533 DR : Shared_String_Access;
1536 (SR : Shared_String_Access;
1537 DR : Shared_String_Access;
1539 -- Common code of tail computation. SR/DR can point to the same object
1546 (SR : Shared_String_Access;
1547 DR : Shared_String_Access;
1550 if Count < SR.Last then
1551 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1554 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1556 for J in 1 .. Count - SR.Last loop
1565 -- Result is empty string, reuse empty shared string
1568 Reference (Empty_Shared_String'Access);
1569 Source.Reference := Empty_Shared_String'Access;
1572 -- Length of the result is the same as length of the source string,
1573 -- reuse source shared string.
1575 elsif Count = SR.Last then
1578 -- Try to reuse existing shared string
1580 elsif Can_Be_Reused (SR, Count) then
1581 Common (SR, SR, Count);
1583 -- Otherwise allocate new shared string and fill it
1586 DR := Allocate (Count);
1587 Common (SR, DR, Count);
1588 Source.Reference := DR;
1597 function To_String (Source : Unbounded_String) return String is
1599 return Source.Reference.Data (1 .. Source.Reference.Last);
1602 -------------------------
1603 -- To_Unbounded_String --
1604 -------------------------
1606 function To_Unbounded_String (Source : String) return Unbounded_String is
1607 DR : constant Shared_String_Access := Allocate (Source'Length);
1609 DR.Data (1 .. Source'Length) := Source;
1610 DR.Last := Source'Length;
1611 return (AF.Controlled with Reference => DR);
1612 end To_Unbounded_String;
1614 function To_Unbounded_String (Length : Natural) return Unbounded_String is
1615 DR : constant Shared_String_Access := Allocate (Length);
1618 return (AF.Controlled with Reference => DR);
1619 end To_Unbounded_String;
1626 (Source : Unbounded_String;
1627 Mapping : Maps.Character_Mapping) return Unbounded_String
1629 SR : constant Shared_String_Access := Source.Reference;
1630 DR : Shared_String_Access;
1633 -- Nothing to translate, reuse empty shared string
1636 Reference (Empty_Shared_String'Access);
1637 DR := Empty_Shared_String'Access;
1639 -- Otherwise, allocate new shared string and fill it
1642 DR := Allocate (SR.Last);
1644 for J in 1 .. SR.Last loop
1645 DR.Data (J) := Value (Mapping, SR.Data (J));
1651 return (AF.Controlled with Reference => DR);
1655 (Source : in out Unbounded_String;
1656 Mapping : Maps.Character_Mapping)
1658 SR : constant Shared_String_Access := Source.Reference;
1659 DR : Shared_String_Access;
1662 -- Nothing to translate
1667 -- Try to reuse shared string
1669 elsif Can_Be_Reused (SR, SR.Last) then
1670 for J in 1 .. SR.Last loop
1671 SR.Data (J) := Value (Mapping, SR.Data (J));
1674 -- Otherwise, allocate new shared string
1677 DR := Allocate (SR.Last);
1679 for J in 1 .. SR.Last loop
1680 DR.Data (J) := Value (Mapping, SR.Data (J));
1684 Source.Reference := DR;
1690 (Source : Unbounded_String;
1691 Mapping : Maps.Character_Mapping_Function) return Unbounded_String
1693 SR : constant Shared_String_Access := Source.Reference;
1694 DR : Shared_String_Access;
1697 -- Nothing to translate, reuse empty shared string
1700 Reference (Empty_Shared_String'Access);
1701 DR := Empty_Shared_String'Access;
1703 -- Otherwise, allocate new shared string and fill it
1706 DR := Allocate (SR.Last);
1708 for J in 1 .. SR.Last loop
1709 DR.Data (J) := Mapping.all (SR.Data (J));
1715 return (AF.Controlled with Reference => DR);
1725 (Source : in out Unbounded_String;
1726 Mapping : Maps.Character_Mapping_Function)
1728 SR : constant Shared_String_Access := Source.Reference;
1729 DR : Shared_String_Access;
1732 -- Nothing to translate
1737 -- Try to reuse shared string
1739 elsif Can_Be_Reused (SR, SR.Last) then
1740 for J in 1 .. SR.Last loop
1741 SR.Data (J) := Mapping.all (SR.Data (J));
1744 -- Otherwise allocate new shared string and fill it
1747 DR := Allocate (SR.Last);
1749 for J in 1 .. SR.Last loop
1750 DR.Data (J) := Mapping.all (SR.Data (J));
1754 Source.Reference := DR;
1772 (Source : Unbounded_String;
1773 Side : Trim_End) return Unbounded_String
1775 SR : constant Shared_String_Access := Source.Reference;
1777 DR : Shared_String_Access;
1782 Low := Index_Non_Blank (Source, Forward);
1784 -- All blanks, reuse empty shared string
1787 Reference (Empty_Shared_String'Access);
1788 DR := Empty_Shared_String'Access;
1794 DL := SR.Last - Low + 1;
1798 High := Index_Non_Blank (Source, Backward);
1802 High := Index_Non_Blank (Source, Backward);
1803 DL := High - Low + 1;
1806 -- Length of the result is the same as length of the source string,
1807 -- reuse source shared string.
1809 if DL = SR.Last then
1813 -- Otherwise, allocate new shared string
1816 DR := Allocate (DL);
1817 DR.Data (1 .. DL) := SR.Data (Low .. High);
1822 return (AF.Controlled with Reference => DR);
1826 (Source : in out Unbounded_String;
1829 SR : constant Shared_String_Access := Source.Reference;
1831 DR : Shared_String_Access;
1836 Low := Index_Non_Blank (Source, Forward);
1838 -- All blanks, reuse empty shared string
1841 Reference (Empty_Shared_String'Access);
1842 Source.Reference := Empty_Shared_String'Access;
1849 DL := SR.Last - Low + 1;
1853 High := Index_Non_Blank (Source, Backward);
1857 High := Index_Non_Blank (Source, Backward);
1858 DL := High - Low + 1;
1861 -- Length of the result is the same as length of the source string,
1864 if DL = SR.Last then
1867 -- Try to reuse existing shared string
1869 elsif Can_Be_Reused (SR, DL) then
1870 SR.Data (1 .. DL) := SR.Data (Low .. High);
1873 -- Otherwise, allocate new shared string
1876 DR := Allocate (DL);
1877 DR.Data (1 .. DL) := SR.Data (Low .. High);
1879 Source.Reference := DR;
1886 (Source : Unbounded_String;
1887 Left : Maps.Character_Set;
1888 Right : Maps.Character_Set) return Unbounded_String
1890 SR : constant Shared_String_Access := Source.Reference;
1892 DR : Shared_String_Access;
1897 Low := Index (Source, Left, Outside, Forward);
1899 -- Source includes only characters from Left set, reuse empty shared
1903 Reference (Empty_Shared_String'Access);
1904 DR := Empty_Shared_String'Access;
1907 High := Index (Source, Right, Outside, Backward);
1908 DL := Integer'Max (0, High - Low + 1);
1910 -- Source includes only characters from Right set or result string
1911 -- is empty, reuse empty shared string.
1913 if High = 0 or else DL = 0 then
1914 Reference (Empty_Shared_String'Access);
1915 DR := Empty_Shared_String'Access;
1917 -- Otherwise, allocate new shared string and fill it
1920 DR := Allocate (DL);
1921 DR.Data (1 .. DL) := SR.Data (Low .. High);
1926 return (AF.Controlled with Reference => DR);
1930 (Source : in out Unbounded_String;
1931 Left : Maps.Character_Set;
1932 Right : Maps.Character_Set)
1934 SR : constant Shared_String_Access := Source.Reference;
1936 DR : Shared_String_Access;
1941 Low := Index (Source, Left, Outside, Forward);
1943 -- Source includes only characters from Left set, reuse empty shared
1947 Reference (Empty_Shared_String'Access);
1948 Source.Reference := Empty_Shared_String'Access;
1952 High := Index (Source, Right, Outside, Backward);
1953 DL := Integer'Max (0, High - Low + 1);
1955 -- Source includes only characters from Right set or result string
1956 -- is empty, reuse empty shared string.
1958 if High = 0 or else DL = 0 then
1959 Reference (Empty_Shared_String'Access);
1960 Source.Reference := Empty_Shared_String'Access;
1963 -- Try to reuse existing shared string
1965 elsif Can_Be_Reused (SR, DL) then
1966 SR.Data (1 .. DL) := SR.Data (Low .. High);
1969 -- Otherwise, allocate new shared string and fill it
1972 DR := Allocate (DL);
1973 DR.Data (1 .. DL) := SR.Data (Low .. High);
1975 Source.Reference := DR;
1981 ---------------------
1982 -- Unbounded_Slice --
1983 ---------------------
1985 function Unbounded_Slice
1986 (Source : Unbounded_String;
1988 High : Natural) return Unbounded_String
1990 SR : constant Shared_String_Access := Source.Reference;
1992 DR : Shared_String_Access;
1997 if Low > SR.Last + 1 or else High > SR.Last then
2000 -- Result is empty slice, reuse empty shared string
2002 elsif Low > High then
2003 Reference (Empty_Shared_String'Access);
2004 DR := Empty_Shared_String'Access;
2006 -- Otherwise, allocate new shared string and fill it
2009 DL := High - Low + 1;
2010 DR := Allocate (DL);
2011 DR.Data (1 .. DL) := SR.Data (Low .. High);
2015 return (AF.Controlled with Reference => DR);
2016 end Unbounded_Slice;
2018 procedure Unbounded_Slice
2019 (Source : Unbounded_String;
2020 Target : out Unbounded_String;
2024 SR : constant Shared_String_Access := Source.Reference;
2025 TR : constant Shared_String_Access := Target.Reference;
2027 DR : Shared_String_Access;
2032 if Low > SR.Last + 1 or else High > SR.Last then
2035 -- Result is empty slice, reuse empty shared string
2037 elsif Low > High then
2038 Reference (Empty_Shared_String'Access);
2039 Target.Reference := Empty_Shared_String'Access;
2043 DL := High - Low + 1;
2045 -- Try to reuse existing shared string
2047 if Can_Be_Reused (TR, DL) then
2048 TR.Data (1 .. DL) := SR.Data (Low .. High);
2051 -- Otherwise, allocate new shared string and fill it
2054 DR := Allocate (DL);
2055 DR.Data (1 .. DL) := SR.Data (Low .. High);
2057 Target.Reference := DR;
2061 end Unbounded_Slice;
2067 procedure Unreference (Item : not null Shared_String_Access) is
2071 new Ada.Unchecked_Deallocation (Shared_String, Shared_String_Access);
2073 Aux : Shared_String_Access := Item;
2076 if Sync_Sub_And_Fetch (Aux.Counter'Access, 1) = 0 then
2078 -- Reference counter of Empty_Shared_String must never reach zero
2080 pragma Assert (Aux /= Empty_Shared_String'Access);
2086 end Ada.Strings.Unbounded;