1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME 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-2002 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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada.Strings.Fixed;
35 with Ada.Strings.Search;
36 with Ada.Unchecked_Deallocation;
38 package body Ada.Strings.Unbounded is
42 procedure Realloc_For_Chunk
43 (Source : in out Unbounded_String;
44 Chunk_Size : Natural);
45 pragma Inline (Realloc_For_Chunk);
46 -- Adjust the size allocated for the string. Add at least Chunk_Size so it
47 -- is safe to add a string of this size at the end of the current
48 -- content. The real size allocated for the string is Chunk_Size + x %
49 -- of the current string size. This buffered handling makes the Append
50 -- unbounded string routines very fast.
56 function "&" (Left, Right : Unbounded_String) return Unbounded_String is
57 L_Length : constant Natural := Left.Last;
58 R_Length : constant Natural := Right.Last;
59 Result : Unbounded_String;
62 Result.Last := L_Length + R_Length;
64 Result.Reference := new String (1 .. Result.Last);
66 Result.Reference (1 .. L_Length) :=
67 Left.Reference (1 .. Left.Last);
68 Result.Reference (L_Length + 1 .. Result.Last) :=
69 Right.Reference (1 .. Right.Last);
75 (Left : Unbounded_String;
77 return Unbounded_String
79 L_Length : constant Natural := Left.Last;
80 Result : Unbounded_String;
83 Result.Last := L_Length + Right'Length;
85 Result.Reference := new String (1 .. Result.Last);
87 Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
88 Result.Reference (L_Length + 1 .. Result.Last) := Right;
95 Right : Unbounded_String)
96 return Unbounded_String
98 R_Length : constant Natural := Right.Last;
99 Result : Unbounded_String;
102 Result.Last := Left'Length + R_Length;
104 Result.Reference := new String (1 .. Result.Last);
106 Result.Reference (1 .. Left'Length) := Left;
107 Result.Reference (Left'Length + 1 .. Result.Last) :=
108 Right.Reference (1 .. Right.Last);
114 (Left : Unbounded_String;
116 return Unbounded_String
118 Result : Unbounded_String;
121 Result.Last := Left.Last + 1;
123 Result.Reference := new String (1 .. Result.Last);
125 Result.Reference (1 .. Result.Last - 1) :=
126 Left.Reference (1 .. Left.Last);
127 Result.Reference (Result.Last) := Right;
134 Right : Unbounded_String)
135 return Unbounded_String
137 Result : Unbounded_String;
140 Result.Last := Right.Last + 1;
142 Result.Reference := new String (1 .. Result.Last);
143 Result.Reference (1) := Left;
144 Result.Reference (2 .. Result.Last) :=
145 Right.Reference (1 .. Right.Last);
156 return Unbounded_String
158 Result : Unbounded_String;
163 Result.Reference := new String (1 .. Left);
164 for J in Result.Reference'Range loop
165 Result.Reference (J) := Right;
174 return Unbounded_String
176 Len : constant Natural := Right'Length;
178 Result : Unbounded_String;
181 Result.Last := Left * Len;
183 Result.Reference := new String (1 .. Result.Last);
186 for J in 1 .. Left loop
187 Result.Reference (K .. K + Len - 1) := Right;
196 Right : Unbounded_String)
197 return Unbounded_String
199 Len : constant Natural := Right.Last;
201 Result : Unbounded_String;
204 Result.Last := Left * Len;
206 Result.Reference := new String (1 .. Result.Last);
209 for I in 1 .. Left loop
210 Result.Reference (K .. K + Len - 1) :=
211 Right.Reference (1 .. Right.Last);
222 function "<" (Left, Right : Unbounded_String) return Boolean is
225 Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
229 (Left : Unbounded_String;
234 return Left.Reference (1 .. Left.Last) < Right;
239 Right : Unbounded_String)
243 return Left < Right.Reference (1 .. Right.Last);
250 function "<=" (Left, Right : Unbounded_String) return Boolean is
253 Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
257 (Left : Unbounded_String;
262 return Left.Reference (1 .. Left.Last) <= Right;
267 Right : Unbounded_String)
271 return Left <= Right.Reference (1 .. Right.Last);
278 function "=" (Left, Right : Unbounded_String) return Boolean is
281 Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
285 (Left : Unbounded_String;
290 return Left.Reference (1 .. Left.Last) = Right;
295 Right : Unbounded_String)
299 return Left = Right.Reference (1 .. Right.Last);
306 function ">" (Left, Right : Unbounded_String) return Boolean is
309 Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
313 (Left : Unbounded_String;
318 return Left.Reference (1 .. Left.Last) > Right;
323 Right : Unbounded_String)
327 return Left > Right.Reference (1 .. Right.Last);
334 function ">=" (Left, Right : Unbounded_String) return Boolean is
337 Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
341 (Left : Unbounded_String;
346 return Left.Reference (1 .. Left.Last) >= Right;
351 Right : Unbounded_String)
355 return Left >= Right.Reference (1 .. Right.Last);
362 procedure Adjust (Object : in out Unbounded_String) is
364 -- Copy string, except we do not copy the statically allocated null
365 -- string, since it can never be deallocated.
366 -- Note that we do not copy extra string room here to avoid dragging
367 -- unused allocated memory.
369 if Object.Reference /= Null_String'Access then
370 Object.Reference := new String'(Object.Reference (1 .. Object.Last));
379 (Source : in out Unbounded_String;
380 New_Item : Unbounded_String)
383 Realloc_For_Chunk (Source, New_Item.Last);
384 Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
385 New_Item.Reference (1 .. New_Item.Last);
386 Source.Last := Source.Last + New_Item.Last;
390 (Source : in out Unbounded_String;
394 Realloc_For_Chunk (Source, New_Item'Length);
395 Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
397 Source.Last := Source.Last + New_Item'Length;
401 (Source : in out Unbounded_String;
402 New_Item : Character)
405 Realloc_For_Chunk (Source, 1);
406 Source.Reference (Source.Last + 1) := New_Item;
407 Source.Last := Source.Last + 1;
415 (Source : Unbounded_String;
417 Mapping : Maps.Character_Mapping := Maps.Identity)
422 Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
426 (Source : Unbounded_String;
428 Mapping : Maps.Character_Mapping_Function)
433 Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
437 (Source : Unbounded_String;
438 Set : Maps.Character_Set)
442 return Search.Count (Source.Reference (1 .. Source.Last), Set);
450 (Source : Unbounded_String;
453 return Unbounded_String
458 (Fixed.Delete (Source.Reference (1 .. Source.Last), From, Through));
462 (Source : in out Unbounded_String;
467 if From > Through then
470 elsif From < Source.Reference'First or else Through > Source.Last then
475 Len : constant Natural := Through - From + 1;
478 Source.Reference (From .. Source.Last - Len) :=
479 Source.Reference (Through + 1 .. Source.Last);
480 Source.Last := Source.Last - Len;
490 (Source : Unbounded_String;
495 if Index <= Source.Last then
496 return Source.Reference (Index);
498 raise Strings.Index_Error;
506 procedure Finalize (Object : in out Unbounded_String) is
507 procedure Deallocate is
508 new Ada.Unchecked_Deallocation (String, String_Access);
511 -- Note: Don't try to free statically allocated null string
513 if Object.Reference /= Null_String'Access then
514 Deallocate (Object.Reference);
515 Object.Reference := Null_Unbounded_String.Reference;
525 (Source : Unbounded_String;
526 Set : Maps.Character_Set;
527 Test : Strings.Membership;
528 First : out Positive;
533 (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
540 procedure Free (X : in out String_Access) is
541 procedure Deallocate is
542 new Ada.Unchecked_Deallocation (String, String_Access);
545 -- Note: Do not try to free statically allocated null string
547 if X /= Null_Unbounded_String.Reference then
557 (Source : Unbounded_String;
559 Pad : Character := Space)
560 return Unbounded_String
563 return To_Unbounded_String
564 (Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
568 (Source : in out Unbounded_String;
570 Pad : Character := Space)
572 Old : String_Access := Source.Reference;
576 new String'(Fixed.Head (Source.Reference (1 .. Source.Last),
578 Source.Last := Source.Reference'Length;
587 (Source : Unbounded_String;
589 Going : Strings.Direction := Strings.Forward;
590 Mapping : Maps.Character_Mapping := Maps.Identity)
595 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
599 (Source : Unbounded_String;
601 Going : Direction := Forward;
602 Mapping : Maps.Character_Mapping_Function)
607 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
611 (Source : Unbounded_String;
612 Set : Maps.Character_Set;
613 Test : Strings.Membership := Strings.Inside;
614 Going : Strings.Direction := Strings.Forward)
619 (Source.Reference (1 .. Source.Last), Set, Test, Going);
622 function Index_Non_Blank
623 (Source : Unbounded_String;
624 Going : Strings.Direction := Strings.Forward)
629 Search.Index_Non_Blank (Source.Reference (1 .. Source.Last), Going);
636 procedure Initialize (Object : in out Unbounded_String) is
638 Object.Reference := Null_Unbounded_String.Reference;
647 (Source : Unbounded_String;
650 return Unbounded_String
653 return To_Unbounded_String
654 (Fixed.Insert (Source.Reference (1 .. Source.Last), Before, New_Item));
658 (Source : in out Unbounded_String;
663 if Before not in Source.Reference'First .. Source.Last + 1 then
667 Realloc_For_Chunk (Source, New_Item'Size);
670 (Before + New_Item'Length .. Source.Last + New_Item'Length) :=
671 Source.Reference (Before .. Source.Last);
673 Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
674 Source.Last := Source.Last + New_Item'Length;
681 function Length (Source : Unbounded_String) return Natural is
691 (Source : Unbounded_String;
694 return Unbounded_String is
697 return To_Unbounded_String
699 (Source.Reference (1 .. Source.Last), Position, New_Item));
703 (Source : in out Unbounded_String;
707 NL : constant Natural := New_Item'Length;
710 if Position <= Source.Last - NL + 1 then
711 Source.Reference (Position .. Position + NL - 1) := New_Item;
715 Old : String_Access := Source.Reference;
718 Source.Reference := new String'
720 (Source.Reference (1 .. Source.Last), Position, New_Item));
721 Source.Last := Source.Reference'Length;
727 -----------------------
728 -- Realloc_For_Chunk --
729 -----------------------
731 procedure Realloc_For_Chunk
732 (Source : in out Unbounded_String;
733 Chunk_Size : Natural)
735 Growth_Factor : constant := 50;
736 S_Length : constant Natural := Source.Reference'Length;
739 if Chunk_Size > S_Length - Source.Last then
741 Alloc_Chunk_Size : constant Positive :=
742 Chunk_Size + (S_Length / Growth_Factor);
746 Tmp := new String (1 .. S_Length + Alloc_Chunk_Size);
747 Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
748 Free (Source.Reference);
749 Source.Reference := Tmp;
752 end Realloc_For_Chunk;
754 ---------------------
755 -- Replace_Element --
756 ---------------------
758 procedure Replace_Element
759 (Source : in out Unbounded_String;
764 if Index <= Source.Last then
765 Source.Reference (Index) := By;
767 raise Strings.Index_Error;
775 function Replace_Slice
776 (Source : Unbounded_String;
780 return Unbounded_String
783 return To_Unbounded_String
785 (Source.Reference (1 .. Source.Last), Low, High, By));
788 procedure Replace_Slice
789 (Source : in out Unbounded_String;
794 Old : String_Access := Source.Reference;
797 Source.Reference := new String'
799 (Source.Reference (1 .. Source.Last), Low, High, By));
800 Source.Last := Source.Reference'Length;
809 (Source : Unbounded_String;
815 -- Note: test of High > Length is in accordance with AI95-00128
817 if Low > Source.Last + 1 or else High > Source.Last then
820 return Source.Reference (Low .. High);
829 (Source : Unbounded_String;
831 Pad : Character := Space)
832 return Unbounded_String is
835 return To_Unbounded_String
836 (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
840 (Source : in out Unbounded_String;
842 Pad : Character := Space)
844 Old : String_Access := Source.Reference;
847 Source.Reference := new String'
848 (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
849 Source.Last := Source.Reference'Length;
857 function To_String (Source : Unbounded_String) return String is
859 return Source.Reference (1 .. Source.Last);
862 -------------------------
863 -- To_Unbounded_String --
864 -------------------------
866 function To_Unbounded_String (Source : String) return Unbounded_String is
867 Result : Unbounded_String;
870 Result.Last := Source'Length;
871 Result.Reference := new String (1 .. Source'Length);
872 Result.Reference.all := Source;
874 end To_Unbounded_String;
876 function To_Unbounded_String
878 return Unbounded_String
880 Result : Unbounded_String;
883 Result.Last := Length;
884 Result.Reference := new String (1 .. Length);
886 end To_Unbounded_String;
893 (Source : Unbounded_String;
894 Mapping : Maps.Character_Mapping)
895 return Unbounded_String
898 return To_Unbounded_String
899 (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
903 (Source : in out Unbounded_String;
904 Mapping : Maps.Character_Mapping)
907 Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
911 (Source : Unbounded_String;
912 Mapping : Maps.Character_Mapping_Function)
913 return Unbounded_String
916 return To_Unbounded_String
917 (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
921 (Source : in out Unbounded_String;
922 Mapping : Maps.Character_Mapping_Function)
925 Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
933 (Source : Unbounded_String;
935 return Unbounded_String
938 return To_Unbounded_String
939 (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
943 (Source : in out Unbounded_String;
946 Old : String_Access := Source.Reference;
949 Source.Reference := new String'
950 (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
951 Source.Last := Source.Reference'Length;
956 (Source : Unbounded_String;
957 Left : Maps.Character_Set;
958 Right : Maps.Character_Set)
959 return Unbounded_String
962 return To_Unbounded_String
963 (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
967 (Source : in out Unbounded_String;
968 Left : Maps.Character_Set;
969 Right : Maps.Character_Set)
971 Old : String_Access := Source.Reference;
974 Source.Reference := new String'
975 (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
976 Source.Last := Source.Reference'Length;
980 end Ada.Strings.Unbounded;