1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . S T R I N G S . W I D E _ U N B O U N D E D --
9 -- Copyright (C) 1992-2005 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
.Wide_Fixed
;
35 with Ada
.Strings
.Wide_Search
;
36 with Ada
.Unchecked_Deallocation
;
38 package body Ada
.Strings
.Wide_Unbounded
is
42 procedure Realloc_For_Chunk
43 (Source
: in out Unbounded_Wide_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 wide string routines very fast.
57 (Left
: Unbounded_Wide_String
;
58 Right
: Unbounded_Wide_String
) return Unbounded_Wide_String
60 L_Length
: constant Natural := Left
.Last
;
61 R_Length
: constant Natural := Right
.Last
;
62 Result
: Unbounded_Wide_String
;
65 Result
.Last
:= L_Length
+ R_Length
;
67 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
69 Result
.Reference
(1 .. L_Length
) :=
70 Left
.Reference
(1 .. Left
.Last
);
71 Result
.Reference
(L_Length
+ 1 .. Result
.Last
) :=
72 Right
.Reference
(1 .. Right
.Last
);
78 (Left
: Unbounded_Wide_String
;
79 Right
: Wide_String) return Unbounded_Wide_String
81 L_Length
: constant Natural := Left
.Last
;
82 Result
: Unbounded_Wide_String
;
85 Result
.Last
:= L_Length
+ Right
'Length;
87 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
89 Result
.Reference
(1 .. L_Length
) := Left
.Reference
(1 .. Left
.Last
);
90 Result
.Reference
(L_Length
+ 1 .. Result
.Last
) := Right
;
97 Right
: Unbounded_Wide_String
) return Unbounded_Wide_String
99 R_Length
: constant Natural := Right
.Last
;
100 Result
: Unbounded_Wide_String
;
103 Result
.Last
:= Left
'Length + R_Length
;
105 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
107 Result
.Reference
(1 .. Left
'Length) := Left
;
108 Result
.Reference
(Left
'Length + 1 .. Result
.Last
) :=
109 Right
.Reference
(1 .. Right
.Last
);
115 (Left
: Unbounded_Wide_String
;
116 Right
: Wide_Character) return Unbounded_Wide_String
118 Result
: Unbounded_Wide_String
;
121 Result
.Last
:= Left
.Last
+ 1;
123 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
125 Result
.Reference
(1 .. Result
.Last
- 1) :=
126 Left
.Reference
(1 .. Left
.Last
);
127 Result
.Reference
(Result
.Last
) := Right
;
133 (Left
: Wide_Character;
134 Right
: Unbounded_Wide_String
) return Unbounded_Wide_String
136 Result
: Unbounded_Wide_String
;
139 Result
.Last
:= Right
.Last
+ 1;
141 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
142 Result
.Reference
(1) := Left
;
143 Result
.Reference
(2 .. Result
.Last
) :=
144 Right
.Reference
(1 .. Right
.Last
);
155 Right
: Wide_Character) return Unbounded_Wide_String
157 Result
: Unbounded_Wide_String
;
162 Result
.Reference
:= new Wide_String (1 .. Left
);
163 for J
in Result
.Reference
'Range loop
164 Result
.Reference
(J
) := Right
;
172 Right
: Wide_String) return Unbounded_Wide_String
174 Len
: constant Natural := Right
'Length;
176 Result
: Unbounded_Wide_String
;
179 Result
.Last
:= Left
* Len
;
181 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
184 for J
in 1 .. Left
loop
185 Result
.Reference
(K
.. K
+ Len
- 1) := Right
;
194 Right
: Unbounded_Wide_String
) return Unbounded_Wide_String
196 Len
: constant Natural := Right
.Last
;
198 Result
: Unbounded_Wide_String
;
201 Result
.Last
:= Left
* Len
;
203 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
206 for I
in 1 .. Left
loop
207 Result
.Reference
(K
.. K
+ Len
- 1) :=
208 Right
.Reference
(1 .. Right
.Last
);
220 (Left
: Unbounded_Wide_String
;
221 Right
: Unbounded_Wide_String
) return Boolean
225 Left
.Reference
(1 .. Left
.Last
) < Right
.Reference
(1 .. Right
.Last
);
229 (Left
: Unbounded_Wide_String
;
230 Right
: Wide_String) return Boolean
233 return Left
.Reference
(1 .. Left
.Last
) < Right
;
238 Right
: Unbounded_Wide_String
) return Boolean
241 return Left
< Right
.Reference
(1 .. Right
.Last
);
249 (Left
: Unbounded_Wide_String
;
250 Right
: Unbounded_Wide_String
) return Boolean
254 Left
.Reference
(1 .. Left
.Last
) <= Right
.Reference
(1 .. Right
.Last
);
258 (Left
: Unbounded_Wide_String
;
259 Right
: Wide_String) return Boolean
262 return Left
.Reference
(1 .. Left
.Last
) <= Right
;
267 Right
: Unbounded_Wide_String
) return Boolean
270 return Left
<= Right
.Reference
(1 .. Right
.Last
);
278 (Left
: Unbounded_Wide_String
;
279 Right
: Unbounded_Wide_String
) return Boolean
283 Left
.Reference
(1 .. Left
.Last
) = Right
.Reference
(1 .. Right
.Last
);
287 (Left
: Unbounded_Wide_String
;
288 Right
: Wide_String) return Boolean
291 return Left
.Reference
(1 .. Left
.Last
) = Right
;
296 Right
: Unbounded_Wide_String
) return Boolean
299 return Left
= Right
.Reference
(1 .. Right
.Last
);
307 (Left
: Unbounded_Wide_String
;
308 Right
: Unbounded_Wide_String
) return Boolean
312 Left
.Reference
(1 .. Left
.Last
) > Right
.Reference
(1 .. Right
.Last
);
316 (Left
: Unbounded_Wide_String
;
317 Right
: Wide_String) return Boolean
320 return Left
.Reference
(1 .. Left
.Last
) > Right
;
325 Right
: Unbounded_Wide_String
) return Boolean
328 return Left
> Right
.Reference
(1 .. Right
.Last
);
336 (Left
: Unbounded_Wide_String
;
337 Right
: Unbounded_Wide_String
) return Boolean
341 Left
.Reference
(1 .. Left
.Last
) >= Right
.Reference
(1 .. Right
.Last
);
345 (Left
: Unbounded_Wide_String
;
346 Right
: Wide_String) return Boolean
349 return Left
.Reference
(1 .. Left
.Last
) >= Right
;
354 Right
: Unbounded_Wide_String
) return Boolean
357 return Left
>= Right
.Reference
(1 .. Right
.Last
);
364 procedure Adjust
(Object
: in out Unbounded_Wide_String
) is
366 -- Copy string, except we do not copy the statically allocated
367 -- null string, since it can never be deallocated.
368 -- Note that we do not copy extra string room here to avoid dragging
369 -- unused allocated memory.
371 if Object
.Reference
/= Null_Wide_String
'Access then
373 new Wide_String'(Object.Reference (1 .. Object.Last));
382 (Source : in out Unbounded_Wide_String;
383 New_Item : Unbounded_Wide_String)
386 Realloc_For_Chunk (Source, New_Item.Last);
387 Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
388 New_Item.Reference (1 .. New_Item.Last);
389 Source.Last := Source.Last + New_Item.Last;
393 (Source : in out Unbounded_Wide_String;
394 New_Item : Wide_String)
397 Realloc_For_Chunk (Source, New_Item'Length);
398 Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
400 Source.Last := Source.Last + New_Item'Length;
404 (Source : in out Unbounded_Wide_String;
405 New_Item : Wide_Character)
408 Realloc_For_Chunk (Source, 1);
409 Source.Reference (Source.Last + 1) := New_Item;
410 Source.Last := Source.Last + 1;
418 (Source : Unbounded_Wide_String;
419 Pattern : Wide_String;
420 Mapping : Wide_Maps.Wide_Character_Mapping :=
425 return Wide_Search.Count
426 (Source.Reference (1 .. Source.Last), Pattern, Mapping);
430 (Source : Unbounded_Wide_String;
431 Pattern : Wide_String;
432 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
435 return Wide_Search.Count
436 (Source.Reference (1 .. Source.Last), Pattern, Mapping);
440 (Source : Unbounded_Wide_String;
441 Set : Wide_Maps.Wide_Character_Set) return Natural
444 return Wide_Search.Count (Source.Reference (1 .. Source.Last), Set);
452 (Source : Unbounded_Wide_String;
454 Through : Natural) return Unbounded_Wide_String
457 return To_Unbounded_Wide_String
459 (Source.Reference (1 .. Source.Last), From, Through));
463 (Source : in out Unbounded_Wide_String;
468 if From > Through then
471 elsif From < Source.Reference'First or else Through > Source.Last then
476 Len : constant Natural := Through - From + 1;
479 Source.Reference (From .. Source.Last - Len) :=
480 Source.Reference (Through + 1 .. Source.Last);
481 Source.Last := Source.Last - Len;
491 (Source : Unbounded_Wide_String;
492 Index : Positive) return Wide_Character
495 if Index <= Source.Last then
496 return Source.Reference (Index);
498 raise Strings.Index_Error;
506 procedure Finalize (Object : in out Unbounded_Wide_String) is
507 procedure Deallocate is
508 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
511 -- Note: Don't try to free statically allocated null string
513 if Object.Reference /= Null_Wide_String'Access then
514 Deallocate (Object.Reference);
515 Object.Reference := Null_Unbounded_Wide_String.Reference;
524 (Source : Unbounded_Wide_String;
525 Set : Wide_Maps.Wide_Character_Set;
526 Test : Strings.Membership;
527 First : out Positive;
531 Wide_Search.Find_Token
532 (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
539 procedure Free (X : in out Wide_String_Access) is
540 procedure Deallocate is
541 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
543 -- Note: Do not try to free statically allocated null string
545 if X /= Null_Unbounded_Wide_String.Reference then
555 (Source : Unbounded_Wide_String;
557 Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String
561 To_Unbounded_Wide_String
562 (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
566 (Source : in out Unbounded_Wide_String;
568 Pad : Wide_Character := Wide_Space)
570 Old : Wide_String_Access := Source.Reference;
573 Source.Reference := new Wide_String'
574 (Wide_Fixed
.Head
(Source
.Reference
(1 .. Source
.Last
), Count
, Pad
));
575 Source
.Last
:= Source
.Reference
'Length;
584 (Source
: Unbounded_Wide_String
;
585 Pattern
: Wide_String;
586 Going
: Strings
.Direction
:= Strings
.Forward
;
587 Mapping
: Wide_Maps
.Wide_Character_Mapping
:=
588 Wide_Maps
.Identity
) return Natural
591 return Wide_Search
.Index
592 (Source
.Reference
(1 .. Source
.Last
), Pattern
, Going
, Mapping
);
596 (Source
: Unbounded_Wide_String
;
597 Pattern
: Wide_String;
598 Going
: Direction
:= Forward
;
599 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
) return Natural
602 return Wide_Search
.Index
603 (Source
.Reference
(1 .. Source
.Last
), Pattern
, Going
, Mapping
);
607 (Source
: Unbounded_Wide_String
;
608 Set
: Wide_Maps
.Wide_Character_Set
;
609 Test
: Strings
.Membership
:= Strings
.Inside
;
610 Going
: Strings
.Direction
:= Strings
.Forward
) return Natural
613 return Wide_Search
.Index
614 (Source
.Reference
(1 .. Source
.Last
), Set
, Test
, Going
);
617 function Index_Non_Blank
618 (Source
: Unbounded_Wide_String
;
619 Going
: Strings
.Direction
:= Strings
.Forward
) return Natural
622 return Wide_Search
.Index_Non_Blank
623 (Source
.Reference
(1 .. Source
.Last
), Going
);
630 procedure Initialize
(Object
: in out Unbounded_Wide_String
) is
632 Object
.Reference
:= Null_Unbounded_Wide_String
.Reference
;
641 (Source
: Unbounded_Wide_String
;
643 New_Item
: Wide_String) return Unbounded_Wide_String
646 return To_Unbounded_Wide_String
648 (Source
.Reference
(1 .. Source
.Last
), Before
, New_Item
));
652 (Source
: in out Unbounded_Wide_String
;
654 New_Item
: Wide_String)
657 if Before
not in Source
.Reference
'First .. Source
.Last
+ 1 then
661 Realloc_For_Chunk
(Source
, New_Item
'Size);
664 (Before
+ New_Item
'Length .. Source
.Last
+ New_Item
'Length) :=
665 Source
.Reference
(Before
.. Source
.Last
);
667 Source
.Reference
(Before
.. Before
+ New_Item
'Length - 1) := New_Item
;
668 Source
.Last
:= Source
.Last
+ New_Item
'Length;
675 function Length
(Source
: Unbounded_Wide_String
) return Natural is
685 (Source
: Unbounded_Wide_String
;
687 New_Item
: Wide_String) return Unbounded_Wide_String
690 return To_Unbounded_Wide_String
691 (Wide_Fixed
.Overwrite
692 (Source
.Reference
(1 .. Source
.Last
), Position
, New_Item
));
696 (Source
: in out Unbounded_Wide_String
;
698 New_Item
: Wide_String)
700 NL
: constant Natural := New_Item
'Length;
703 if Position
<= Source
.Last
- NL
+ 1 then
704 Source
.Reference
(Position
.. Position
+ NL
- 1) := New_Item
;
708 Old
: Wide_String_Access
:= Source
.Reference
;
711 Source
.Reference
:= new Wide_String'
712 (Wide_Fixed.Overwrite
713 (Source.Reference (1 .. Source.Last), Position, New_Item));
714 Source.Last := Source.Reference'Length;
720 -----------------------
721 -- Realloc_For_Chunk --
722 -----------------------
724 procedure Realloc_For_Chunk
725 (Source : in out Unbounded_Wide_String;
726 Chunk_Size : Natural)
728 Growth_Factor : constant := 50;
729 S_Length : constant Natural := Source.Reference'Length;
732 if Chunk_Size > S_Length - Source.Last then
734 Alloc_Chunk_Size : constant Positive :=
735 Chunk_Size + (S_Length / Growth_Factor);
736 Tmp : Wide_String_Access;
739 Tmp := new Wide_String (1 .. S_Length + Alloc_Chunk_Size);
740 Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
741 Free (Source.Reference);
742 Source.Reference := Tmp;
745 end Realloc_For_Chunk;
747 ---------------------
748 -- Replace_Element --
749 ---------------------
751 procedure Replace_Element
752 (Source : in out Unbounded_Wide_String;
757 if Index <= Source.Last then
758 Source.Reference (Index) := By;
760 raise Strings.Index_Error;
768 function Replace_Slice
769 (Source : Unbounded_Wide_String;
772 By : Wide_String) return Unbounded_Wide_String
776 To_Unbounded_Wide_String
777 (Wide_Fixed.Replace_Slice
778 (Source.Reference (1 .. Source.Last), Low, High, By));
781 procedure Replace_Slice
782 (Source : in out Unbounded_Wide_String;
787 Old : Wide_String_Access := Source.Reference;
790 Source.Reference := new Wide_String'
791 (Wide_Fixed
.Replace_Slice
792 (Source
.Reference
(1 .. Source
.Last
), Low
, High
, By
));
793 Source
.Last
:= Source
.Reference
'Length;
802 (Source
: Unbounded_Wide_String
;
804 High
: Natural) return Wide_String
807 -- Note: test of High > Length is in accordance with AI95-00128
809 if Low
> Source
.Last
+ 1 or else High
> Source
.Last
then
813 return Source
.Reference
(Low
.. High
);
822 (Source
: Unbounded_Wide_String
;
824 Pad
: Wide_Character := Wide_Space
) return Unbounded_Wide_String
827 return To_Unbounded_Wide_String
828 (Wide_Fixed
.Tail
(Source
.Reference
(1 .. Source
.Last
), Count
, Pad
));
832 (Source
: in out Unbounded_Wide_String
;
834 Pad
: Wide_Character := Wide_Space
)
836 Old
: Wide_String_Access
:= Source
.Reference
;
839 Source
.Reference
:= new Wide_String'
840 (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
841 Source.Last := Source.Reference'Length;
845 ------------------------------
846 -- To_Unbounded_Wide_String --
847 ------------------------------
849 function To_Unbounded_Wide_String
850 (Source : Wide_String) return Unbounded_Wide_String
852 Result : Unbounded_Wide_String;
854 Result.Last := Source'Length;
855 Result.Reference := new Wide_String (1 .. Source'Length);
856 Result.Reference.all := Source;
858 end To_Unbounded_Wide_String;
860 function To_Unbounded_Wide_String
861 (Length : Natural) return Unbounded_Wide_String
863 Result : Unbounded_Wide_String;
865 Result.Last := Length;
866 Result.Reference := new Wide_String (1 .. Length);
868 end To_Unbounded_Wide_String;
874 function To_Wide_String
875 (Source : Unbounded_Wide_String) return Wide_String
878 return Source.Reference (1 .. Source.Last);
886 (Source : Unbounded_Wide_String;
887 Mapping : Wide_Maps.Wide_Character_Mapping) return Unbounded_Wide_String
890 return To_Unbounded_Wide_String
891 (Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
895 (Source : in out Unbounded_Wide_String;
896 Mapping : Wide_Maps.Wide_Character_Mapping)
899 Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
903 (Source : Unbounded_Wide_String;
904 Mapping : Wide_Maps.Wide_Character_Mapping_Function)
905 return Unbounded_Wide_String
908 return To_Unbounded_Wide_String
909 (Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
913 (Source : in out Unbounded_Wide_String;
914 Mapping : Wide_Maps.Wide_Character_Mapping_Function)
917 Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
925 (Source : Unbounded_Wide_String;
926 Side : Trim_End) return Unbounded_Wide_String
929 return To_Unbounded_Wide_String
930 (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
934 (Source : in out Unbounded_Wide_String;
937 Old : Wide_String_Access := Source.Reference;
939 Source.Reference := new Wide_String'
940 (Wide_Fixed
.Trim
(Source
.Reference
(1 .. Source
.Last
), Side
));
941 Source
.Last
:= Source
.Reference
'Length;
946 (Source
: Unbounded_Wide_String
;
947 Left
: Wide_Maps
.Wide_Character_Set
;
948 Right
: Wide_Maps
.Wide_Character_Set
) return Unbounded_Wide_String
951 return To_Unbounded_Wide_String
952 (Wide_Fixed
.Trim
(Source
.Reference
(1 .. Source
.Last
), Left
, Right
));
956 (Source
: in out Unbounded_Wide_String
;
957 Left
: Wide_Maps
.Wide_Character_Set
;
958 Right
: Wide_Maps
.Wide_Character_Set
)
960 Old
: Wide_String_Access
:= Source
.Reference
;
963 Source
.Reference
:= new Wide_String'
964 (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
965 Source.Last := Source.Reference'Length;
969 end Ada.Strings.Wide_Unbounded;