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-2012, 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 (LR.Last + RR.Last); 95 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last); 96 DR.Data (LR.Last + 1 .. DL) := RR.Data (1 .. RR.Last); 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 : constant Shared_String_Access := Allocate (Source'Length); 1613 begin 1614 DR.Data (1 .. Source'Length) := Source; 1615 DR.Last := Source'Length; 1616 return (AF.Controlled with Reference => DR); 1617 end To_Unbounded_String; 1618 1619 function To_Unbounded_String (Length : Natural) return Unbounded_String is 1620 DR : constant Shared_String_Access := Allocate (Length); 1621 begin 1622 DR.Last := Length; 1623 return (AF.Controlled with Reference => DR); 1624 end To_Unbounded_String; 1625 1626 --------------- 1627 -- Translate -- 1628 --------------- 1629 1630 function Translate 1631 (Source : Unbounded_String; 1632 Mapping : Maps.Character_Mapping) return Unbounded_String 1633 is 1634 SR : constant Shared_String_Access := Source.Reference; 1635 DR : Shared_String_Access; 1636 1637 begin 1638 -- Nothing to translate, reuse empty shared string 1639 1640 if SR.Last = 0 then 1641 Reference (Empty_Shared_String'Access); 1642 DR := Empty_Shared_String'Access; 1643 1644 -- Otherwise, allocate new shared string and fill it 1645 1646 else 1647 DR := Allocate (SR.Last); 1648 1649 for J in 1 .. SR.Last loop 1650 DR.Data (J) := Value (Mapping, SR.Data (J)); 1651 end loop; 1652 1653 DR.Last := SR.Last; 1654 end if; 1655 1656 return (AF.Controlled with Reference => DR); 1657 end Translate; 1658 1659 procedure Translate 1660 (Source : in out Unbounded_String; 1661 Mapping : Maps.Character_Mapping) 1662 is 1663 SR : constant Shared_String_Access := Source.Reference; 1664 DR : Shared_String_Access; 1665 1666 begin 1667 -- Nothing to translate 1668 1669 if SR.Last = 0 then 1670 null; 1671 1672 -- Try to reuse shared string 1673 1674 elsif Can_Be_Reused (SR, SR.Last) then 1675 for J in 1 .. SR.Last loop 1676 SR.Data (J) := Value (Mapping, SR.Data (J)); 1677 end loop; 1678 1679 -- Otherwise, allocate new shared string 1680 1681 else 1682 DR := Allocate (SR.Last); 1683 1684 for J in 1 .. SR.Last loop 1685 DR.Data (J) := Value (Mapping, SR.Data (J)); 1686 end loop; 1687 1688 DR.Last := SR.Last; 1689 Source.Reference := DR; 1690 Unreference (SR); 1691 end if; 1692 end Translate; 1693 1694 function Translate 1695 (Source : Unbounded_String; 1696 Mapping : Maps.Character_Mapping_Function) return Unbounded_String 1697 is 1698 SR : constant Shared_String_Access := Source.Reference; 1699 DR : Shared_String_Access; 1700 1701 begin 1702 -- Nothing to translate, reuse empty shared string 1703 1704 if SR.Last = 0 then 1705 Reference (Empty_Shared_String'Access); 1706 DR := Empty_Shared_String'Access; 1707 1708 -- Otherwise, allocate new shared string and fill it 1709 1710 else 1711 DR := Allocate (SR.Last); 1712 1713 for J in 1 .. SR.Last loop 1714 DR.Data (J) := Mapping.all (SR.Data (J)); 1715 end loop; 1716 1717 DR.Last := SR.Last; 1718 end if; 1719 1720 return (AF.Controlled with Reference => DR); 1721 1722 exception 1723 when others => 1724 Unreference (DR); 1725 1726 raise; 1727 end Translate; 1728 1729 procedure Translate 1730 (Source : in out Unbounded_String; 1731 Mapping : Maps.Character_Mapping_Function) 1732 is 1733 SR : constant Shared_String_Access := Source.Reference; 1734 DR : Shared_String_Access; 1735 1736 begin 1737 -- Nothing to translate 1738 1739 if SR.Last = 0 then 1740 null; 1741 1742 -- Try to reuse shared string 1743 1744 elsif Can_Be_Reused (SR, SR.Last) then 1745 for J in 1 .. SR.Last loop 1746 SR.Data (J) := Mapping.all (SR.Data (J)); 1747 end loop; 1748 1749 -- Otherwise allocate new shared string and fill it 1750 1751 else 1752 DR := Allocate (SR.Last); 1753 1754 for J in 1 .. SR.Last loop 1755 DR.Data (J) := Mapping.all (SR.Data (J)); 1756 end loop; 1757 1758 DR.Last := SR.Last; 1759 Source.Reference := DR; 1760 Unreference (SR); 1761 end if; 1762 1763 exception 1764 when others => 1765 if DR /= null then 1766 Unreference (DR); 1767 end if; 1768 1769 raise; 1770 end Translate; 1771 1772 ---------- 1773 -- Trim -- 1774 ---------- 1775 1776 function Trim 1777 (Source : Unbounded_String; 1778 Side : Trim_End) return Unbounded_String 1779 is 1780 SR : constant Shared_String_Access := Source.Reference; 1781 DL : Natural; 1782 DR : Shared_String_Access; 1783 Low : Natural; 1784 High : Natural; 1785 1786 begin 1787 Low := Index_Non_Blank (Source, Forward); 1788 1789 -- All blanks, reuse empty shared string 1790 1791 if Low = 0 then 1792 Reference (Empty_Shared_String'Access); 1793 DR := Empty_Shared_String'Access; 1794 1795 else 1796 case Side is 1797 when Left => 1798 High := SR.Last; 1799 DL := SR.Last - Low + 1; 1800 1801 when Right => 1802 Low := 1; 1803 High := Index_Non_Blank (Source, Backward); 1804 DL := High; 1805 1806 when Both => 1807 High := Index_Non_Blank (Source, Backward); 1808 DL := High - Low + 1; 1809 end case; 1810 1811 -- Length of the result is the same as length of the source string, 1812 -- reuse source shared string. 1813 1814 if DL = SR.Last then 1815 Reference (SR); 1816 DR := SR; 1817 1818 -- Otherwise, allocate new shared string 1819 1820 else 1821 DR := Allocate (DL); 1822 DR.Data (1 .. DL) := SR.Data (Low .. High); 1823 DR.Last := DL; 1824 end if; 1825 end if; 1826 1827 return (AF.Controlled with Reference => DR); 1828 end Trim; 1829 1830 procedure Trim 1831 (Source : in out Unbounded_String; 1832 Side : Trim_End) 1833 is 1834 SR : constant Shared_String_Access := Source.Reference; 1835 DL : Natural; 1836 DR : Shared_String_Access; 1837 Low : Natural; 1838 High : Natural; 1839 1840 begin 1841 Low := Index_Non_Blank (Source, Forward); 1842 1843 -- All blanks, reuse empty shared string 1844 1845 if Low = 0 then 1846 Reference (Empty_Shared_String'Access); 1847 Source.Reference := Empty_Shared_String'Access; 1848 Unreference (SR); 1849 1850 else 1851 case Side is 1852 when Left => 1853 High := SR.Last; 1854 DL := SR.Last - Low + 1; 1855 1856 when Right => 1857 Low := 1; 1858 High := Index_Non_Blank (Source, Backward); 1859 DL := High; 1860 1861 when Both => 1862 High := Index_Non_Blank (Source, Backward); 1863 DL := High - Low + 1; 1864 end case; 1865 1866 -- Length of the result is the same as length of the source string, 1867 -- nothing to do. 1868 1869 if DL = SR.Last then 1870 null; 1871 1872 -- Try to reuse existing shared string 1873 1874 elsif Can_Be_Reused (SR, DL) then 1875 SR.Data (1 .. DL) := SR.Data (Low .. High); 1876 SR.Last := DL; 1877 1878 -- Otherwise, allocate new shared string 1879 1880 else 1881 DR := Allocate (DL); 1882 DR.Data (1 .. DL) := SR.Data (Low .. High); 1883 DR.Last := DL; 1884 Source.Reference := DR; 1885 Unreference (SR); 1886 end if; 1887 end if; 1888 end Trim; 1889 1890 function Trim 1891 (Source : Unbounded_String; 1892 Left : Maps.Character_Set; 1893 Right : Maps.Character_Set) return Unbounded_String 1894 is 1895 SR : constant Shared_String_Access := Source.Reference; 1896 DL : Natural; 1897 DR : Shared_String_Access; 1898 Low : Natural; 1899 High : Natural; 1900 1901 begin 1902 Low := Index (Source, Left, Outside, Forward); 1903 1904 -- Source includes only characters from Left set, reuse empty shared 1905 -- string. 1906 1907 if Low = 0 then 1908 Reference (Empty_Shared_String'Access); 1909 DR := Empty_Shared_String'Access; 1910 1911 else 1912 High := Index (Source, Right, Outside, Backward); 1913 DL := Integer'Max (0, High - Low + 1); 1914 1915 -- Source includes only characters from Right set or result string 1916 -- is empty, reuse empty shared string. 1917 1918 if High = 0 or else DL = 0 then 1919 Reference (Empty_Shared_String'Access); 1920 DR := Empty_Shared_String'Access; 1921 1922 -- Otherwise, allocate new shared string and fill it 1923 1924 else 1925 DR := Allocate (DL); 1926 DR.Data (1 .. DL) := SR.Data (Low .. High); 1927 DR.Last := DL; 1928 end if; 1929 end if; 1930 1931 return (AF.Controlled with Reference => DR); 1932 end Trim; 1933 1934 procedure Trim 1935 (Source : in out Unbounded_String; 1936 Left : Maps.Character_Set; 1937 Right : Maps.Character_Set) 1938 is 1939 SR : constant Shared_String_Access := Source.Reference; 1940 DL : Natural; 1941 DR : Shared_String_Access; 1942 Low : Natural; 1943 High : Natural; 1944 1945 begin 1946 Low := Index (Source, Left, Outside, Forward); 1947 1948 -- Source includes only characters from Left set, reuse empty shared 1949 -- string. 1950 1951 if Low = 0 then 1952 Reference (Empty_Shared_String'Access); 1953 Source.Reference := Empty_Shared_String'Access; 1954 Unreference (SR); 1955 1956 else 1957 High := Index (Source, Right, Outside, Backward); 1958 DL := Integer'Max (0, High - Low + 1); 1959 1960 -- Source includes only characters from Right set or result string 1961 -- is empty, reuse empty shared string. 1962 1963 if High = 0 or else DL = 0 then 1964 Reference (Empty_Shared_String'Access); 1965 Source.Reference := Empty_Shared_String'Access; 1966 Unreference (SR); 1967 1968 -- Try to reuse existing shared string 1969 1970 elsif Can_Be_Reused (SR, DL) then 1971 SR.Data (1 .. DL) := SR.Data (Low .. High); 1972 SR.Last := DL; 1973 1974 -- Otherwise, allocate new shared string and fill it 1975 1976 else 1977 DR := Allocate (DL); 1978 DR.Data (1 .. DL) := SR.Data (Low .. High); 1979 DR.Last := DL; 1980 Source.Reference := DR; 1981 Unreference (SR); 1982 end if; 1983 end if; 1984 end Trim; 1985 1986 --------------------- 1987 -- Unbounded_Slice -- 1988 --------------------- 1989 1990 function Unbounded_Slice 1991 (Source : Unbounded_String; 1992 Low : Positive; 1993 High : Natural) return Unbounded_String 1994 is 1995 SR : constant Shared_String_Access := Source.Reference; 1996 DL : Natural; 1997 DR : Shared_String_Access; 1998 1999 begin 2000 -- Check bounds 2001 2002 if Low > SR.Last + 1 or else High > SR.Last then 2003 raise Index_Error; 2004 2005 -- Result is empty slice, reuse empty shared string 2006 2007 elsif Low > High then 2008 Reference (Empty_Shared_String'Access); 2009 DR := Empty_Shared_String'Access; 2010 2011 -- Otherwise, allocate new shared string and fill it 2012 2013 else 2014 DL := High - Low + 1; 2015 DR := Allocate (DL); 2016 DR.Data (1 .. DL) := SR.Data (Low .. High); 2017 DR.Last := DL; 2018 end if; 2019 2020 return (AF.Controlled with Reference => DR); 2021 end Unbounded_Slice; 2022 2023 procedure Unbounded_Slice 2024 (Source : Unbounded_String; 2025 Target : out Unbounded_String; 2026 Low : Positive; 2027 High : Natural) 2028 is 2029 SR : constant Shared_String_Access := Source.Reference; 2030 TR : constant Shared_String_Access := Target.Reference; 2031 DL : Natural; 2032 DR : Shared_String_Access; 2033 2034 begin 2035 -- Check bounds 2036 2037 if Low > SR.Last + 1 or else High > SR.Last then 2038 raise Index_Error; 2039 2040 -- Result is empty slice, reuse empty shared string 2041 2042 elsif Low > High then 2043 Reference (Empty_Shared_String'Access); 2044 Target.Reference := Empty_Shared_String'Access; 2045 Unreference (TR); 2046 2047 else 2048 DL := High - Low + 1; 2049 2050 -- Try to reuse existing shared string 2051 2052 if Can_Be_Reused (TR, DL) then 2053 TR.Data (1 .. DL) := SR.Data (Low .. High); 2054 TR.Last := DL; 2055 2056 -- Otherwise, allocate new shared string and fill it 2057 2058 else 2059 DR := Allocate (DL); 2060 DR.Data (1 .. DL) := SR.Data (Low .. High); 2061 DR.Last := DL; 2062 Target.Reference := DR; 2063 Unreference (TR); 2064 end if; 2065 end if; 2066 end Unbounded_Slice; 2067 2068 ----------------- 2069 -- Unreference -- 2070 ----------------- 2071 2072 procedure Unreference (Item : not null Shared_String_Access) is 2073 2074 procedure Free is 2075 new Ada.Unchecked_Deallocation (Shared_String, Shared_String_Access); 2076 2077 Aux : Shared_String_Access := Item; 2078 2079 begin 2080 if System.Atomic_Counters.Decrement (Aux.Counter) then 2081 2082 -- Reference counter of Empty_Shared_String must never reach zero 2083 2084 pragma Assert (Aux /= Empty_Shared_String'Access); 2085 2086 Free (Aux); 2087 end if; 2088 end Unreference; 2089 2090end Ada.Strings.Unbounded; 2091