gcc/ada/a-strunb-shared.adb

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