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