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