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