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