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