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-2018, 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 503 (Max_Length : Natural) return not null Shared_String_Access 504 is 505 begin 506 -- Empty string requested, return shared empty string 507 508 if Max_Length = 0 then 509 Reference (Empty_Shared_String'Access); 510 return Empty_Shared_String'Access; 511 512 -- Otherwise, allocate requested space (and probably some more room) 513 514 else 515 return new Shared_String (Aligned_Max_Length (Max_Length)); 516 end if; 517 end Allocate; 518 519 ------------ 520 -- Append -- 521 ------------ 522 523 procedure Append 524 (Source : in out Unbounded_String; 525 New_Item : Unbounded_String) 526 is 527 SR : constant Shared_String_Access := Source.Reference; 528 NR : constant Shared_String_Access := New_Item.Reference; 529 DL : constant Natural := SR.Last + NR.Last; 530 DR : Shared_String_Access; 531 532 begin 533 -- Source is an empty string, reuse New_Item data 534 535 if SR.Last = 0 then 536 Reference (NR); 537 Source.Reference := NR; 538 Unreference (SR); 539 540 -- New_Item is empty string, nothing to do 541 542 elsif NR.Last = 0 then 543 null; 544 545 -- Try to reuse existing shared string 546 547 elsif Can_Be_Reused (SR, DL) then 548 SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last); 549 SR.Last := DL; 550 551 -- Otherwise, allocate new one and fill it 552 553 else 554 DR := Allocate (DL + DL / Growth_Factor); 555 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 556 DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last); 557 DR.Last := DL; 558 Source.Reference := DR; 559 Unreference (SR); 560 end if; 561 end Append; 562 563 procedure Append 564 (Source : in out Unbounded_String; 565 New_Item : String) 566 is 567 SR : constant Shared_String_Access := Source.Reference; 568 DL : constant Natural := SR.Last + New_Item'Length; 569 DR : Shared_String_Access; 570 571 begin 572 -- New_Item is an empty string, nothing to do 573 574 if New_Item'Length = 0 then 575 null; 576 577 -- Try to reuse existing shared string 578 579 elsif Can_Be_Reused (SR, DL) then 580 SR.Data (SR.Last + 1 .. DL) := New_Item; 581 SR.Last := DL; 582 583 -- Otherwise, allocate new one and fill it 584 585 else 586 DR := Allocate (DL + DL / Growth_Factor); 587 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 588 DR.Data (SR.Last + 1 .. DL) := New_Item; 589 DR.Last := DL; 590 Source.Reference := DR; 591 Unreference (SR); 592 end if; 593 end Append; 594 595 procedure Append 596 (Source : in out Unbounded_String; 597 New_Item : Character) 598 is 599 SR : constant Shared_String_Access := Source.Reference; 600 DL : constant Natural := SR.Last + 1; 601 DR : Shared_String_Access; 602 603 begin 604 -- Try to reuse existing shared string 605 606 if Can_Be_Reused (SR, SR.Last + 1) then 607 SR.Data (SR.Last + 1) := New_Item; 608 SR.Last := SR.Last + 1; 609 610 -- Otherwise, allocate new one and fill it 611 612 else 613 DR := Allocate (DL + DL / Growth_Factor); 614 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 615 DR.Data (DL) := New_Item; 616 DR.Last := DL; 617 Source.Reference := DR; 618 Unreference (SR); 619 end if; 620 end Append; 621 622 ------------------- 623 -- Can_Be_Reused -- 624 ------------------- 625 626 function Can_Be_Reused 627 (Item : not null Shared_String_Access; 628 Length : Natural) return Boolean 629 is 630 begin 631 return 632 System.Atomic_Counters.Is_One (Item.Counter) 633 and then Item.Max_Length >= Length 634 and then Item.Max_Length <= 635 Aligned_Max_Length (Length + Length / Growth_Factor); 636 end Can_Be_Reused; 637 638 ----------- 639 -- Count -- 640 ----------- 641 642 function Count 643 (Source : Unbounded_String; 644 Pattern : String; 645 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural 646 is 647 SR : constant Shared_String_Access := Source.Reference; 648 begin 649 return Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping); 650 end Count; 651 652 function Count 653 (Source : Unbounded_String; 654 Pattern : String; 655 Mapping : Maps.Character_Mapping_Function) return Natural 656 is 657 SR : constant Shared_String_Access := Source.Reference; 658 begin 659 return Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping); 660 end Count; 661 662 function Count 663 (Source : Unbounded_String; 664 Set : Maps.Character_Set) return Natural 665 is 666 SR : constant Shared_String_Access := Source.Reference; 667 begin 668 return Search.Count (SR.Data (1 .. SR.Last), Set); 669 end Count; 670 671 ------------ 672 -- Delete -- 673 ------------ 674 675 function Delete 676 (Source : Unbounded_String; 677 From : Positive; 678 Through : Natural) return Unbounded_String 679 is 680 SR : constant Shared_String_Access := Source.Reference; 681 DL : Natural; 682 DR : Shared_String_Access; 683 684 begin 685 -- Empty slice is deleted, use the same shared string 686 687 if From > Through then 688 Reference (SR); 689 DR := SR; 690 691 -- Index is out of range 692 693 elsif Through > SR.Last then 694 raise Index_Error; 695 696 -- Compute size of the result 697 698 else 699 DL := SR.Last - (Through - From + 1); 700 701 -- Result is an empty string, reuse shared empty string 702 703 if DL = 0 then 704 Reference (Empty_Shared_String'Access); 705 DR := Empty_Shared_String'Access; 706 707 -- Otherwise, allocate new shared string and fill it 708 709 else 710 DR := Allocate (DL); 711 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1); 712 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last); 713 DR.Last := DL; 714 end if; 715 end if; 716 717 return (AF.Controlled with Reference => DR); 718 end Delete; 719 720 procedure Delete 721 (Source : in out Unbounded_String; 722 From : Positive; 723 Through : Natural) 724 is 725 SR : constant Shared_String_Access := Source.Reference; 726 DL : Natural; 727 DR : Shared_String_Access; 728 729 begin 730 -- Nothing changed, return 731 732 if From > Through then 733 null; 734 735 -- Through is outside of the range 736 737 elsif Through > SR.Last then 738 raise Index_Error; 739 740 else 741 DL := SR.Last - (Through - From + 1); 742 743 -- Result is empty, reuse shared empty string 744 745 if DL = 0 then 746 Reference (Empty_Shared_String'Access); 747 Source.Reference := Empty_Shared_String'Access; 748 Unreference (SR); 749 750 -- Try to reuse existing shared string 751 752 elsif Can_Be_Reused (SR, DL) then 753 SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last); 754 SR.Last := DL; 755 756 -- Otherwise, allocate new shared string 757 758 else 759 DR := Allocate (DL); 760 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1); 761 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last); 762 DR.Last := DL; 763 Source.Reference := DR; 764 Unreference (SR); 765 end if; 766 end if; 767 end Delete; 768 769 ------------- 770 -- Element -- 771 ------------- 772 773 function Element 774 (Source : Unbounded_String; 775 Index : Positive) return Character 776 is 777 SR : constant Shared_String_Access := Source.Reference; 778 begin 779 if Index <= SR.Last then 780 return SR.Data (Index); 781 else 782 raise Index_Error; 783 end if; 784 end Element; 785 786 -------------- 787 -- Finalize -- 788 -------------- 789 790 procedure Finalize (Object : in out Unbounded_String) is 791 SR : constant not null Shared_String_Access := Object.Reference; 792 begin 793 if SR /= Null_Unbounded_String.Reference then 794 795 -- The same controlled object can be finalized several times for 796 -- some reason. As per 7.6.1(24) this should have no ill effect, 797 -- so we need to add a guard for the case of finalizing the same 798 -- object twice. 799 800 -- We set the Object to the empty string so there will be no ill 801 -- effects if a program references an already-finalized object. 802 803 Object.Reference := Null_Unbounded_String.Reference; 804 Reference (Object.Reference); 805 Unreference (SR); 806 end if; 807 end Finalize; 808 809 ---------------- 810 -- Find_Token -- 811 ---------------- 812 813 procedure Find_Token 814 (Source : Unbounded_String; 815 Set : Maps.Character_Set; 816 From : Positive; 817 Test : Strings.Membership; 818 First : out Positive; 819 Last : out Natural) 820 is 821 SR : constant Shared_String_Access := Source.Reference; 822 begin 823 Search.Find_Token (SR.Data (From .. SR.Last), Set, Test, First, Last); 824 end Find_Token; 825 826 procedure Find_Token 827 (Source : Unbounded_String; 828 Set : Maps.Character_Set; 829 Test : Strings.Membership; 830 First : out Positive; 831 Last : out Natural) 832 is 833 SR : constant Shared_String_Access := Source.Reference; 834 begin 835 Search.Find_Token (SR.Data (1 .. SR.Last), Set, Test, First, Last); 836 end Find_Token; 837 838 ---------- 839 -- Free -- 840 ---------- 841 842 procedure Free (X : in out String_Access) is 843 procedure Deallocate is 844 new Ada.Unchecked_Deallocation (String, String_Access); 845 begin 846 Deallocate (X); 847 end Free; 848 849 ---------- 850 -- Head -- 851 ---------- 852 853 function Head 854 (Source : Unbounded_String; 855 Count : Natural; 856 Pad : Character := Space) return Unbounded_String 857 is 858 SR : constant Shared_String_Access := Source.Reference; 859 DR : Shared_String_Access; 860 861 begin 862 -- Result is empty, reuse shared empty string 863 864 if Count = 0 then 865 Reference (Empty_Shared_String'Access); 866 DR := Empty_Shared_String'Access; 867 868 -- Length of the string is the same as requested, reuse source shared 869 -- string. 870 871 elsif Count = SR.Last then 872 Reference (SR); 873 DR := SR; 874 875 -- Otherwise, allocate new shared string and fill it 876 877 else 878 DR := Allocate (Count); 879 880 -- Length of the source string is more than requested, copy 881 -- corresponding slice. 882 883 if Count < SR.Last then 884 DR.Data (1 .. Count) := SR.Data (1 .. Count); 885 886 -- Length of the source string is less than requested, copy all 887 -- contents and fill others by Pad character. 888 889 else 890 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 891 892 for J in SR.Last + 1 .. Count loop 893 DR.Data (J) := Pad; 894 end loop; 895 end if; 896 897 DR.Last := Count; 898 end if; 899 900 return (AF.Controlled with Reference => DR); 901 end Head; 902 903 procedure Head 904 (Source : in out Unbounded_String; 905 Count : Natural; 906 Pad : Character := Space) 907 is 908 SR : constant Shared_String_Access := Source.Reference; 909 DR : Shared_String_Access; 910 911 begin 912 -- Result is empty, reuse empty shared string 913 914 if Count = 0 then 915 Reference (Empty_Shared_String'Access); 916 Source.Reference := Empty_Shared_String'Access; 917 Unreference (SR); 918 919 -- Result is same as source string, reuse source shared string 920 921 elsif Count = SR.Last then 922 null; 923 924 -- Try to reuse existing shared string 925 926 elsif Can_Be_Reused (SR, Count) then 927 if Count > SR.Last then 928 for J in SR.Last + 1 .. Count loop 929 SR.Data (J) := Pad; 930 end loop; 931 end if; 932 933 SR.Last := Count; 934 935 -- Otherwise, allocate new shared string and fill it 936 937 else 938 DR := Allocate (Count); 939 940 -- Length of the source string is greater than requested, copy 941 -- corresponding slice. 942 943 if Count < SR.Last then 944 DR.Data (1 .. Count) := SR.Data (1 .. Count); 945 946 -- Length of the source string is less than requested, copy all 947 -- existing data and fill remaining positions with Pad characters. 948 949 else 950 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 951 952 for J in SR.Last + 1 .. Count loop 953 DR.Data (J) := Pad; 954 end loop; 955 end if; 956 957 DR.Last := Count; 958 Source.Reference := DR; 959 Unreference (SR); 960 end if; 961 end Head; 962 963 ----------- 964 -- Index -- 965 ----------- 966 967 function Index 968 (Source : Unbounded_String; 969 Pattern : String; 970 Going : Strings.Direction := Strings.Forward; 971 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural 972 is 973 SR : constant Shared_String_Access := Source.Reference; 974 begin 975 return Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping); 976 end Index; 977 978 function Index 979 (Source : Unbounded_String; 980 Pattern : String; 981 Going : Direction := Forward; 982 Mapping : Maps.Character_Mapping_Function) return Natural 983 is 984 SR : constant Shared_String_Access := Source.Reference; 985 begin 986 return Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping); 987 end Index; 988 989 function Index 990 (Source : Unbounded_String; 991 Set : Maps.Character_Set; 992 Test : Strings.Membership := Strings.Inside; 993 Going : Strings.Direction := Strings.Forward) return Natural 994 is 995 SR : constant Shared_String_Access := Source.Reference; 996 begin 997 return Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going); 998 end Index; 999 1000 function Index 1001 (Source : Unbounded_String; 1002 Pattern : String; 1003 From : Positive; 1004 Going : Direction := Forward; 1005 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural 1006 is 1007 SR : constant Shared_String_Access := Source.Reference; 1008 begin 1009 return Search.Index 1010 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping); 1011 end Index; 1012 1013 function Index 1014 (Source : Unbounded_String; 1015 Pattern : String; 1016 From : Positive; 1017 Going : Direction := Forward; 1018 Mapping : Maps.Character_Mapping_Function) return Natural 1019 is 1020 SR : constant Shared_String_Access := Source.Reference; 1021 begin 1022 return Search.Index 1023 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping); 1024 end Index; 1025 1026 function Index 1027 (Source : Unbounded_String; 1028 Set : Maps.Character_Set; 1029 From : Positive; 1030 Test : Membership := Inside; 1031 Going : Direction := Forward) return Natural 1032 is 1033 SR : constant Shared_String_Access := Source.Reference; 1034 begin 1035 return Search.Index (SR.Data (1 .. SR.Last), Set, From, Test, Going); 1036 end Index; 1037 1038 --------------------- 1039 -- Index_Non_Blank -- 1040 --------------------- 1041 1042 function Index_Non_Blank 1043 (Source : Unbounded_String; 1044 Going : Strings.Direction := Strings.Forward) return Natural 1045 is 1046 SR : constant Shared_String_Access := Source.Reference; 1047 begin 1048 return Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going); 1049 end Index_Non_Blank; 1050 1051 function Index_Non_Blank 1052 (Source : Unbounded_String; 1053 From : Positive; 1054 Going : Direction := Forward) return Natural 1055 is 1056 SR : constant Shared_String_Access := Source.Reference; 1057 begin 1058 return Search.Index_Non_Blank (SR.Data (1 .. SR.Last), From, Going); 1059 end Index_Non_Blank; 1060 1061 ---------------- 1062 -- Initialize -- 1063 ---------------- 1064 1065 procedure Initialize (Object : in out Unbounded_String) is 1066 begin 1067 Reference (Object.Reference); 1068 end Initialize; 1069 1070 ------------ 1071 -- Insert -- 1072 ------------ 1073 1074 function Insert 1075 (Source : Unbounded_String; 1076 Before : Positive; 1077 New_Item : String) return Unbounded_String 1078 is 1079 SR : constant Shared_String_Access := Source.Reference; 1080 DL : constant Natural := SR.Last + New_Item'Length; 1081 DR : Shared_String_Access; 1082 1083 begin 1084 -- Check index first 1085 1086 if Before > SR.Last + 1 then 1087 raise Index_Error; 1088 end if; 1089 1090 -- Result is empty, reuse empty shared string 1091 1092 if DL = 0 then 1093 Reference (Empty_Shared_String'Access); 1094 DR := Empty_Shared_String'Access; 1095 1096 -- Inserted string is empty, reuse source shared string 1097 1098 elsif New_Item'Length = 0 then 1099 Reference (SR); 1100 DR := SR; 1101 1102 -- Otherwise, allocate new shared string and fill it 1103 1104 else 1105 DR := Allocate (DL + DL / Growth_Factor); 1106 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1); 1107 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item; 1108 DR.Data (Before + New_Item'Length .. DL) := 1109 SR.Data (Before .. SR.Last); 1110 DR.Last := DL; 1111 end if; 1112 1113 return (AF.Controlled with Reference => DR); 1114 end Insert; 1115 1116 procedure Insert 1117 (Source : in out Unbounded_String; 1118 Before : Positive; 1119 New_Item : String) 1120 is 1121 SR : constant Shared_String_Access := Source.Reference; 1122 DL : constant Natural := SR.Last + New_Item'Length; 1123 DR : Shared_String_Access; 1124 1125 begin 1126 -- Check bounds 1127 1128 if Before > SR.Last + 1 then 1129 raise Index_Error; 1130 end if; 1131 1132 -- Result is empty string, reuse empty shared string 1133 1134 if DL = 0 then 1135 Reference (Empty_Shared_String'Access); 1136 Source.Reference := Empty_Shared_String'Access; 1137 Unreference (SR); 1138 1139 -- Inserted string is empty, nothing to do 1140 1141 elsif New_Item'Length = 0 then 1142 null; 1143 1144 -- Try to reuse existing shared string first 1145 1146 elsif Can_Be_Reused (SR, DL) then 1147 SR.Data (Before + New_Item'Length .. DL) := 1148 SR.Data (Before .. SR.Last); 1149 SR.Data (Before .. Before + New_Item'Length - 1) := New_Item; 1150 SR.Last := DL; 1151 1152 -- Otherwise, allocate new shared string and fill it 1153 1154 else 1155 DR := Allocate (DL + DL / Growth_Factor); 1156 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1); 1157 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item; 1158 DR.Data (Before + New_Item'Length .. DL) := 1159 SR.Data (Before .. SR.Last); 1160 DR.Last := DL; 1161 Source.Reference := DR; 1162 Unreference (SR); 1163 end if; 1164 end Insert; 1165 1166 ------------ 1167 -- Length -- 1168 ------------ 1169 1170 function Length (Source : Unbounded_String) return Natural is 1171 begin 1172 return Source.Reference.Last; 1173 end Length; 1174 1175 --------------- 1176 -- Overwrite -- 1177 --------------- 1178 1179 function Overwrite 1180 (Source : Unbounded_String; 1181 Position : Positive; 1182 New_Item : String) return Unbounded_String 1183 is 1184 SR : constant Shared_String_Access := Source.Reference; 1185 DL : Natural; 1186 DR : Shared_String_Access; 1187 1188 begin 1189 -- Check bounds 1190 1191 if Position > SR.Last + 1 then 1192 raise Index_Error; 1193 end if; 1194 1195 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1); 1196 1197 -- Result is empty string, reuse empty shared string 1198 1199 if DL = 0 then 1200 Reference (Empty_Shared_String'Access); 1201 DR := Empty_Shared_String'Access; 1202 1203 -- Result is same as source string, reuse source shared string 1204 1205 elsif New_Item'Length = 0 then 1206 Reference (SR); 1207 DR := SR; 1208 1209 -- Otherwise, allocate new shared string and fill it 1210 1211 else 1212 DR := Allocate (DL); 1213 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1); 1214 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item; 1215 DR.Data (Position + New_Item'Length .. DL) := 1216 SR.Data (Position + New_Item'Length .. SR.Last); 1217 DR.Last := DL; 1218 end if; 1219 1220 return (AF.Controlled with Reference => DR); 1221 end Overwrite; 1222 1223 procedure Overwrite 1224 (Source : in out Unbounded_String; 1225 Position : Positive; 1226 New_Item : String) 1227 is 1228 SR : constant Shared_String_Access := Source.Reference; 1229 DL : Natural; 1230 DR : Shared_String_Access; 1231 1232 begin 1233 -- Bounds check 1234 1235 if Position > SR.Last + 1 then 1236 raise Index_Error; 1237 end if; 1238 1239 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1); 1240 1241 -- Result is empty string, reuse empty shared string 1242 1243 if DL = 0 then 1244 Reference (Empty_Shared_String'Access); 1245 Source.Reference := Empty_Shared_String'Access; 1246 Unreference (SR); 1247 1248 -- String unchanged, nothing to do 1249 1250 elsif New_Item'Length = 0 then 1251 null; 1252 1253 -- Try to reuse existing shared string 1254 1255 elsif Can_Be_Reused (SR, DL) then 1256 SR.Data (Position .. Position + New_Item'Length - 1) := New_Item; 1257 SR.Last := DL; 1258 1259 -- Otherwise allocate new shared string and fill it 1260 1261 else 1262 DR := Allocate (DL); 1263 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1); 1264 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item; 1265 DR.Data (Position + New_Item'Length .. DL) := 1266 SR.Data (Position + New_Item'Length .. SR.Last); 1267 DR.Last := DL; 1268 Source.Reference := DR; 1269 Unreference (SR); 1270 end if; 1271 end Overwrite; 1272 1273 --------------- 1274 -- Reference -- 1275 --------------- 1276 1277 procedure Reference (Item : not null Shared_String_Access) is 1278 begin 1279 System.Atomic_Counters.Increment (Item.Counter); 1280 end Reference; 1281 1282 --------------------- 1283 -- Replace_Element -- 1284 --------------------- 1285 1286 procedure Replace_Element 1287 (Source : in out Unbounded_String; 1288 Index : Positive; 1289 By : Character) 1290 is 1291 SR : constant Shared_String_Access := Source.Reference; 1292 DR : Shared_String_Access; 1293 1294 begin 1295 -- Bounds check 1296 1297 if Index <= SR.Last then 1298 1299 -- Try to reuse existing shared string 1300 1301 if Can_Be_Reused (SR, SR.Last) then 1302 SR.Data (Index) := By; 1303 1304 -- Otherwise allocate new shared string and fill it 1305 1306 else 1307 DR := Allocate (SR.Last); 1308 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 1309 DR.Data (Index) := By; 1310 DR.Last := SR.Last; 1311 Source.Reference := DR; 1312 Unreference (SR); 1313 end if; 1314 1315 else 1316 raise Index_Error; 1317 end if; 1318 end Replace_Element; 1319 1320 ------------------- 1321 -- Replace_Slice -- 1322 ------------------- 1323 1324 function Replace_Slice 1325 (Source : Unbounded_String; 1326 Low : Positive; 1327 High : Natural; 1328 By : String) return Unbounded_String 1329 is 1330 SR : constant Shared_String_Access := Source.Reference; 1331 DL : Natural; 1332 DR : Shared_String_Access; 1333 1334 begin 1335 -- Check bounds 1336 1337 if Low > SR.Last + 1 then 1338 raise Index_Error; 1339 end if; 1340 1341 -- Do replace operation when removed slice is not empty 1342 1343 if High >= Low then 1344 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1; 1345 -- This is the number of characters remaining in the string after 1346 -- replacing the slice. 1347 1348 -- Result is empty string, reuse empty shared string 1349 1350 if DL = 0 then 1351 Reference (Empty_Shared_String'Access); 1352 DR := Empty_Shared_String'Access; 1353 1354 -- Otherwise allocate new shared string and fill it 1355 1356 else 1357 DR := Allocate (DL); 1358 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1); 1359 DR.Data (Low .. Low + By'Length - 1) := By; 1360 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last); 1361 DR.Last := DL; 1362 end if; 1363 1364 return (AF.Controlled with Reference => DR); 1365 1366 -- Otherwise just insert string 1367 1368 else 1369 return Insert (Source, Low, By); 1370 end if; 1371 end Replace_Slice; 1372 1373 procedure Replace_Slice 1374 (Source : in out Unbounded_String; 1375 Low : Positive; 1376 High : Natural; 1377 By : String) 1378 is 1379 SR : constant Shared_String_Access := Source.Reference; 1380 DL : Natural; 1381 DR : Shared_String_Access; 1382 1383 begin 1384 -- Bounds check 1385 1386 if Low > SR.Last + 1 then 1387 raise Index_Error; 1388 end if; 1389 1390 -- Do replace operation only when replaced slice is not empty 1391 1392 if High >= Low then 1393 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1; 1394 -- This is the number of characters remaining in the string after 1395 -- replacing the slice. 1396 1397 -- Result is empty string, reuse empty shared string 1398 1399 if DL = 0 then 1400 Reference (Empty_Shared_String'Access); 1401 Source.Reference := Empty_Shared_String'Access; 1402 Unreference (SR); 1403 1404 -- Try to reuse existing shared string 1405 1406 elsif Can_Be_Reused (SR, DL) then 1407 SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last); 1408 SR.Data (Low .. Low + By'Length - 1) := By; 1409 SR.Last := DL; 1410 1411 -- Otherwise allocate new shared string and fill it 1412 1413 else 1414 DR := Allocate (DL); 1415 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1); 1416 DR.Data (Low .. Low + By'Length - 1) := By; 1417 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last); 1418 DR.Last := DL; 1419 Source.Reference := DR; 1420 Unreference (SR); 1421 end if; 1422 1423 -- Otherwise just insert item 1424 1425 else 1426 Insert (Source, Low, By); 1427 end if; 1428 end Replace_Slice; 1429 1430 -------------------------- 1431 -- Set_Unbounded_String -- 1432 -------------------------- 1433 1434 procedure Set_Unbounded_String 1435 (Target : out Unbounded_String; 1436 Source : String) 1437 is 1438 TR : constant Shared_String_Access := Target.Reference; 1439 DR : Shared_String_Access; 1440 1441 begin 1442 -- In case of empty string, reuse empty shared string 1443 1444 if Source'Length = 0 then 1445 Reference (Empty_Shared_String'Access); 1446 Target.Reference := Empty_Shared_String'Access; 1447 1448 else 1449 -- Try to reuse existing shared string 1450 1451 if Can_Be_Reused (TR, Source'Length) then 1452 Reference (TR); 1453 DR := TR; 1454 1455 -- Otherwise allocate new shared string 1456 1457 else 1458 DR := Allocate (Source'Length); 1459 Target.Reference := DR; 1460 end if; 1461 1462 DR.Data (1 .. Source'Length) := Source; 1463 DR.Last := Source'Length; 1464 end if; 1465 1466 Unreference (TR); 1467 end Set_Unbounded_String; 1468 1469 ----------- 1470 -- Slice -- 1471 ----------- 1472 1473 function Slice 1474 (Source : Unbounded_String; 1475 Low : Positive; 1476 High : Natural) return String 1477 is 1478 SR : constant Shared_String_Access := Source.Reference; 1479 1480 begin 1481 -- Note: test of High > Length is in accordance with AI95-00128 1482 1483 if Low > SR.Last + 1 or else High > SR.Last then 1484 raise Index_Error; 1485 1486 else 1487 return SR.Data (Low .. High); 1488 end if; 1489 end Slice; 1490 1491 ---------- 1492 -- Tail -- 1493 ---------- 1494 1495 function Tail 1496 (Source : Unbounded_String; 1497 Count : Natural; 1498 Pad : Character := Space) return Unbounded_String 1499 is 1500 SR : constant Shared_String_Access := Source.Reference; 1501 DR : Shared_String_Access; 1502 1503 begin 1504 -- For empty result reuse empty shared string 1505 1506 if Count = 0 then 1507 Reference (Empty_Shared_String'Access); 1508 DR := Empty_Shared_String'Access; 1509 1510 -- Result is whole source string, reuse source shared string 1511 1512 elsif Count = SR.Last then 1513 Reference (SR); 1514 DR := SR; 1515 1516 -- Otherwise allocate new shared string and fill it 1517 1518 else 1519 DR := Allocate (Count); 1520 1521 if Count < SR.Last then 1522 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last); 1523 1524 else 1525 for J in 1 .. Count - SR.Last loop 1526 DR.Data (J) := Pad; 1527 end loop; 1528 1529 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last); 1530 end if; 1531 1532 DR.Last := Count; 1533 end if; 1534 1535 return (AF.Controlled with Reference => DR); 1536 end Tail; 1537 1538 procedure Tail 1539 (Source : in out Unbounded_String; 1540 Count : Natural; 1541 Pad : Character := Space) 1542 is 1543 SR : constant Shared_String_Access := Source.Reference; 1544 DR : Shared_String_Access; 1545 1546 procedure Common 1547 (SR : Shared_String_Access; 1548 DR : Shared_String_Access; 1549 Count : Natural); 1550 -- Common code of tail computation. SR/DR can point to the same object 1551 1552 ------------ 1553 -- Common -- 1554 ------------ 1555 1556 procedure Common 1557 (SR : Shared_String_Access; 1558 DR : Shared_String_Access; 1559 Count : Natural) is 1560 begin 1561 if Count < SR.Last then 1562 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last); 1563 1564 else 1565 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last); 1566 1567 for J in 1 .. Count - SR.Last loop 1568 DR.Data (J) := Pad; 1569 end loop; 1570 end if; 1571 1572 DR.Last := Count; 1573 end Common; 1574 1575 begin 1576 -- Result is empty string, reuse empty shared string 1577 1578 if Count = 0 then 1579 Reference (Empty_Shared_String'Access); 1580 Source.Reference := Empty_Shared_String'Access; 1581 Unreference (SR); 1582 1583 -- Length of the result is the same as length of the source string, 1584 -- reuse source shared string. 1585 1586 elsif Count = SR.Last then 1587 null; 1588 1589 -- Try to reuse existing shared string 1590 1591 elsif Can_Be_Reused (SR, Count) then 1592 Common (SR, SR, Count); 1593 1594 -- Otherwise allocate new shared string and fill it 1595 1596 else 1597 DR := Allocate (Count); 1598 Common (SR, DR, Count); 1599 Source.Reference := DR; 1600 Unreference (SR); 1601 end if; 1602 end Tail; 1603 1604 --------------- 1605 -- To_String -- 1606 --------------- 1607 1608 function To_String (Source : Unbounded_String) return String is 1609 begin 1610 return Source.Reference.Data (1 .. Source.Reference.Last); 1611 end To_String; 1612 1613 ------------------------- 1614 -- To_Unbounded_String -- 1615 ------------------------- 1616 1617 function To_Unbounded_String (Source : String) return Unbounded_String is 1618 DR : Shared_String_Access; 1619 1620 begin 1621 if Source'Length = 0 then 1622 Reference (Empty_Shared_String'Access); 1623 DR := Empty_Shared_String'Access; 1624 1625 else 1626 DR := Allocate (Source'Length); 1627 DR.Data (1 .. Source'Length) := Source; 1628 DR.Last := Source'Length; 1629 end if; 1630 1631 return (AF.Controlled with Reference => DR); 1632 end To_Unbounded_String; 1633 1634 function To_Unbounded_String (Length : Natural) return Unbounded_String is 1635 DR : Shared_String_Access; 1636 1637 begin 1638 if Length = 0 then 1639 Reference (Empty_Shared_String'Access); 1640 DR := Empty_Shared_String'Access; 1641 1642 else 1643 DR := Allocate (Length); 1644 DR.Last := Length; 1645 end if; 1646 1647 return (AF.Controlled with Reference => DR); 1648 end To_Unbounded_String; 1649 1650 --------------- 1651 -- Translate -- 1652 --------------- 1653 1654 function Translate 1655 (Source : Unbounded_String; 1656 Mapping : Maps.Character_Mapping) return Unbounded_String 1657 is 1658 SR : constant Shared_String_Access := Source.Reference; 1659 DR : Shared_String_Access; 1660 1661 begin 1662 -- Nothing to translate, reuse empty shared string 1663 1664 if SR.Last = 0 then 1665 Reference (Empty_Shared_String'Access); 1666 DR := Empty_Shared_String'Access; 1667 1668 -- Otherwise, allocate new shared string and fill it 1669 1670 else 1671 DR := Allocate (SR.Last); 1672 1673 for J in 1 .. SR.Last loop 1674 DR.Data (J) := Value (Mapping, SR.Data (J)); 1675 end loop; 1676 1677 DR.Last := SR.Last; 1678 end if; 1679 1680 return (AF.Controlled with Reference => DR); 1681 end Translate; 1682 1683 procedure Translate 1684 (Source : in out Unbounded_String; 1685 Mapping : Maps.Character_Mapping) 1686 is 1687 SR : constant Shared_String_Access := Source.Reference; 1688 DR : Shared_String_Access; 1689 1690 begin 1691 -- Nothing to translate 1692 1693 if SR.Last = 0 then 1694 null; 1695 1696 -- Try to reuse shared string 1697 1698 elsif Can_Be_Reused (SR, SR.Last) then 1699 for J in 1 .. SR.Last loop 1700 SR.Data (J) := Value (Mapping, SR.Data (J)); 1701 end loop; 1702 1703 -- Otherwise, allocate new shared string 1704 1705 else 1706 DR := Allocate (SR.Last); 1707 1708 for J in 1 .. SR.Last loop 1709 DR.Data (J) := Value (Mapping, SR.Data (J)); 1710 end loop; 1711 1712 DR.Last := SR.Last; 1713 Source.Reference := DR; 1714 Unreference (SR); 1715 end if; 1716 end Translate; 1717 1718 function Translate 1719 (Source : Unbounded_String; 1720 Mapping : Maps.Character_Mapping_Function) return Unbounded_String 1721 is 1722 SR : constant Shared_String_Access := Source.Reference; 1723 DR : Shared_String_Access; 1724 1725 begin 1726 -- Nothing to translate, reuse empty shared string 1727 1728 if SR.Last = 0 then 1729 Reference (Empty_Shared_String'Access); 1730 DR := Empty_Shared_String'Access; 1731 1732 -- Otherwise, allocate new shared string and fill it 1733 1734 else 1735 DR := Allocate (SR.Last); 1736 1737 for J in 1 .. SR.Last loop 1738 DR.Data (J) := Mapping.all (SR.Data (J)); 1739 end loop; 1740 1741 DR.Last := SR.Last; 1742 end if; 1743 1744 return (AF.Controlled with Reference => DR); 1745 1746 exception 1747 when others => 1748 Unreference (DR); 1749 1750 raise; 1751 end Translate; 1752 1753 procedure Translate 1754 (Source : in out Unbounded_String; 1755 Mapping : Maps.Character_Mapping_Function) 1756 is 1757 SR : constant Shared_String_Access := Source.Reference; 1758 DR : Shared_String_Access; 1759 1760 begin 1761 -- Nothing to translate 1762 1763 if SR.Last = 0 then 1764 null; 1765 1766 -- Try to reuse shared string 1767 1768 elsif Can_Be_Reused (SR, SR.Last) then 1769 for J in 1 .. SR.Last loop 1770 SR.Data (J) := Mapping.all (SR.Data (J)); 1771 end loop; 1772 1773 -- Otherwise allocate new shared string and fill it 1774 1775 else 1776 DR := Allocate (SR.Last); 1777 1778 for J in 1 .. SR.Last loop 1779 DR.Data (J) := Mapping.all (SR.Data (J)); 1780 end loop; 1781 1782 DR.Last := SR.Last; 1783 Source.Reference := DR; 1784 Unreference (SR); 1785 end if; 1786 1787 exception 1788 when others => 1789 if DR /= null then 1790 Unreference (DR); 1791 end if; 1792 1793 raise; 1794 end Translate; 1795 1796 ---------- 1797 -- Trim -- 1798 ---------- 1799 1800 function Trim 1801 (Source : Unbounded_String; 1802 Side : Trim_End) return Unbounded_String 1803 is 1804 SR : constant Shared_String_Access := Source.Reference; 1805 DL : Natural; 1806 DR : Shared_String_Access; 1807 Low : Natural; 1808 High : Natural; 1809 1810 begin 1811 Low := Index_Non_Blank (Source, Forward); 1812 1813 -- All blanks, reuse empty shared string 1814 1815 if Low = 0 then 1816 Reference (Empty_Shared_String'Access); 1817 DR := Empty_Shared_String'Access; 1818 1819 else 1820 case Side is 1821 when Left => 1822 High := SR.Last; 1823 DL := SR.Last - Low + 1; 1824 1825 when Right => 1826 Low := 1; 1827 High := Index_Non_Blank (Source, Backward); 1828 DL := High; 1829 1830 when Both => 1831 High := Index_Non_Blank (Source, Backward); 1832 DL := High - Low + 1; 1833 end case; 1834 1835 -- Length of the result is the same as length of the source string, 1836 -- reuse source shared string. 1837 1838 if DL = SR.Last then 1839 Reference (SR); 1840 DR := SR; 1841 1842 -- Otherwise, allocate new shared string 1843 1844 else 1845 DR := Allocate (DL); 1846 DR.Data (1 .. DL) := SR.Data (Low .. High); 1847 DR.Last := DL; 1848 end if; 1849 end if; 1850 1851 return (AF.Controlled with Reference => DR); 1852 end Trim; 1853 1854 procedure Trim 1855 (Source : in out Unbounded_String; 1856 Side : Trim_End) 1857 is 1858 SR : constant Shared_String_Access := Source.Reference; 1859 DL : Natural; 1860 DR : Shared_String_Access; 1861 Low : Natural; 1862 High : Natural; 1863 1864 begin 1865 Low := Index_Non_Blank (Source, Forward); 1866 1867 -- All blanks, reuse empty shared string 1868 1869 if Low = 0 then 1870 Reference (Empty_Shared_String'Access); 1871 Source.Reference := Empty_Shared_String'Access; 1872 Unreference (SR); 1873 1874 else 1875 case Side is 1876 when Left => 1877 High := SR.Last; 1878 DL := SR.Last - Low + 1; 1879 1880 when Right => 1881 Low := 1; 1882 High := Index_Non_Blank (Source, Backward); 1883 DL := High; 1884 1885 when Both => 1886 High := Index_Non_Blank (Source, Backward); 1887 DL := High - Low + 1; 1888 end case; 1889 1890 -- Length of the result is the same as length of the source string, 1891 -- nothing to do. 1892 1893 if DL = SR.Last then 1894 null; 1895 1896 -- Try to reuse existing shared string 1897 1898 elsif Can_Be_Reused (SR, DL) then 1899 SR.Data (1 .. DL) := SR.Data (Low .. High); 1900 SR.Last := DL; 1901 1902 -- Otherwise, allocate new shared string 1903 1904 else 1905 DR := Allocate (DL); 1906 DR.Data (1 .. DL) := SR.Data (Low .. High); 1907 DR.Last := DL; 1908 Source.Reference := DR; 1909 Unreference (SR); 1910 end if; 1911 end if; 1912 end Trim; 1913 1914 function Trim 1915 (Source : Unbounded_String; 1916 Left : Maps.Character_Set; 1917 Right : Maps.Character_Set) return Unbounded_String 1918 is 1919 SR : constant Shared_String_Access := Source.Reference; 1920 DL : Natural; 1921 DR : Shared_String_Access; 1922 Low : Natural; 1923 High : Natural; 1924 1925 begin 1926 Low := Index (Source, Left, Outside, Forward); 1927 1928 -- Source includes only characters from Left set, reuse empty shared 1929 -- string. 1930 1931 if Low = 0 then 1932 Reference (Empty_Shared_String'Access); 1933 DR := Empty_Shared_String'Access; 1934 1935 else 1936 High := Index (Source, Right, Outside, Backward); 1937 DL := Integer'Max (0, High - Low + 1); 1938 1939 -- Source includes only characters from Right set or result string 1940 -- is empty, reuse empty shared string. 1941 1942 if High = 0 or else DL = 0 then 1943 Reference (Empty_Shared_String'Access); 1944 DR := Empty_Shared_String'Access; 1945 1946 -- Otherwise, allocate new shared string and fill it 1947 1948 else 1949 DR := Allocate (DL); 1950 DR.Data (1 .. DL) := SR.Data (Low .. High); 1951 DR.Last := DL; 1952 end if; 1953 end if; 1954 1955 return (AF.Controlled with Reference => DR); 1956 end Trim; 1957 1958 procedure Trim 1959 (Source : in out Unbounded_String; 1960 Left : Maps.Character_Set; 1961 Right : Maps.Character_Set) 1962 is 1963 SR : constant Shared_String_Access := Source.Reference; 1964 DL : Natural; 1965 DR : Shared_String_Access; 1966 Low : Natural; 1967 High : Natural; 1968 1969 begin 1970 Low := Index (Source, Left, Outside, Forward); 1971 1972 -- Source includes only characters from Left set, reuse empty shared 1973 -- string. 1974 1975 if Low = 0 then 1976 Reference (Empty_Shared_String'Access); 1977 Source.Reference := Empty_Shared_String'Access; 1978 Unreference (SR); 1979 1980 else 1981 High := Index (Source, Right, Outside, Backward); 1982 DL := Integer'Max (0, High - Low + 1); 1983 1984 -- Source includes only characters from Right set or result string 1985 -- is empty, reuse empty shared string. 1986 1987 if High = 0 or else DL = 0 then 1988 Reference (Empty_Shared_String'Access); 1989 Source.Reference := Empty_Shared_String'Access; 1990 Unreference (SR); 1991 1992 -- Try to reuse existing shared string 1993 1994 elsif Can_Be_Reused (SR, DL) then 1995 SR.Data (1 .. DL) := SR.Data (Low .. High); 1996 SR.Last := DL; 1997 1998 -- Otherwise, allocate new shared string and fill it 1999 2000 else 2001 DR := Allocate (DL); 2002 DR.Data (1 .. DL) := SR.Data (Low .. High); 2003 DR.Last := DL; 2004 Source.Reference := DR; 2005 Unreference (SR); 2006 end if; 2007 end if; 2008 end Trim; 2009 2010 --------------------- 2011 -- Unbounded_Slice -- 2012 --------------------- 2013 2014 function Unbounded_Slice 2015 (Source : Unbounded_String; 2016 Low : Positive; 2017 High : Natural) return Unbounded_String 2018 is 2019 SR : constant Shared_String_Access := Source.Reference; 2020 DL : Natural; 2021 DR : Shared_String_Access; 2022 2023 begin 2024 -- Check bounds 2025 2026 if Low > SR.Last + 1 or else High > SR.Last then 2027 raise Index_Error; 2028 2029 -- Result is empty slice, reuse empty shared string 2030 2031 elsif Low > High then 2032 Reference (Empty_Shared_String'Access); 2033 DR := Empty_Shared_String'Access; 2034 2035 -- Otherwise, allocate new shared string and fill it 2036 2037 else 2038 DL := High - Low + 1; 2039 DR := Allocate (DL); 2040 DR.Data (1 .. DL) := SR.Data (Low .. High); 2041 DR.Last := DL; 2042 end if; 2043 2044 return (AF.Controlled with Reference => DR); 2045 end Unbounded_Slice; 2046 2047 procedure Unbounded_Slice 2048 (Source : Unbounded_String; 2049 Target : out Unbounded_String; 2050 Low : Positive; 2051 High : Natural) 2052 is 2053 SR : constant Shared_String_Access := Source.Reference; 2054 TR : constant Shared_String_Access := Target.Reference; 2055 DL : Natural; 2056 DR : Shared_String_Access; 2057 2058 begin 2059 -- Check bounds 2060 2061 if Low > SR.Last + 1 or else High > SR.Last then 2062 raise Index_Error; 2063 2064 -- Result is empty slice, reuse empty shared string 2065 2066 elsif Low > High then 2067 Reference (Empty_Shared_String'Access); 2068 Target.Reference := Empty_Shared_String'Access; 2069 Unreference (TR); 2070 2071 else 2072 DL := High - Low + 1; 2073 2074 -- Try to reuse existing shared string 2075 2076 if Can_Be_Reused (TR, DL) then 2077 TR.Data (1 .. DL) := SR.Data (Low .. High); 2078 TR.Last := DL; 2079 2080 -- Otherwise, allocate new shared string and fill it 2081 2082 else 2083 DR := Allocate (DL); 2084 DR.Data (1 .. DL) := SR.Data (Low .. High); 2085 DR.Last := DL; 2086 Target.Reference := DR; 2087 Unreference (TR); 2088 end if; 2089 end if; 2090 end Unbounded_Slice; 2091 2092 ----------------- 2093 -- Unreference -- 2094 ----------------- 2095 2096 procedure Unreference (Item : not null Shared_String_Access) is 2097 2098 procedure Free is 2099 new Ada.Unchecked_Deallocation (Shared_String, Shared_String_Access); 2100 2101 Aux : Shared_String_Access := Item; 2102 2103 begin 2104 if System.Atomic_Counters.Decrement (Aux.Counter) then 2105 2106 -- Reference counter of Empty_Shared_String should never reach 2107 -- zero. We check here in case it wraps around. 2108 2109 if Aux /= Empty_Shared_String'Access then 2110 Free (Aux); 2111 end if; 2112 end if; 2113 end Unreference; 2114 2115end Ada.Strings.Unbounded; 2116