1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . S T R I N G S . U N B O U N D E D -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- 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. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32with Ada.Strings.Search; 33with Ada.Unchecked_Deallocation; 34 35package body Ada.Strings.Unbounded is 36 37 use Ada.Strings.Maps; 38 39 Growth_Factor : constant := 32; 40 -- The growth factor controls how much extra space is allocated when 41 -- we have to increase the size of an allocated unbounded string. By 42 -- allocating extra space, we avoid the need to reallocate on every 43 -- append, particularly important when a string is built up by repeated 44 -- append operations of small pieces. This is expressed as a factor so 45 -- 32 means add 1/32 of the length of the string as growth space. 46 47 Min_Mul_Alloc : constant := Standard'Maximum_Alignment; 48 -- Allocation will be done by a multiple of Min_Mul_Alloc. This causes 49 -- no memory loss as most (all?) malloc implementations are obliged to 50 -- align the returned memory on the maximum alignment as malloc does not 51 -- know the target alignment. 52 53 function Aligned_Max_Length (Max_Length : Natural) return Natural; 54 -- Returns recommended length of the shared string which is greater or 55 -- equal to specified length. Calculation take in sense alignment of the 56 -- allocated memory segments to use memory effectively by Append/Insert/etc 57 -- operations. 58 59 --------- 60 -- "&" -- 61 --------- 62 63 function "&" 64 (Left : Unbounded_String; 65 Right : Unbounded_String) return Unbounded_String 66 is 67 LR : constant Shared_String_Access := Left.Reference; 68 RR : constant Shared_String_Access := Right.Reference; 69 DL : constant Natural := LR.Last + RR.Last; 70 DR : Shared_String_Access; 71 72 begin 73 -- Result is an empty string, reuse shared empty string 74 75 if DL = 0 then 76 Reference (Empty_Shared_String'Access); 77 DR := Empty_Shared_String'Access; 78 79 -- Left string is empty, return Right string 80 81 elsif LR.Last = 0 then 82 Reference (RR); 83 DR := RR; 84 85 -- Right string is empty, return Left string 86 87 elsif RR.Last = 0 then 88 Reference (LR); 89 DR := LR; 90 91 -- Otherwise, allocate new shared string and fill data 92 93 else 94 DR := Allocate (DL); 95 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last); 96 DR.Data (LR.Last + 1 .. DL) := RR.Data (1 .. RR.Last); 97 DR.Last := DL; 98 end if; 99 100 return (AF.Controlled with Reference => DR); 101 end "&"; 102 103 function "&" 104 (Left : Unbounded_String; 105 Right : String) return Unbounded_String 106 is 107 LR : constant Shared_String_Access := Left.Reference; 108 DL : constant Natural := LR.Last + Right'Length; 109 DR : Shared_String_Access; 110 111 begin 112 -- Result is an empty string, reuse shared empty string 113 114 if DL = 0 then 115 Reference (Empty_Shared_String'Access); 116 DR := Empty_Shared_String'Access; 117 118 -- Right is an empty string, return Left string 119 120 elsif Right'Length = 0 then 121 Reference (LR); 122 DR := LR; 123 124 -- Otherwise, allocate new shared string and fill it 125 126 else 127 DR := Allocate (DL); 128 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last); 129 DR.Data (LR.Last + 1 .. DL) := Right; 130 DR.Last := DL; 131 end if; 132 133 return (AF.Controlled with Reference => DR); 134 end "&"; 135 136 function "&" 137 (Left : String; 138 Right : Unbounded_String) return Unbounded_String 139 is 140 RR : constant Shared_String_Access := Right.Reference; 141 DL : constant Natural := Left'Length + RR.Last; 142 DR : Shared_String_Access; 143 144 begin 145 -- Result is an empty string, reuse shared one 146 147 if DL = 0 then 148 Reference (Empty_Shared_String'Access); 149 DR := Empty_Shared_String'Access; 150 151 -- Left is empty string, return Right string 152 153 elsif Left'Length = 0 then 154 Reference (RR); 155 DR := RR; 156 157 -- Otherwise, allocate new shared string and fill it 158 159 else 160 DR := Allocate (DL); 161 DR.Data (1 .. Left'Length) := Left; 162 DR.Data (Left'Length + 1 .. DL) := RR.Data (1 .. RR.Last); 163 DR.Last := DL; 164 end if; 165 166 return (AF.Controlled with Reference => DR); 167 end "&"; 168 169 function "&" 170 (Left : Unbounded_String; 171 Right : Character) return Unbounded_String 172 is 173 LR : constant Shared_String_Access := Left.Reference; 174 DL : constant Natural := LR.Last + 1; 175 DR : Shared_String_Access; 176 177 begin 178 DR := Allocate (DL); 179 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last); 180 DR.Data (DL) := Right; 181 DR.Last := DL; 182 183 return (AF.Controlled with Reference => DR); 184 end "&"; 185 186 function "&" 187 (Left : Character; 188 Right : Unbounded_String) return Unbounded_String 189 is 190 RR : constant Shared_String_Access := Right.Reference; 191 DL : constant Natural := 1 + RR.Last; 192 DR : Shared_String_Access; 193 194 begin 195 DR := Allocate (DL); 196 DR.Data (1) := Left; 197 DR.Data (2 .. DL) := RR.Data (1 .. RR.Last); 198 DR.Last := DL; 199 200 return (AF.Controlled with Reference => DR); 201 end "&"; 202 203 --------- 204 -- "*" -- 205 --------- 206 207 function "*" 208 (Left : Natural; 209 Right : Character) return Unbounded_String 210 is 211 DR : Shared_String_Access; 212 213 begin 214 -- Result is an empty string, reuse shared empty string 215 216 if Left = 0 then 217 Reference (Empty_Shared_String'Access); 218 DR := Empty_Shared_String'Access; 219 220 -- Otherwise, allocate new shared string and fill it 221 222 else 223 DR := Allocate (Left); 224 225 for J in 1 .. Left loop 226 DR.Data (J) := Right; 227 end loop; 228 229 DR.Last := Left; 230 end if; 231 232 return (AF.Controlled with Reference => DR); 233 end "*"; 234 235 function "*" 236 (Left : Natural; 237 Right : String) return Unbounded_String 238 is 239 DL : constant Natural := Left * Right'Length; 240 DR : Shared_String_Access; 241 K : Positive; 242 243 begin 244 -- Result is an empty string, reuse shared empty string 245 246 if DL = 0 then 247 Reference (Empty_Shared_String'Access); 248 DR := Empty_Shared_String'Access; 249 250 -- Otherwise, allocate new shared string and fill it 251 252 else 253 DR := Allocate (DL); 254 K := 1; 255 256 for J in 1 .. Left loop 257 DR.Data (K .. K + Right'Length - 1) := Right; 258 K := K + Right'Length; 259 end loop; 260 261 DR.Last := DL; 262 end if; 263 264 return (AF.Controlled with Reference => DR); 265 end "*"; 266 267 function "*" 268 (Left : Natural; 269 Right : Unbounded_String) return Unbounded_String 270 is 271 RR : constant Shared_String_Access := Right.Reference; 272 DL : constant Natural := Left * RR.Last; 273 DR : Shared_String_Access; 274 K : Positive; 275 276 begin 277 -- Result is an empty string, reuse shared empty string 278 279 if DL = 0 then 280 Reference (Empty_Shared_String'Access); 281 DR := Empty_Shared_String'Access; 282 283 -- Coefficient is one, just return string itself 284 285 elsif Left = 1 then 286 Reference (RR); 287 DR := RR; 288 289 -- Otherwise, allocate new shared string and fill it 290 291 else 292 DR := Allocate (DL); 293 K := 1; 294 295 for J in 1 .. Left loop 296 DR.Data (K .. K + RR.Last - 1) := RR.Data (1 .. RR.Last); 297 K := K + RR.Last; 298 end loop; 299 300 DR.Last := DL; 301 end if; 302 303 return (AF.Controlled with Reference => DR); 304 end "*"; 305 306 --------- 307 -- "<" -- 308 --------- 309 310 function "<" 311 (Left : Unbounded_String; 312 Right : Unbounded_String) return Boolean 313 is 314 LR : constant Shared_String_Access := Left.Reference; 315 RR : constant Shared_String_Access := Right.Reference; 316 begin 317 return LR.Data (1 .. LR.Last) < RR.Data (1 .. RR.Last); 318 end "<"; 319 320 function "<" 321 (Left : Unbounded_String; 322 Right : String) return Boolean 323 is 324 LR : constant Shared_String_Access := Left.Reference; 325 begin 326 return LR.Data (1 .. LR.Last) < Right; 327 end "<"; 328 329 function "<" 330 (Left : String; 331 Right : Unbounded_String) return Boolean 332 is 333 RR : constant Shared_String_Access := Right.Reference; 334 begin 335 return Left < RR.Data (1 .. RR.Last); 336 end "<"; 337 338 ---------- 339 -- "<=" -- 340 ---------- 341 342 function "<=" 343 (Left : Unbounded_String; 344 Right : Unbounded_String) return Boolean 345 is 346 LR : constant Shared_String_Access := Left.Reference; 347 RR : constant Shared_String_Access := Right.Reference; 348 349 begin 350 -- LR = RR means two strings shares shared string, thus they are equal 351 352 return LR = RR or else LR.Data (1 .. LR.Last) <= RR.Data (1 .. RR.Last); 353 end "<="; 354 355 function "<=" 356 (Left : Unbounded_String; 357 Right : String) return Boolean 358 is 359 LR : constant Shared_String_Access := Left.Reference; 360 begin 361 return LR.Data (1 .. LR.Last) <= Right; 362 end "<="; 363 364 function "<=" 365 (Left : String; 366 Right : Unbounded_String) return Boolean 367 is 368 RR : constant Shared_String_Access := Right.Reference; 369 begin 370 return Left <= RR.Data (1 .. RR.Last); 371 end "<="; 372 373 --------- 374 -- "=" -- 375 --------- 376 377 function "=" 378 (Left : Unbounded_String; 379 Right : Unbounded_String) return Boolean 380 is 381 LR : constant Shared_String_Access := Left.Reference; 382 RR : constant Shared_String_Access := Right.Reference; 383 384 begin 385 return LR = RR or else LR.Data (1 .. LR.Last) = RR.Data (1 .. RR.Last); 386 -- LR = RR means two strings shares shared string, thus they are equal 387 end "="; 388 389 function "=" 390 (Left : Unbounded_String; 391 Right : String) return Boolean 392 is 393 LR : constant Shared_String_Access := Left.Reference; 394 begin 395 return LR.Data (1 .. LR.Last) = Right; 396 end "="; 397 398 function "=" 399 (Left : String; 400 Right : Unbounded_String) return Boolean 401 is 402 RR : constant Shared_String_Access := Right.Reference; 403 begin 404 return Left = RR.Data (1 .. RR.Last); 405 end "="; 406 407 --------- 408 -- ">" -- 409 --------- 410 411 function ">" 412 (Left : Unbounded_String; 413 Right : Unbounded_String) return Boolean 414 is 415 LR : constant Shared_String_Access := Left.Reference; 416 RR : constant Shared_String_Access := Right.Reference; 417 begin 418 return LR.Data (1 .. LR.Last) > RR.Data (1 .. RR.Last); 419 end ">"; 420 421 function ">" 422 (Left : Unbounded_String; 423 Right : String) return Boolean 424 is 425 LR : constant Shared_String_Access := Left.Reference; 426 begin 427 return LR.Data (1 .. LR.Last) > Right; 428 end ">"; 429 430 function ">" 431 (Left : String; 432 Right : Unbounded_String) return Boolean 433 is 434 RR : constant Shared_String_Access := Right.Reference; 435 begin 436 return Left > RR.Data (1 .. RR.Last); 437 end ">"; 438 439 ---------- 440 -- ">=" -- 441 ---------- 442 443 function ">=" 444 (Left : Unbounded_String; 445 Right : Unbounded_String) return Boolean 446 is 447 LR : constant Shared_String_Access := Left.Reference; 448 RR : constant Shared_String_Access := Right.Reference; 449 450 begin 451 -- LR = RR means two strings shares shared string, thus they are equal 452 453 return LR = RR or else LR.Data (1 .. LR.Last) >= RR.Data (1 .. RR.Last); 454 end ">="; 455 456 function ">=" 457 (Left : Unbounded_String; 458 Right : String) return Boolean 459 is 460 LR : constant Shared_String_Access := Left.Reference; 461 begin 462 return LR.Data (1 .. LR.Last) >= Right; 463 end ">="; 464 465 function ">=" 466 (Left : String; 467 Right : Unbounded_String) return Boolean 468 is 469 RR : constant Shared_String_Access := Right.Reference; 470 begin 471 return Left >= RR.Data (1 .. RR.Last); 472 end ">="; 473 474 ------------ 475 -- Adjust -- 476 ------------ 477 478 procedure Adjust (Object : in out Unbounded_String) is 479 begin 480 Reference (Object.Reference); 481 end Adjust; 482 483 ------------------------ 484 -- Aligned_Max_Length -- 485 ------------------------ 486 487 function Aligned_Max_Length (Max_Length : Natural) return Natural is 488 Static_Size : constant Natural := 489 Empty_Shared_String'Size / Standard'Storage_Unit; 490 -- Total size of all static components 491 492 begin 493 return 494 ((Static_Size + Max_Length - 1) / Min_Mul_Alloc + 2) * Min_Mul_Alloc 495 - Static_Size; 496 end Aligned_Max_Length; 497 498 -------------- 499 -- Allocate -- 500 -------------- 501 502 function Allocate (Max_Length : Natural) return Shared_String_Access is 503 begin 504 -- Empty string requested, return shared empty string 505 506 if Max_Length = 0 then 507 Reference (Empty_Shared_String'Access); 508 return Empty_Shared_String'Access; 509 510 -- Otherwise, allocate requested space (and probably some more room) 511 512 else 513 return new Shared_String (Aligned_Max_Length (Max_Length)); 514 end if; 515 end Allocate; 516 517 ------------ 518 -- Append -- 519 ------------ 520 521 procedure Append 522 (Source : in out Unbounded_String; 523 New_Item : Unbounded_String) 524 is 525 SR : constant Shared_String_Access := Source.Reference; 526 NR : constant Shared_String_Access := New_Item.Reference; 527 DL : constant Natural := SR.Last + NR.Last; 528 DR : Shared_String_Access; 529 530 begin 531 -- Source is an empty string, reuse New_Item data 532 533 if SR.Last = 0 then 534 Reference (NR); 535 Source.Reference := NR; 536 Unreference (SR); 537 538 -- New_Item is empty string, nothing to do 539 540 elsif NR.Last = 0 then 541 null; 542 543 -- Try to reuse existing shared string 544 545 elsif Can_Be_Reused (SR, DL) then 546 SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last); 547 SR.Last := DL; 548 549 -- Otherwise, allocate new one and fill it 550 551 else 552 DR := Allocate (DL + DL / Growth_Factor); 553 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 554 DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last); 555 DR.Last := DL; 556 Source.Reference := DR; 557 Unreference (SR); 558 end if; 559 end Append; 560 561 procedure Append 562 (Source : in out Unbounded_String; 563 New_Item : String) 564 is 565 SR : constant Shared_String_Access := Source.Reference; 566 DL : constant Natural := SR.Last + New_Item'Length; 567 DR : Shared_String_Access; 568 569 begin 570 -- New_Item is an empty string, nothing to do 571 572 if New_Item'Length = 0 then 573 null; 574 575 -- Try to reuse existing shared string 576 577 elsif Can_Be_Reused (SR, DL) then 578 SR.Data (SR.Last + 1 .. DL) := New_Item; 579 SR.Last := DL; 580 581 -- Otherwise, allocate new one and fill it 582 583 else 584 DR := Allocate (DL + DL / Growth_Factor); 585 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 586 DR.Data (SR.Last + 1 .. DL) := New_Item; 587 DR.Last := DL; 588 Source.Reference := DR; 589 Unreference (SR); 590 end if; 591 end Append; 592 593 procedure Append 594 (Source : in out Unbounded_String; 595 New_Item : Character) 596 is 597 SR : constant Shared_String_Access := Source.Reference; 598 DL : constant Natural := SR.Last + 1; 599 DR : Shared_String_Access; 600 601 begin 602 -- Try to reuse existing shared string 603 604 if Can_Be_Reused (SR, SR.Last + 1) then 605 SR.Data (SR.Last + 1) := New_Item; 606 SR.Last := SR.Last + 1; 607 608 -- Otherwise, allocate new one and fill it 609 610 else 611 DR := Allocate (DL + DL / Growth_Factor); 612 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 613 DR.Data (DL) := New_Item; 614 DR.Last := DL; 615 Source.Reference := DR; 616 Unreference (SR); 617 end if; 618 end Append; 619 620 ------------------- 621 -- Can_Be_Reused -- 622 ------------------- 623 624 function Can_Be_Reused 625 (Item : Shared_String_Access; 626 Length : Natural) return Boolean is 627 begin 628 return 629 System.Atomic_Counters.Is_One (Item.Counter) 630 and then Item.Max_Length >= Length 631 and then Item.Max_Length <= 632 Aligned_Max_Length (Length + Length / Growth_Factor); 633 end Can_Be_Reused; 634 635 ----------- 636 -- Count -- 637 ----------- 638 639 function Count 640 (Source : Unbounded_String; 641 Pattern : String; 642 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural 643 is 644 SR : constant Shared_String_Access := Source.Reference; 645 begin 646 return Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping); 647 end Count; 648 649 function Count 650 (Source : Unbounded_String; 651 Pattern : String; 652 Mapping : Maps.Character_Mapping_Function) return Natural 653 is 654 SR : constant Shared_String_Access := Source.Reference; 655 begin 656 return Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping); 657 end Count; 658 659 function Count 660 (Source : Unbounded_String; 661 Set : Maps.Character_Set) return Natural 662 is 663 SR : constant Shared_String_Access := Source.Reference; 664 begin 665 return Search.Count (SR.Data (1 .. SR.Last), Set); 666 end Count; 667 668 ------------ 669 -- Delete -- 670 ------------ 671 672 function Delete 673 (Source : Unbounded_String; 674 From : Positive; 675 Through : Natural) return Unbounded_String 676 is 677 SR : constant Shared_String_Access := Source.Reference; 678 DL : Natural; 679 DR : Shared_String_Access; 680 681 begin 682 -- Empty slice is deleted, use the same shared string 683 684 if From > Through then 685 Reference (SR); 686 DR := SR; 687 688 -- Index is out of range 689 690 elsif Through > SR.Last then 691 raise Index_Error; 692 693 -- Compute size of the result 694 695 else 696 DL := SR.Last - (Through - From + 1); 697 698 -- Result is an empty string, reuse shared empty string 699 700 if DL = 0 then 701 Reference (Empty_Shared_String'Access); 702 DR := Empty_Shared_String'Access; 703 704 -- Otherwise, allocate new shared string and fill it 705 706 else 707 DR := Allocate (DL); 708 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1); 709 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last); 710 DR.Last := DL; 711 end if; 712 end if; 713 714 return (AF.Controlled with Reference => DR); 715 end Delete; 716 717 procedure Delete 718 (Source : in out Unbounded_String; 719 From : Positive; 720 Through : Natural) 721 is 722 SR : constant Shared_String_Access := Source.Reference; 723 DL : Natural; 724 DR : Shared_String_Access; 725 726 begin 727 -- Nothing changed, return 728 729 if From > Through then 730 null; 731 732 -- Through is outside of the range 733 734 elsif Through > SR.Last then 735 raise Index_Error; 736 737 else 738 DL := SR.Last - (Through - From + 1); 739 740 -- Result is empty, reuse shared empty string 741 742 if DL = 0 then 743 Reference (Empty_Shared_String'Access); 744 Source.Reference := Empty_Shared_String'Access; 745 Unreference (SR); 746 747 -- Try to reuse existing shared string 748 749 elsif Can_Be_Reused (SR, DL) then 750 SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last); 751 SR.Last := DL; 752 753 -- Otherwise, allocate new shared string 754 755 else 756 DR := Allocate (DL); 757 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1); 758 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last); 759 DR.Last := DL; 760 Source.Reference := DR; 761 Unreference (SR); 762 end if; 763 end if; 764 end Delete; 765 766 ------------- 767 -- Element -- 768 ------------- 769 770 function Element 771 (Source : Unbounded_String; 772 Index : Positive) return Character 773 is 774 SR : constant Shared_String_Access := Source.Reference; 775 begin 776 if Index <= SR.Last then 777 return SR.Data (Index); 778 else 779 raise Index_Error; 780 end if; 781 end Element; 782 783 -------------- 784 -- Finalize -- 785 -------------- 786 787 procedure Finalize (Object : in out Unbounded_String) is 788 SR : constant Shared_String_Access := Object.Reference; 789 790 begin 791 if SR /= null then 792 793 -- The same controlled object can be finalized several times for 794 -- some reason. As per 7.6.1(24) this should have no ill effect, 795 -- so we need to add a guard for the case of finalizing the same 796 -- object twice. 797 798 Object.Reference := null; 799 Unreference (SR); 800 end if; 801 end Finalize; 802 803 ---------------- 804 -- Find_Token -- 805 ---------------- 806 807 procedure Find_Token 808 (Source : Unbounded_String; 809 Set : Maps.Character_Set; 810 From : Positive; 811 Test : Strings.Membership; 812 First : out Positive; 813 Last : out Natural) 814 is 815 SR : constant Shared_String_Access := Source.Reference; 816 begin 817 Search.Find_Token (SR.Data (From .. SR.Last), Set, Test, First, Last); 818 end Find_Token; 819 820 procedure Find_Token 821 (Source : Unbounded_String; 822 Set : Maps.Character_Set; 823 Test : Strings.Membership; 824 First : out Positive; 825 Last : out Natural) 826 is 827 SR : constant Shared_String_Access := Source.Reference; 828 begin 829 Search.Find_Token (SR.Data (1 .. SR.Last), Set, Test, First, Last); 830 end Find_Token; 831 832 ---------- 833 -- Free -- 834 ---------- 835 836 procedure Free (X : in out String_Access) is 837 procedure Deallocate is 838 new Ada.Unchecked_Deallocation (String, String_Access); 839 begin 840 Deallocate (X); 841 end Free; 842 843 ---------- 844 -- Head -- 845 ---------- 846 847 function Head 848 (Source : Unbounded_String; 849 Count : Natural; 850 Pad : Character := Space) return Unbounded_String 851 is 852 SR : constant Shared_String_Access := Source.Reference; 853 DR : Shared_String_Access; 854 855 begin 856 -- Result is empty, reuse shared empty string 857 858 if Count = 0 then 859 Reference (Empty_Shared_String'Access); 860 DR := Empty_Shared_String'Access; 861 862 -- Length of the string is the same as requested, reuse source shared 863 -- string. 864 865 elsif Count = SR.Last then 866 Reference (SR); 867 DR := SR; 868 869 -- Otherwise, allocate new shared string and fill it 870 871 else 872 DR := Allocate (Count); 873 874 -- Length of the source string is more than requested, copy 875 -- corresponding slice. 876 877 if Count < SR.Last then 878 DR.Data (1 .. Count) := SR.Data (1 .. Count); 879 880 -- Length of the source string is less than requested, copy all 881 -- contents and fill others by Pad character. 882 883 else 884 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 885 886 for J in SR.Last + 1 .. Count loop 887 DR.Data (J) := Pad; 888 end loop; 889 end if; 890 891 DR.Last := Count; 892 end if; 893 894 return (AF.Controlled with Reference => DR); 895 end Head; 896 897 procedure Head 898 (Source : in out Unbounded_String; 899 Count : Natural; 900 Pad : Character := Space) 901 is 902 SR : constant Shared_String_Access := Source.Reference; 903 DR : Shared_String_Access; 904 905 begin 906 -- Result is empty, reuse empty shared string 907 908 if Count = 0 then 909 Reference (Empty_Shared_String'Access); 910 Source.Reference := Empty_Shared_String'Access; 911 Unreference (SR); 912 913 -- Result is same as source string, reuse source shared string 914 915 elsif Count = SR.Last then 916 null; 917 918 -- Try to reuse existing shared string 919 920 elsif Can_Be_Reused (SR, Count) then 921 if Count > SR.Last then 922 for J in SR.Last + 1 .. Count loop 923 SR.Data (J) := Pad; 924 end loop; 925 end if; 926 927 SR.Last := Count; 928 929 -- Otherwise, allocate new shared string and fill it 930 931 else 932 DR := Allocate (Count); 933 934 -- Length of the source string is greater than requested, copy 935 -- corresponding slice. 936 937 if Count < SR.Last then 938 DR.Data (1 .. Count) := SR.Data (1 .. Count); 939 940 -- Length of the source string is less than requested, copy all 941 -- existing data and fill remaining positions with Pad characters. 942 943 else 944 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 945 946 for J in SR.Last + 1 .. Count loop 947 DR.Data (J) := Pad; 948 end loop; 949 end if; 950 951 DR.Last := Count; 952 Source.Reference := DR; 953 Unreference (SR); 954 end if; 955 end Head; 956 957 ----------- 958 -- Index -- 959 ----------- 960 961 function Index 962 (Source : Unbounded_String; 963 Pattern : String; 964 Going : Strings.Direction := Strings.Forward; 965 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural 966 is 967 SR : constant Shared_String_Access := Source.Reference; 968 begin 969 return Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping); 970 end Index; 971 972 function Index 973 (Source : Unbounded_String; 974 Pattern : String; 975 Going : Direction := Forward; 976 Mapping : Maps.Character_Mapping_Function) return Natural 977 is 978 SR : constant Shared_String_Access := Source.Reference; 979 begin 980 return Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping); 981 end Index; 982 983 function Index 984 (Source : Unbounded_String; 985 Set : Maps.Character_Set; 986 Test : Strings.Membership := Strings.Inside; 987 Going : Strings.Direction := Strings.Forward) return Natural 988 is 989 SR : constant Shared_String_Access := Source.Reference; 990 begin 991 return Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going); 992 end Index; 993 994 function Index 995 (Source : Unbounded_String; 996 Pattern : String; 997 From : Positive; 998 Going : Direction := Forward; 999 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural 1000 is 1001 SR : constant Shared_String_Access := Source.Reference; 1002 begin 1003 return Search.Index 1004 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping); 1005 end Index; 1006 1007 function Index 1008 (Source : Unbounded_String; 1009 Pattern : String; 1010 From : Positive; 1011 Going : Direction := Forward; 1012 Mapping : Maps.Character_Mapping_Function) return Natural 1013 is 1014 SR : constant Shared_String_Access := Source.Reference; 1015 begin 1016 return Search.Index 1017 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping); 1018 end Index; 1019 1020 function Index 1021 (Source : Unbounded_String; 1022 Set : Maps.Character_Set; 1023 From : Positive; 1024 Test : Membership := Inside; 1025 Going : Direction := Forward) return Natural 1026 is 1027 SR : constant Shared_String_Access := Source.Reference; 1028 begin 1029 return Search.Index (SR.Data (1 .. SR.Last), Set, From, Test, Going); 1030 end Index; 1031 1032 --------------------- 1033 -- Index_Non_Blank -- 1034 --------------------- 1035 1036 function Index_Non_Blank 1037 (Source : Unbounded_String; 1038 Going : Strings.Direction := Strings.Forward) return Natural 1039 is 1040 SR : constant Shared_String_Access := Source.Reference; 1041 begin 1042 return Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going); 1043 end Index_Non_Blank; 1044 1045 function Index_Non_Blank 1046 (Source : Unbounded_String; 1047 From : Positive; 1048 Going : Direction := Forward) return Natural 1049 is 1050 SR : constant Shared_String_Access := Source.Reference; 1051 begin 1052 return Search.Index_Non_Blank (SR.Data (1 .. SR.Last), From, Going); 1053 end Index_Non_Blank; 1054 1055 ---------------- 1056 -- Initialize -- 1057 ---------------- 1058 1059 procedure Initialize (Object : in out Unbounded_String) is 1060 begin 1061 Reference (Object.Reference); 1062 end Initialize; 1063 1064 ------------ 1065 -- Insert -- 1066 ------------ 1067 1068 function Insert 1069 (Source : Unbounded_String; 1070 Before : Positive; 1071 New_Item : String) return Unbounded_String 1072 is 1073 SR : constant Shared_String_Access := Source.Reference; 1074 DL : constant Natural := SR.Last + New_Item'Length; 1075 DR : Shared_String_Access; 1076 1077 begin 1078 -- Check index first 1079 1080 if Before > SR.Last + 1 then 1081 raise Index_Error; 1082 end if; 1083 1084 -- Result is empty, reuse empty shared string 1085 1086 if DL = 0 then 1087 Reference (Empty_Shared_String'Access); 1088 DR := Empty_Shared_String'Access; 1089 1090 -- Inserted string is empty, reuse source shared string 1091 1092 elsif New_Item'Length = 0 then 1093 Reference (SR); 1094 DR := SR; 1095 1096 -- Otherwise, allocate new shared string and fill it 1097 1098 else 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); 1104 DR.Last := DL; 1105 end if; 1106 1107 return (AF.Controlled with Reference => DR); 1108 end Insert; 1109 1110 procedure Insert 1111 (Source : in out Unbounded_String; 1112 Before : Positive; 1113 New_Item : String) 1114 is 1115 SR : constant Shared_String_Access := Source.Reference; 1116 DL : constant Natural := SR.Last + New_Item'Length; 1117 DR : Shared_String_Access; 1118 1119 begin 1120 -- Check bounds 1121 1122 if Before > SR.Last + 1 then 1123 raise Index_Error; 1124 end if; 1125 1126 -- Result is empty string, reuse empty shared string 1127 1128 if DL = 0 then 1129 Reference (Empty_Shared_String'Access); 1130 Source.Reference := Empty_Shared_String'Access; 1131 Unreference (SR); 1132 1133 -- Inserted string is empty, nothing to do 1134 1135 elsif New_Item'Length = 0 then 1136 null; 1137 1138 -- Try to reuse existing shared string first 1139 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; 1144 SR.Last := DL; 1145 1146 -- Otherwise, allocate new shared string and fill it 1147 1148 else 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); 1154 DR.Last := DL; 1155 Source.Reference := DR; 1156 Unreference (SR); 1157 end if; 1158 end Insert; 1159 1160 ------------ 1161 -- Length -- 1162 ------------ 1163 1164 function Length (Source : Unbounded_String) return Natural is 1165 begin 1166 return Source.Reference.Last; 1167 end Length; 1168 1169 --------------- 1170 -- Overwrite -- 1171 --------------- 1172 1173 function Overwrite 1174 (Source : Unbounded_String; 1175 Position : Positive; 1176 New_Item : String) return Unbounded_String 1177 is 1178 SR : constant Shared_String_Access := Source.Reference; 1179 DL : Natural; 1180 DR : Shared_String_Access; 1181 1182 begin 1183 -- Check bounds 1184 1185 if Position > SR.Last + 1 then 1186 raise Index_Error; 1187 end if; 1188 1189 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1); 1190 1191 -- Result is empty string, reuse empty shared string 1192 1193 if DL = 0 then 1194 Reference (Empty_Shared_String'Access); 1195 DR := Empty_Shared_String'Access; 1196 1197 -- Result is same as source string, reuse source shared string 1198 1199 elsif New_Item'Length = 0 then 1200 Reference (SR); 1201 DR := SR; 1202 1203 -- Otherwise, allocate new shared string and fill it 1204 1205 else 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); 1211 DR.Last := DL; 1212 end if; 1213 1214 return (AF.Controlled with Reference => DR); 1215 end Overwrite; 1216 1217 procedure Overwrite 1218 (Source : in out Unbounded_String; 1219 Position : Positive; 1220 New_Item : String) 1221 is 1222 SR : constant Shared_String_Access := Source.Reference; 1223 DL : Natural; 1224 DR : Shared_String_Access; 1225 1226 begin 1227 -- Bounds check 1228 1229 if Position > SR.Last + 1 then 1230 raise Index_Error; 1231 end if; 1232 1233 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1); 1234 1235 -- Result is empty string, reuse empty shared string 1236 1237 if DL = 0 then 1238 Reference (Empty_Shared_String'Access); 1239 Source.Reference := Empty_Shared_String'Access; 1240 Unreference (SR); 1241 1242 -- String unchanged, nothing to do 1243 1244 elsif New_Item'Length = 0 then 1245 null; 1246 1247 -- Try to reuse existing shared string 1248 1249 elsif Can_Be_Reused (SR, DL) then 1250 SR.Data (Position .. Position + New_Item'Length - 1) := New_Item; 1251 SR.Last := DL; 1252 1253 -- Otherwise allocate new shared string and fill it 1254 1255 else 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); 1261 DR.Last := DL; 1262 Source.Reference := DR; 1263 Unreference (SR); 1264 end if; 1265 end Overwrite; 1266 1267 --------------- 1268 -- Reference -- 1269 --------------- 1270 1271 procedure Reference (Item : not null Shared_String_Access) is 1272 begin 1273 System.Atomic_Counters.Increment (Item.Counter); 1274 end Reference; 1275 1276 --------------------- 1277 -- Replace_Element -- 1278 --------------------- 1279 1280 procedure Replace_Element 1281 (Source : in out Unbounded_String; 1282 Index : Positive; 1283 By : Character) 1284 is 1285 SR : constant Shared_String_Access := Source.Reference; 1286 DR : Shared_String_Access; 1287 1288 begin 1289 -- Bounds check 1290 1291 if Index <= SR.Last then 1292 1293 -- Try to reuse existing shared string 1294 1295 if Can_Be_Reused (SR, SR.Last) then 1296 SR.Data (Index) := By; 1297 1298 -- Otherwise allocate new shared string and fill it 1299 1300 else 1301 DR := Allocate (SR.Last); 1302 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 1303 DR.Data (Index) := By; 1304 DR.Last := SR.Last; 1305 Source.Reference := DR; 1306 Unreference (SR); 1307 end if; 1308 1309 else 1310 raise Index_Error; 1311 end if; 1312 end Replace_Element; 1313 1314 ------------------- 1315 -- Replace_Slice -- 1316 ------------------- 1317 1318 function Replace_Slice 1319 (Source : Unbounded_String; 1320 Low : Positive; 1321 High : Natural; 1322 By : String) return Unbounded_String 1323 is 1324 SR : constant Shared_String_Access := Source.Reference; 1325 DL : Natural; 1326 DR : Shared_String_Access; 1327 1328 begin 1329 -- Check bounds 1330 1331 if Low > SR.Last + 1 then 1332 raise Index_Error; 1333 end if; 1334 1335 -- Do replace operation when removed slice is not empty 1336 1337 if High >= Low then 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. 1341 1342 -- Result is empty string, reuse empty shared string 1343 1344 if DL = 0 then 1345 Reference (Empty_Shared_String'Access); 1346 DR := Empty_Shared_String'Access; 1347 1348 -- Otherwise allocate new shared string and fill it 1349 1350 else 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); 1355 DR.Last := DL; 1356 end if; 1357 1358 return (AF.Controlled with Reference => DR); 1359 1360 -- Otherwise just insert string 1361 1362 else 1363 return Insert (Source, Low, By); 1364 end if; 1365 end Replace_Slice; 1366 1367 procedure Replace_Slice 1368 (Source : in out Unbounded_String; 1369 Low : Positive; 1370 High : Natural; 1371 By : String) 1372 is 1373 SR : constant Shared_String_Access := Source.Reference; 1374 DL : Natural; 1375 DR : Shared_String_Access; 1376 1377 begin 1378 -- Bounds check 1379 1380 if Low > SR.Last + 1 then 1381 raise Index_Error; 1382 end if; 1383 1384 -- Do replace operation only when replaced slice is not empty 1385 1386 if High >= Low then 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. 1390 1391 -- Result is empty string, reuse empty shared string 1392 1393 if DL = 0 then 1394 Reference (Empty_Shared_String'Access); 1395 Source.Reference := Empty_Shared_String'Access; 1396 Unreference (SR); 1397 1398 -- Try to reuse existing shared string 1399 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; 1403 SR.Last := DL; 1404 1405 -- Otherwise allocate new shared string and fill it 1406 1407 else 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); 1412 DR.Last := DL; 1413 Source.Reference := DR; 1414 Unreference (SR); 1415 end if; 1416 1417 -- Otherwise just insert item 1418 1419 else 1420 Insert (Source, Low, By); 1421 end if; 1422 end Replace_Slice; 1423 1424 -------------------------- 1425 -- Set_Unbounded_String -- 1426 -------------------------- 1427 1428 procedure Set_Unbounded_String 1429 (Target : out Unbounded_String; 1430 Source : String) 1431 is 1432 TR : constant Shared_String_Access := Target.Reference; 1433 DR : Shared_String_Access; 1434 1435 begin 1436 -- In case of empty string, reuse empty shared string 1437 1438 if Source'Length = 0 then 1439 Reference (Empty_Shared_String'Access); 1440 Target.Reference := Empty_Shared_String'Access; 1441 1442 else 1443 -- Try to reuse existing shared string 1444 1445 if Can_Be_Reused (TR, Source'Length) then 1446 Reference (TR); 1447 DR := TR; 1448 1449 -- Otherwise allocate new shared string 1450 1451 else 1452 DR := Allocate (Source'Length); 1453 Target.Reference := DR; 1454 end if; 1455 1456 DR.Data (1 .. Source'Length) := Source; 1457 DR.Last := Source'Length; 1458 end if; 1459 1460 Unreference (TR); 1461 end Set_Unbounded_String; 1462 1463 ----------- 1464 -- Slice -- 1465 ----------- 1466 1467 function Slice 1468 (Source : Unbounded_String; 1469 Low : Positive; 1470 High : Natural) return String 1471 is 1472 SR : constant Shared_String_Access := Source.Reference; 1473 1474 begin 1475 -- Note: test of High > Length is in accordance with AI95-00128 1476 1477 if Low > SR.Last + 1 or else High > SR.Last then 1478 raise Index_Error; 1479 1480 else 1481 return SR.Data (Low .. High); 1482 end if; 1483 end Slice; 1484 1485 ---------- 1486 -- Tail -- 1487 ---------- 1488 1489 function Tail 1490 (Source : Unbounded_String; 1491 Count : Natural; 1492 Pad : Character := Space) return Unbounded_String 1493 is 1494 SR : constant Shared_String_Access := Source.Reference; 1495 DR : Shared_String_Access; 1496 1497 begin 1498 -- For empty result reuse empty shared string 1499 1500 if Count = 0 then 1501 Reference (Empty_Shared_String'Access); 1502 DR := Empty_Shared_String'Access; 1503 1504 -- Result is whole source string, reuse source shared string 1505 1506 elsif Count = SR.Last then 1507 Reference (SR); 1508 DR := SR; 1509 1510 -- Otherwise allocate new shared string and fill it 1511 1512 else 1513 DR := Allocate (Count); 1514 1515 if Count < SR.Last then 1516 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last); 1517 1518 else 1519 for J in 1 .. Count - SR.Last loop 1520 DR.Data (J) := Pad; 1521 end loop; 1522 1523 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last); 1524 end if; 1525 1526 DR.Last := Count; 1527 end if; 1528 1529 return (AF.Controlled with Reference => DR); 1530 end Tail; 1531 1532 procedure Tail 1533 (Source : in out Unbounded_String; 1534 Count : Natural; 1535 Pad : Character := Space) 1536 is 1537 SR : constant Shared_String_Access := Source.Reference; 1538 DR : Shared_String_Access; 1539 1540 procedure Common 1541 (SR : Shared_String_Access; 1542 DR : Shared_String_Access; 1543 Count : Natural); 1544 -- Common code of tail computation. SR/DR can point to the same object 1545 1546 ------------ 1547 -- Common -- 1548 ------------ 1549 1550 procedure Common 1551 (SR : Shared_String_Access; 1552 DR : Shared_String_Access; 1553 Count : Natural) is 1554 begin 1555 if Count < SR.Last then 1556 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last); 1557 1558 else 1559 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last); 1560 1561 for J in 1 .. Count - SR.Last loop 1562 DR.Data (J) := Pad; 1563 end loop; 1564 end if; 1565 1566 DR.Last := Count; 1567 end Common; 1568 1569 begin 1570 -- Result is empty string, reuse empty shared string 1571 1572 if Count = 0 then 1573 Reference (Empty_Shared_String'Access); 1574 Source.Reference := Empty_Shared_String'Access; 1575 Unreference (SR); 1576 1577 -- Length of the result is the same as length of the source string, 1578 -- reuse source shared string. 1579 1580 elsif Count = SR.Last then 1581 null; 1582 1583 -- Try to reuse existing shared string 1584 1585 elsif Can_Be_Reused (SR, Count) then 1586 Common (SR, SR, Count); 1587 1588 -- Otherwise allocate new shared string and fill it 1589 1590 else 1591 DR := Allocate (Count); 1592 Common (SR, DR, Count); 1593 Source.Reference := DR; 1594 Unreference (SR); 1595 end if; 1596 end Tail; 1597 1598 --------------- 1599 -- To_String -- 1600 --------------- 1601 1602 function To_String (Source : Unbounded_String) return String is 1603 begin 1604 return Source.Reference.Data (1 .. Source.Reference.Last); 1605 end To_String; 1606 1607 ------------------------- 1608 -- To_Unbounded_String -- 1609 ------------------------- 1610 1611 function To_Unbounded_String (Source : String) return Unbounded_String is 1612 DR : Shared_String_Access; 1613 1614 begin 1615 if Source'Length = 0 then 1616 Reference (Empty_Shared_String'Access); 1617 DR := Empty_Shared_String'Access; 1618 1619 else 1620 DR := Allocate (Source'Length); 1621 DR.Data (1 .. Source'Length) := Source; 1622 DR.Last := Source'Length; 1623 end if; 1624 1625 return (AF.Controlled with Reference => DR); 1626 end To_Unbounded_String; 1627 1628 function To_Unbounded_String (Length : Natural) return Unbounded_String is 1629 DR : Shared_String_Access; 1630 1631 begin 1632 if Length = 0 then 1633 Reference (Empty_Shared_String'Access); 1634 DR := Empty_Shared_String'Access; 1635 1636 else 1637 DR := Allocate (Length); 1638 DR.Last := Length; 1639 end if; 1640 1641 return (AF.Controlled with Reference => DR); 1642 end To_Unbounded_String; 1643 1644 --------------- 1645 -- Translate -- 1646 --------------- 1647 1648 function Translate 1649 (Source : Unbounded_String; 1650 Mapping : Maps.Character_Mapping) return Unbounded_String 1651 is 1652 SR : constant Shared_String_Access := Source.Reference; 1653 DR : Shared_String_Access; 1654 1655 begin 1656 -- Nothing to translate, reuse empty shared string 1657 1658 if SR.Last = 0 then 1659 Reference (Empty_Shared_String'Access); 1660 DR := Empty_Shared_String'Access; 1661 1662 -- Otherwise, allocate new shared string and fill it 1663 1664 else 1665 DR := Allocate (SR.Last); 1666 1667 for J in 1 .. SR.Last loop 1668 DR.Data (J) := Value (Mapping, SR.Data (J)); 1669 end loop; 1670 1671 DR.Last := SR.Last; 1672 end if; 1673 1674 return (AF.Controlled with Reference => DR); 1675 end Translate; 1676 1677 procedure Translate 1678 (Source : in out Unbounded_String; 1679 Mapping : Maps.Character_Mapping) 1680 is 1681 SR : constant Shared_String_Access := Source.Reference; 1682 DR : Shared_String_Access; 1683 1684 begin 1685 -- Nothing to translate 1686 1687 if SR.Last = 0 then 1688 null; 1689 1690 -- Try to reuse shared string 1691 1692 elsif Can_Be_Reused (SR, SR.Last) then 1693 for J in 1 .. SR.Last loop 1694 SR.Data (J) := Value (Mapping, SR.Data (J)); 1695 end loop; 1696 1697 -- Otherwise, allocate new shared string 1698 1699 else 1700 DR := Allocate (SR.Last); 1701 1702 for J in 1 .. SR.Last loop 1703 DR.Data (J) := Value (Mapping, SR.Data (J)); 1704 end loop; 1705 1706 DR.Last := SR.Last; 1707 Source.Reference := DR; 1708 Unreference (SR); 1709 end if; 1710 end Translate; 1711 1712 function Translate 1713 (Source : Unbounded_String; 1714 Mapping : Maps.Character_Mapping_Function) return Unbounded_String 1715 is 1716 SR : constant Shared_String_Access := Source.Reference; 1717 DR : Shared_String_Access; 1718 1719 begin 1720 -- Nothing to translate, reuse empty shared string 1721 1722 if SR.Last = 0 then 1723 Reference (Empty_Shared_String'Access); 1724 DR := Empty_Shared_String'Access; 1725 1726 -- Otherwise, allocate new shared string and fill it 1727 1728 else 1729 DR := Allocate (SR.Last); 1730 1731 for J in 1 .. SR.Last loop 1732 DR.Data (J) := Mapping.all (SR.Data (J)); 1733 end loop; 1734 1735 DR.Last := SR.Last; 1736 end if; 1737 1738 return (AF.Controlled with Reference => DR); 1739 1740 exception 1741 when others => 1742 Unreference (DR); 1743 1744 raise; 1745 end Translate; 1746 1747 procedure Translate 1748 (Source : in out Unbounded_String; 1749 Mapping : Maps.Character_Mapping_Function) 1750 is 1751 SR : constant Shared_String_Access := Source.Reference; 1752 DR : Shared_String_Access; 1753 1754 begin 1755 -- Nothing to translate 1756 1757 if SR.Last = 0 then 1758 null; 1759 1760 -- Try to reuse shared string 1761 1762 elsif Can_Be_Reused (SR, SR.Last) then 1763 for J in 1 .. SR.Last loop 1764 SR.Data (J) := Mapping.all (SR.Data (J)); 1765 end loop; 1766 1767 -- Otherwise allocate new shared string and fill it 1768 1769 else 1770 DR := Allocate (SR.Last); 1771 1772 for J in 1 .. SR.Last loop 1773 DR.Data (J) := Mapping.all (SR.Data (J)); 1774 end loop; 1775 1776 DR.Last := SR.Last; 1777 Source.Reference := DR; 1778 Unreference (SR); 1779 end if; 1780 1781 exception 1782 when others => 1783 if DR /= null then 1784 Unreference (DR); 1785 end if; 1786 1787 raise; 1788 end Translate; 1789 1790 ---------- 1791 -- Trim -- 1792 ---------- 1793 1794 function Trim 1795 (Source : Unbounded_String; 1796 Side : Trim_End) return Unbounded_String 1797 is 1798 SR : constant Shared_String_Access := Source.Reference; 1799 DL : Natural; 1800 DR : Shared_String_Access; 1801 Low : Natural; 1802 High : Natural; 1803 1804 begin 1805 Low := Index_Non_Blank (Source, Forward); 1806 1807 -- All blanks, reuse empty shared string 1808 1809 if Low = 0 then 1810 Reference (Empty_Shared_String'Access); 1811 DR := Empty_Shared_String'Access; 1812 1813 else 1814 case Side is 1815 when Left => 1816 High := SR.Last; 1817 DL := SR.Last - Low + 1; 1818 1819 when Right => 1820 Low := 1; 1821 High := Index_Non_Blank (Source, Backward); 1822 DL := High; 1823 1824 when Both => 1825 High := Index_Non_Blank (Source, Backward); 1826 DL := High - Low + 1; 1827 end case; 1828 1829 -- Length of the result is the same as length of the source string, 1830 -- reuse source shared string. 1831 1832 if DL = SR.Last then 1833 Reference (SR); 1834 DR := SR; 1835 1836 -- Otherwise, allocate new shared string 1837 1838 else 1839 DR := Allocate (DL); 1840 DR.Data (1 .. DL) := SR.Data (Low .. High); 1841 DR.Last := DL; 1842 end if; 1843 end if; 1844 1845 return (AF.Controlled with Reference => DR); 1846 end Trim; 1847 1848 procedure Trim 1849 (Source : in out Unbounded_String; 1850 Side : Trim_End) 1851 is 1852 SR : constant Shared_String_Access := Source.Reference; 1853 DL : Natural; 1854 DR : Shared_String_Access; 1855 Low : Natural; 1856 High : Natural; 1857 1858 begin 1859 Low := Index_Non_Blank (Source, Forward); 1860 1861 -- All blanks, reuse empty shared string 1862 1863 if Low = 0 then 1864 Reference (Empty_Shared_String'Access); 1865 Source.Reference := Empty_Shared_String'Access; 1866 Unreference (SR); 1867 1868 else 1869 case Side is 1870 when Left => 1871 High := SR.Last; 1872 DL := SR.Last - Low + 1; 1873 1874 when Right => 1875 Low := 1; 1876 High := Index_Non_Blank (Source, Backward); 1877 DL := High; 1878 1879 when Both => 1880 High := Index_Non_Blank (Source, Backward); 1881 DL := High - Low + 1; 1882 end case; 1883 1884 -- Length of the result is the same as length of the source string, 1885 -- nothing to do. 1886 1887 if DL = SR.Last then 1888 null; 1889 1890 -- Try to reuse existing shared string 1891 1892 elsif Can_Be_Reused (SR, DL) then 1893 SR.Data (1 .. DL) := SR.Data (Low .. High); 1894 SR.Last := DL; 1895 1896 -- Otherwise, allocate new shared string 1897 1898 else 1899 DR := Allocate (DL); 1900 DR.Data (1 .. DL) := SR.Data (Low .. High); 1901 DR.Last := DL; 1902 Source.Reference := DR; 1903 Unreference (SR); 1904 end if; 1905 end if; 1906 end Trim; 1907 1908 function Trim 1909 (Source : Unbounded_String; 1910 Left : Maps.Character_Set; 1911 Right : Maps.Character_Set) return Unbounded_String 1912 is 1913 SR : constant Shared_String_Access := Source.Reference; 1914 DL : Natural; 1915 DR : Shared_String_Access; 1916 Low : Natural; 1917 High : Natural; 1918 1919 begin 1920 Low := Index (Source, Left, Outside, Forward); 1921 1922 -- Source includes only characters from Left set, reuse empty shared 1923 -- string. 1924 1925 if Low = 0 then 1926 Reference (Empty_Shared_String'Access); 1927 DR := Empty_Shared_String'Access; 1928 1929 else 1930 High := Index (Source, Right, Outside, Backward); 1931 DL := Integer'Max (0, High - Low + 1); 1932 1933 -- Source includes only characters from Right set or result string 1934 -- is empty, reuse empty shared string. 1935 1936 if High = 0 or else DL = 0 then 1937 Reference (Empty_Shared_String'Access); 1938 DR := Empty_Shared_String'Access; 1939 1940 -- Otherwise, allocate new shared string and fill it 1941 1942 else 1943 DR := Allocate (DL); 1944 DR.Data (1 .. DL) := SR.Data (Low .. High); 1945 DR.Last := DL; 1946 end if; 1947 end if; 1948 1949 return (AF.Controlled with Reference => DR); 1950 end Trim; 1951 1952 procedure Trim 1953 (Source : in out Unbounded_String; 1954 Left : Maps.Character_Set; 1955 Right : Maps.Character_Set) 1956 is 1957 SR : constant Shared_String_Access := Source.Reference; 1958 DL : Natural; 1959 DR : Shared_String_Access; 1960 Low : Natural; 1961 High : Natural; 1962 1963 begin 1964 Low := Index (Source, Left, Outside, Forward); 1965 1966 -- Source includes only characters from Left set, reuse empty shared 1967 -- string. 1968 1969 if Low = 0 then 1970 Reference (Empty_Shared_String'Access); 1971 Source.Reference := Empty_Shared_String'Access; 1972 Unreference (SR); 1973 1974 else 1975 High := Index (Source, Right, Outside, Backward); 1976 DL := Integer'Max (0, High - Low + 1); 1977 1978 -- Source includes only characters from Right set or result string 1979 -- is empty, reuse empty shared string. 1980 1981 if High = 0 or else DL = 0 then 1982 Reference (Empty_Shared_String'Access); 1983 Source.Reference := Empty_Shared_String'Access; 1984 Unreference (SR); 1985 1986 -- Try to reuse existing shared string 1987 1988 elsif Can_Be_Reused (SR, DL) then 1989 SR.Data (1 .. DL) := SR.Data (Low .. High); 1990 SR.Last := DL; 1991 1992 -- Otherwise, allocate new shared string and fill it 1993 1994 else 1995 DR := Allocate (DL); 1996 DR.Data (1 .. DL) := SR.Data (Low .. High); 1997 DR.Last := DL; 1998 Source.Reference := DR; 1999 Unreference (SR); 2000 end if; 2001 end if; 2002 end Trim; 2003 2004 --------------------- 2005 -- Unbounded_Slice -- 2006 --------------------- 2007 2008 function Unbounded_Slice 2009 (Source : Unbounded_String; 2010 Low : Positive; 2011 High : Natural) return Unbounded_String 2012 is 2013 SR : constant Shared_String_Access := Source.Reference; 2014 DL : Natural; 2015 DR : Shared_String_Access; 2016 2017 begin 2018 -- Check bounds 2019 2020 if Low > SR.Last + 1 or else High > SR.Last then 2021 raise Index_Error; 2022 2023 -- Result is empty slice, reuse empty shared string 2024 2025 elsif Low > High then 2026 Reference (Empty_Shared_String'Access); 2027 DR := Empty_Shared_String'Access; 2028 2029 -- Otherwise, allocate new shared string and fill it 2030 2031 else 2032 DL := High - Low + 1; 2033 DR := Allocate (DL); 2034 DR.Data (1 .. DL) := SR.Data (Low .. High); 2035 DR.Last := DL; 2036 end if; 2037 2038 return (AF.Controlled with Reference => DR); 2039 end Unbounded_Slice; 2040 2041 procedure Unbounded_Slice 2042 (Source : Unbounded_String; 2043 Target : out Unbounded_String; 2044 Low : Positive; 2045 High : Natural) 2046 is 2047 SR : constant Shared_String_Access := Source.Reference; 2048 TR : constant Shared_String_Access := Target.Reference; 2049 DL : Natural; 2050 DR : Shared_String_Access; 2051 2052 begin 2053 -- Check bounds 2054 2055 if Low > SR.Last + 1 or else High > SR.Last then 2056 raise Index_Error; 2057 2058 -- Result is empty slice, reuse empty shared string 2059 2060 elsif Low > High then 2061 Reference (Empty_Shared_String'Access); 2062 Target.Reference := Empty_Shared_String'Access; 2063 Unreference (TR); 2064 2065 else 2066 DL := High - Low + 1; 2067 2068 -- Try to reuse existing shared string 2069 2070 if Can_Be_Reused (TR, DL) then 2071 TR.Data (1 .. DL) := SR.Data (Low .. High); 2072 TR.Last := DL; 2073 2074 -- Otherwise, allocate new shared string and fill it 2075 2076 else 2077 DR := Allocate (DL); 2078 DR.Data (1 .. DL) := SR.Data (Low .. High); 2079 DR.Last := DL; 2080 Target.Reference := DR; 2081 Unreference (TR); 2082 end if; 2083 end if; 2084 end Unbounded_Slice; 2085 2086 ----------------- 2087 -- Unreference -- 2088 ----------------- 2089 2090 procedure Unreference (Item : not null Shared_String_Access) is 2091 2092 procedure Free is 2093 new Ada.Unchecked_Deallocation (Shared_String, Shared_String_Access); 2094 2095 Aux : Shared_String_Access := Item; 2096 2097 begin 2098 if System.Atomic_Counters.Decrement (Aux.Counter) then 2099 2100 -- Reference counter of Empty_Shared_String must never reach zero 2101 2102 pragma Assert (Aux /= Empty_Shared_String'Access); 2103 2104 Free (Aux); 2105 end if; 2106 end Unreference; 2107 2108end Ada.Strings.Unbounded; 2109