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-2014, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  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          Object.Reference := null;
 799          Unreference (SR);
 800       end if;
 801    end Finalize;
 802
 803    ----------------
 804    -- Find_Token --
 805    ----------------
 806
 807    procedure Find_Token
 808      (Source : Unbounded_String;
 809       Set    : Maps.Character_Set;
 810       From   : Positive;
 811       Test   : Strings.Membership;
 812       First  : out Positive;
 813       Last   : out Natural)
 814    is
 815       SR : constant Shared_String_Access := Source.Reference;
 816    begin
 817       Search.Find_Token (SR.Data (From .. SR.Last), Set, Test, First, Last);
 818    end Find_Token;
 819
 820    procedure Find_Token
 821      (Source : Unbounded_String;
 822       Set    : Maps.Character_Set;
 823       Test   : Strings.Membership;
 824       First  : out Positive;
 825       Last   : out Natural)
 826    is
 827       SR : constant Shared_String_Access := Source.Reference;
 828    begin
 829       Search.Find_Token (SR.Data (1 .. SR.Last), Set, Test, First, Last);
 830    end Find_Token;
 831
 832    ----------
 833    -- Free --
 834    ----------
 835
 836    procedure Free (X : in out String_Access) is
 837       procedure Deallocate is
 838         new Ada.Unchecked_Deallocation (String, String_Access);
 839    begin
 840       Deallocate (X);
 841    end Free;
 842
 843    ----------
 844    -- Head --
 845    ----------
 846
 847    function Head
 848      (Source : Unbounded_String;
 849       Count  : Natural;
 850       Pad    : Character := Space) return Unbounded_String
 851    is
 852       SR : constant Shared_String_Access := Source.Reference;
 853       DR : Shared_String_Access;
 854
 855    begin
 856       --  Result is empty, reuse shared empty string
 857
 858       if Count = 0 then
 859          Reference (Empty_Shared_String'Access);
 860          DR := Empty_Shared_String'Access;
 861
 862       --  Length of the string is the same as requested, reuse source shared
 863       --  string.
 864
 865       elsif Count = SR.Last then
 866          Reference (SR);
 867          DR := SR;
 868
 869       --  Otherwise, allocate new shared string and fill it
 870
 871       else
 872          DR := Allocate (Count);
 873
 874          --  Length of the source string is more than requested, copy
 875          --  corresponding slice.
 876
 877          if Count < SR.Last then
 878             DR.Data (1 .. Count) := SR.Data (1 .. Count);
 879
 880          --  Length of the source string is less than requested, copy all
 881          --  contents and fill others by Pad character.
 882
 883          else
 884             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 885
 886             for J in SR.Last + 1 .. Count loop
 887                DR.Data (J) := Pad;
 888             end loop;
 889          end if;
 890
 891          DR.Last := Count;
 892       end if;
 893
 894       return (AF.Controlled with Reference => DR);
 895    end Head;
 896
 897    procedure Head
 898      (Source : in out Unbounded_String;
 899       Count  : Natural;
 900       Pad    : Character := Space)
 901    is
 902       SR : constant Shared_String_Access := Source.Reference;
 903       DR : Shared_String_Access;
 904
 905    begin
 906       --  Result is empty, reuse empty shared string
 907
 908       if Count = 0 then
 909          Reference (Empty_Shared_String'Access);
 910          Source.Reference := Empty_Shared_String'Access;
 911          Unreference (SR);
 912
 913       --  Result is same as source string, reuse source shared string
 914
 915       elsif Count = SR.Last then
 916          null;
 917
 918       --  Try to reuse existing shared string
 919
 920       elsif Can_Be_Reused (SR, Count) then
 921          if Count > SR.Last then
 922             for J in SR.Last + 1 .. Count loop
 923                SR.Data (J) := Pad;
 924             end loop;
 925          end if;
 926
 927          SR.Last := Count;
 928
 929       --  Otherwise, allocate new shared string and fill it
 930
 931       else
 932          DR := Allocate (Count);
 933
 934          --  Length of the source string is greater than requested, copy
 935          --  corresponding slice.
 936
 937          if Count < SR.Last then
 938             DR.Data (1 .. Count) := SR.Data (1 .. Count);
 939
 940          --  Length of the source string is less than requested, copy all
 941          --  existing data and fill remaining positions with Pad characters.
 942
 943          else
 944             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 945
 946             for J in SR.Last + 1 .. Count loop
 947                DR.Data (J) := Pad;
 948             end loop;
 949          end if;
 950
 951          DR.Last := Count;
 952          Source.Reference := DR;
 953          Unreference (SR);
 954       end if;
 955    end Head;
 956
 957    -----------
 958    -- Index --
 959    -----------
 960
 961    function Index
 962      (Source  : Unbounded_String;
 963       Pattern : String;
 964       Going   : Strings.Direction := Strings.Forward;
 965       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 966    is
 967       SR : constant Shared_String_Access := Source.Reference;
 968    begin
 969       return Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
 970    end Index;
 971
 972    function Index
 973      (Source  : Unbounded_String;
 974       Pattern : String;
 975       Going   : Direction := Forward;
 976       Mapping : Maps.Character_Mapping_Function) return Natural
 977    is
 978       SR : constant Shared_String_Access := Source.Reference;
 979    begin
 980       return Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
 981    end Index;
 982
 983    function Index
 984      (Source : Unbounded_String;
 985       Set    : Maps.Character_Set;
 986       Test   : Strings.Membership := Strings.Inside;
 987       Going  : Strings.Direction  := Strings.Forward) return Natural
 988    is
 989       SR : constant Shared_String_Access := Source.Reference;
 990    begin
 991       return Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going);
 992    end Index;
 993
 994    function Index
 995      (Source  : Unbounded_String;
 996       Pattern : String;
 997       From    : Positive;
 998       Going   : Direction := Forward;
 999       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
1000    is
1001       SR : constant Shared_String_Access := Source.Reference;
1002    begin
1003       return Search.Index
1004         (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1005    end Index;
1006
1007    function Index
1008      (Source  : Unbounded_String;
1009       Pattern : String;
1010       From    : Positive;
1011       Going   : Direction := Forward;
1012       Mapping : Maps.Character_Mapping_Function) return Natural
1013    is
1014       SR : constant Shared_String_Access := Source.Reference;
1015    begin
1016       return Search.Index
1017         (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1018    end Index;
1019
1020    function Index
1021      (Source  : Unbounded_String;
1022       Set     : Maps.Character_Set;
1023       From    : Positive;
1024       Test    : Membership := Inside;
1025       Going   : Direction := Forward) return Natural
1026    is
1027       SR : constant Shared_String_Access := Source.Reference;
1028    begin
1029       return Search.Index (SR.Data (1 .. SR.Last), Set, From, Test, Going);
1030    end Index;
1031
1032    ---------------------
1033    -- Index_Non_Blank --
1034    ---------------------
1035
1036    function Index_Non_Blank
1037      (Source : Unbounded_String;
1038       Going  : Strings.Direction := Strings.Forward) return Natural
1039    is
1040       SR : constant Shared_String_Access := Source.Reference;
1041    begin
1042       return Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going);
1043    end Index_Non_Blank;
1044
1045    function Index_Non_Blank
1046      (Source : Unbounded_String;
1047       From   : Positive;
1048       Going  : Direction := Forward) return Natural
1049    is
1050       SR : constant Shared_String_Access := Source.Reference;
1051    begin
1052       return Search.Index_Non_Blank (SR.Data (1 .. SR.Last), From, Going);
1053    end Index_Non_Blank;
1054
1055    ----------------
1056    -- Initialize --
1057    ----------------
1058
1059    procedure Initialize (Object : in out Unbounded_String) is
1060    begin
1061       Reference (Object.Reference);
1062    end Initialize;
1063
1064    ------------
1065    -- Insert --
1066    ------------
1067
1068    function Insert
1069      (Source   : Unbounded_String;
1070       Before   : Positive;
1071       New_Item : String) return Unbounded_String
1072    is
1073       SR : constant Shared_String_Access := Source.Reference;
1074       DL : constant Natural := SR.Last + New_Item'Length;
1075       DR : Shared_String_Access;
1076
1077    begin
1078       --  Check index first
1079
1080       if Before > SR.Last + 1 then
1081          raise Index_Error;
1082       end if;
1083
1084       --  Result is empty, reuse empty shared string
1085
1086       if DL = 0 then
1087          Reference (Empty_Shared_String'Access);
1088          DR := Empty_Shared_String'Access;
1089
1090       --  Inserted string is empty, reuse source shared string
1091
1092       elsif New_Item'Length = 0 then
1093          Reference (SR);
1094          DR := SR;
1095
1096       --  Otherwise, allocate new shared string and fill it
1097
1098       else
1099          DR := Allocate (DL + DL / Growth_Factor);
1100          DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1101          DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1102          DR.Data (Before + New_Item'Length .. DL) :=
1103            SR.Data (Before .. SR.Last);
1104          DR.Last := DL;
1105       end if;
1106
1107       return (AF.Controlled with Reference => DR);
1108    end Insert;
1109
1110    procedure Insert
1111      (Source   : in out Unbounded_String;
1112       Before   : Positive;
1113       New_Item : String)
1114    is
1115       SR : constant Shared_String_Access := Source.Reference;
1116       DL : constant Natural              := SR.Last + New_Item'Length;
1117       DR : Shared_String_Access;
1118
1119    begin
1120       --  Check bounds
1121
1122       if Before > SR.Last + 1 then
1123          raise Index_Error;
1124       end if;
1125
1126       --  Result is empty string, reuse empty shared string
1127
1128       if DL = 0 then
1129          Reference (Empty_Shared_String'Access);
1130          Source.Reference := Empty_Shared_String'Access;
1131          Unreference (SR);
1132
1133       --  Inserted string is empty, nothing to do
1134
1135       elsif New_Item'Length = 0 then
1136          null;
1137
1138       --  Try to reuse existing shared string first
1139
1140       elsif Can_Be_Reused (SR, DL) then
1141          SR.Data (Before + New_Item'Length .. DL) :=
1142            SR.Data (Before .. SR.Last);
1143          SR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1144          SR.Last := DL;
1145
1146       --  Otherwise, allocate new shared string and fill it
1147
1148       else
1149          DR := Allocate (DL + DL / Growth_Factor);
1150          DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1151          DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1152          DR.Data (Before + New_Item'Length .. DL) :=
1153            SR.Data (Before .. SR.Last);
1154          DR.Last := DL;
1155          Source.Reference := DR;
1156          Unreference (SR);
1157       end if;
1158    end Insert;
1159
1160    ------------
1161    -- Length --
1162    ------------
1163
1164    function Length (Source : Unbounded_String) return Natural is
1165    begin
1166       return Source.Reference.Last;
1167    end Length;
1168
1169    ---------------
1170    -- Overwrite --
1171    ---------------
1172
1173    function Overwrite
1174      (Source   : Unbounded_String;
1175       Position : Positive;
1176       New_Item : String) return Unbounded_String
1177    is
1178       SR : constant Shared_String_Access := Source.Reference;
1179       DL : Natural;
1180       DR : Shared_String_Access;
1181
1182    begin
1183       --  Check bounds
1184
1185       if Position > SR.Last + 1 then
1186          raise Index_Error;
1187       end if;
1188
1189       DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1190
1191       --  Result is empty string, reuse empty shared string
1192
1193       if DL = 0 then
1194          Reference (Empty_Shared_String'Access);
1195          DR := Empty_Shared_String'Access;
1196
1197       --  Result is same as source string, reuse source shared string
1198
1199       elsif New_Item'Length = 0 then
1200          Reference (SR);
1201          DR := SR;
1202
1203       --  Otherwise, allocate new shared string and fill it
1204
1205       else
1206          DR := Allocate (DL);
1207          DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1208          DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1209          DR.Data (Position + New_Item'Length .. DL) :=
1210            SR.Data (Position + New_Item'Length .. SR.Last);
1211          DR.Last := DL;
1212       end if;
1213
1214       return (AF.Controlled with Reference => DR);
1215    end Overwrite;
1216
1217    procedure Overwrite
1218      (Source    : in out Unbounded_String;
1219       Position  : Positive;
1220       New_Item  : String)
1221    is
1222       SR : constant Shared_String_Access := Source.Reference;
1223       DL : Natural;
1224       DR : Shared_String_Access;
1225
1226    begin
1227       --  Bounds check
1228
1229       if Position > SR.Last + 1 then
1230          raise Index_Error;
1231       end if;
1232
1233       DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1234
1235       --  Result is empty string, reuse empty shared string
1236
1237       if DL = 0 then
1238          Reference (Empty_Shared_String'Access);
1239          Source.Reference := Empty_Shared_String'Access;
1240          Unreference (SR);
1241
1242       --  String unchanged, nothing to do
1243
1244       elsif New_Item'Length = 0 then
1245          null;
1246
1247       --  Try to reuse existing shared string
1248
1249       elsif Can_Be_Reused (SR, DL) then
1250          SR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1251          SR.Last := DL;
1252
1253       --  Otherwise allocate new shared string and fill it
1254
1255       else
1256          DR := Allocate (DL);
1257          DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1258          DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1259          DR.Data (Position + New_Item'Length .. DL) :=
1260            SR.Data (Position + New_Item'Length .. SR.Last);
1261          DR.Last := DL;
1262          Source.Reference := DR;
1263          Unreference (SR);
1264       end if;
1265    end Overwrite;
1266
1267    ---------------
1268    -- Reference --
1269    ---------------
1270
1271    procedure Reference (Item : not null Shared_String_Access) is
1272    begin
1273       System.Atomic_Counters.Increment (Item.Counter);
1274    end Reference;
1275
1276    ---------------------
1277    -- Replace_Element --
1278    ---------------------
1279
1280    procedure Replace_Element
1281      (Source : in out Unbounded_String;
1282       Index  : Positive;
1283       By     : Character)
1284    is
1285       SR : constant Shared_String_Access := Source.Reference;
1286       DR : Shared_String_Access;
1287
1288    begin
1289       --  Bounds check
1290
1291       if Index <= SR.Last then
1292
1293          --  Try to reuse existing shared string
1294
1295          if Can_Be_Reused (SR, SR.Last) then
1296             SR.Data (Index) := By;
1297
1298          --  Otherwise allocate new shared string and fill it
1299
1300          else
1301             DR := Allocate (SR.Last);
1302             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
1303             DR.Data (Index) := By;
1304             DR.Last := SR.Last;
1305             Source.Reference := DR;
1306             Unreference (SR);
1307          end if;
1308
1309       else
1310          raise Index_Error;
1311       end if;
1312    end Replace_Element;
1313
1314    -------------------
1315    -- Replace_Slice --
1316    -------------------
1317
1318    function Replace_Slice
1319      (Source : Unbounded_String;
1320       Low    : Positive;
1321       High   : Natural;
1322       By     : String) return Unbounded_String
1323    is
1324       SR : constant Shared_String_Access := Source.Reference;
1325       DL : Natural;
1326       DR : Shared_String_Access;
1327
1328    begin
1329       --  Check bounds
1330
1331       if Low > SR.Last + 1 then
1332          raise Index_Error;
1333       end if;
1334
1335       --  Do replace operation when removed slice is not empty
1336
1337       if High >= Low then
1338          DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
1339          --  This is the number of characters remaining in the string after
1340          --  replacing the slice.
1341
1342          --  Result is empty string, reuse empty shared string
1343
1344          if DL = 0 then
1345             Reference (Empty_Shared_String'Access);
1346             DR := Empty_Shared_String'Access;
1347
1348          --  Otherwise allocate new shared string and fill it
1349
1350          else
1351             DR := Allocate (DL);
1352             DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1353             DR.Data (Low .. Low + By'Length - 1) := By;
1354             DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1355             DR.Last := DL;
1356          end if;
1357
1358          return (AF.Controlled with Reference => DR);
1359
1360       --  Otherwise just insert string
1361
1362       else
1363          return Insert (Source, Low, By);
1364       end if;
1365    end Replace_Slice;
1366
1367    procedure Replace_Slice
1368      (Source : in out Unbounded_String;
1369       Low    : Positive;
1370       High   : Natural;
1371       By     : String)
1372    is
1373       SR : constant Shared_String_Access := Source.Reference;
1374       DL : Natural;
1375       DR : Shared_String_Access;
1376
1377    begin
1378       --  Bounds check
1379
1380       if Low > SR.Last + 1 then
1381          raise Index_Error;
1382       end if;
1383
1384       --  Do replace operation only when replaced slice is not empty
1385
1386       if High >= Low then
1387          DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
1388          --  This is the number of characters remaining in the string after
1389          --  replacing the slice.
1390
1391          --  Result is empty string, reuse empty shared string
1392
1393          if DL = 0 then
1394             Reference (Empty_Shared_String'Access);
1395             Source.Reference := Empty_Shared_String'Access;
1396             Unreference (SR);
1397
1398          --  Try to reuse existing shared string
1399
1400          elsif Can_Be_Reused (SR, DL) then
1401             SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1402             SR.Data (Low .. Low + By'Length - 1) := By;
1403             SR.Last := DL;
1404
1405          --  Otherwise allocate new shared string and fill it
1406
1407          else
1408             DR := Allocate (DL);
1409             DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1410             DR.Data (Low .. Low + By'Length - 1) := By;
1411             DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1412             DR.Last := DL;
1413             Source.Reference := DR;
1414             Unreference (SR);
1415          end if;
1416
1417       --  Otherwise just insert item
1418
1419       else
1420          Insert (Source, Low, By);
1421       end if;
1422    end Replace_Slice;
1423
1424    --------------------------
1425    -- Set_Unbounded_String --
1426    --------------------------
1427
1428    procedure Set_Unbounded_String
1429      (Target : out Unbounded_String;
1430       Source : String)
1431    is
1432       TR : constant Shared_String_Access := Target.Reference;
1433       DR : Shared_String_Access;
1434
1435    begin
1436       --  In case of empty string, reuse empty shared string
1437
1438       if Source'Length = 0 then
1439          Reference (Empty_Shared_String'Access);
1440          Target.Reference := Empty_Shared_String'Access;
1441
1442       else
1443          --  Try to reuse existing shared string
1444
1445          if Can_Be_Reused (TR, Source'Length) then
1446             Reference (TR);
1447             DR := TR;
1448
1449          --  Otherwise allocate new shared string
1450
1451          else
1452             DR := Allocate (Source'Length);
1453             Target.Reference := DR;
1454          end if;
1455
1456          DR.Data (1 .. Source'Length) := Source;
1457          DR.Last := Source'Length;
1458       end if;
1459
1460       Unreference (TR);
1461    end Set_Unbounded_String;
1462
1463    -----------
1464    -- Slice --
1465    -----------
1466
1467    function Slice
1468      (Source : Unbounded_String;
1469       Low    : Positive;
1470       High   : Natural) return String
1471    is
1472       SR : constant Shared_String_Access := Source.Reference;
1473
1474    begin
1475       --  Note: test of High > Length is in accordance with AI95-00128
1476
1477       if Low > SR.Last + 1 or else High > SR.Last then
1478          raise Index_Error;
1479
1480       else
1481          return SR.Data (Low .. High);
1482       end if;
1483    end Slice;
1484
1485    ----------
1486    -- Tail --
1487    ----------
1488
1489    function Tail
1490      (Source : Unbounded_String;
1491       Count  : Natural;
1492       Pad    : Character := Space) return Unbounded_String
1493    is
1494       SR : constant Shared_String_Access := Source.Reference;
1495       DR : Shared_String_Access;
1496
1497    begin
1498       --  For empty result reuse empty shared string
1499
1500       if Count = 0 then
1501          Reference (Empty_Shared_String'Access);
1502          DR := Empty_Shared_String'Access;
1503
1504       --  Result is whole source string, reuse source shared string
1505
1506       elsif Count = SR.Last then
1507          Reference (SR);
1508          DR := SR;
1509
1510       --  Otherwise allocate new shared string and fill it
1511
1512       else
1513          DR := Allocate (Count);
1514
1515          if Count < SR.Last then
1516             DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1517
1518          else
1519             for J in 1 .. Count - SR.Last loop
1520                DR.Data (J) := Pad;
1521             end loop;
1522
1523             DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1524          end if;
1525
1526          DR.Last := Count;
1527       end if;
1528
1529       return (AF.Controlled with Reference => DR);
1530    end Tail;
1531
1532    procedure Tail
1533      (Source : in out Unbounded_String;
1534       Count  : Natural;
1535       Pad    : Character := Space)
1536    is
1537       SR : constant Shared_String_Access := Source.Reference;
1538       DR : Shared_String_Access;
1539
1540       procedure Common
1541         (SR    : Shared_String_Access;
1542          DR    : Shared_String_Access;
1543          Count : Natural);
1544       --  Common code of tail computation. SR/DR can point to the same object
1545
1546       ------------
1547       -- Common --
1548       ------------
1549
1550       procedure Common
1551         (SR    : Shared_String_Access;
1552          DR    : Shared_String_Access;
1553          Count : Natural) is
1554       begin
1555          if Count < SR.Last then
1556             DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1557
1558          else
1559             DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1560
1561             for J in 1 .. Count - SR.Last loop
1562                DR.Data (J) := Pad;
1563             end loop;
1564          end if;
1565
1566          DR.Last := Count;
1567       end Common;
1568
1569    begin
1570       --  Result is empty string, reuse empty shared string
1571
1572       if Count = 0 then
1573          Reference (Empty_Shared_String'Access);
1574          Source.Reference := Empty_Shared_String'Access;
1575          Unreference (SR);
1576
1577       --  Length of the result is the same as length of the source string,
1578       --  reuse source shared string.
1579
1580       elsif Count = SR.Last then
1581          null;
1582
1583       --  Try to reuse existing shared string
1584
1585       elsif Can_Be_Reused (SR, Count) then
1586          Common (SR, SR, Count);
1587
1588       --  Otherwise allocate new shared string and fill it
1589
1590       else
1591          DR := Allocate (Count);
1592          Common (SR, DR, Count);
1593          Source.Reference := DR;
1594          Unreference (SR);
1595       end if;
1596    end Tail;
1597
1598    ---------------
1599    -- To_String --
1600    ---------------
1601
1602    function To_String (Source : Unbounded_String) return String is
1603    begin
1604       return Source.Reference.Data (1 .. Source.Reference.Last);
1605    end To_String;
1606
1607    -------------------------
1608    -- To_Unbounded_String --
1609    -------------------------
1610
1611    function To_Unbounded_String (Source : String) return Unbounded_String is
1612       DR : Shared_String_Access;
1613
1614    begin
1615       if Source'Length = 0 then
1616          Reference (Empty_Shared_String'Access);
1617          DR := Empty_Shared_String'Access;
1618
1619       else
1620          DR := Allocate (Source'Length);
1621          DR.Data (1 .. Source'Length) := Source;
1622          DR.Last := Source'Length;
1623       end if;
1624
1625       return (AF.Controlled with Reference => DR);
1626    end To_Unbounded_String;
1627
1628    function To_Unbounded_String (Length : Natural) return Unbounded_String is
1629       DR : Shared_String_Access;
1630
1631    begin
1632       if Length = 0 then
1633          Reference (Empty_Shared_String'Access);
1634          DR := Empty_Shared_String'Access;
1635
1636       else
1637          DR := Allocate (Length);
1638          DR.Last := Length;
1639       end if;
1640
1641       return (AF.Controlled with Reference => DR);
1642    end To_Unbounded_String;
1643
1644    ---------------
1645    -- Translate --
1646    ---------------
1647
1648    function Translate
1649      (Source  : Unbounded_String;
1650       Mapping : Maps.Character_Mapping) return Unbounded_String
1651    is
1652       SR : constant Shared_String_Access := Source.Reference;
1653       DR : Shared_String_Access;
1654
1655    begin
1656       --  Nothing to translate, reuse empty shared string
1657
1658       if SR.Last = 0 then
1659          Reference (Empty_Shared_String'Access);
1660          DR := Empty_Shared_String'Access;
1661
1662       --  Otherwise, allocate new shared string and fill it
1663
1664       else
1665          DR := Allocate (SR.Last);
1666
1667          for J in 1 .. SR.Last loop
1668             DR.Data (J) := Value (Mapping, SR.Data (J));
1669          end loop;
1670
1671          DR.Last := SR.Last;
1672       end if;
1673
1674       return (AF.Controlled with Reference => DR);
1675    end Translate;
1676
1677    procedure Translate
1678      (Source  : in out Unbounded_String;
1679       Mapping : Maps.Character_Mapping)
1680    is
1681       SR : constant Shared_String_Access := Source.Reference;
1682       DR : Shared_String_Access;
1683
1684    begin
1685       --  Nothing to translate
1686
1687       if SR.Last = 0 then
1688          null;
1689
1690       --  Try to reuse shared string
1691
1692       elsif Can_Be_Reused (SR, SR.Last) then
1693          for J in 1 .. SR.Last loop
1694             SR.Data (J) := Value (Mapping, SR.Data (J));
1695          end loop;
1696
1697       --  Otherwise, allocate new shared string
1698
1699       else
1700          DR := Allocate (SR.Last);
1701
1702          for J in 1 .. SR.Last loop
1703             DR.Data (J) := Value (Mapping, SR.Data (J));
1704          end loop;
1705
1706          DR.Last := SR.Last;
1707          Source.Reference := DR;
1708          Unreference (SR);
1709       end if;
1710    end Translate;
1711
1712    function Translate
1713      (Source  : Unbounded_String;
1714       Mapping : Maps.Character_Mapping_Function) return Unbounded_String
1715    is
1716       SR : constant Shared_String_Access := Source.Reference;
1717       DR : Shared_String_Access;
1718
1719    begin
1720       --  Nothing to translate, reuse empty shared string
1721
1722       if SR.Last = 0 then
1723          Reference (Empty_Shared_String'Access);
1724          DR := Empty_Shared_String'Access;
1725
1726       --  Otherwise, allocate new shared string and fill it
1727
1728       else
1729          DR := Allocate (SR.Last);
1730
1731          for J in 1 .. SR.Last loop
1732             DR.Data (J) := Mapping.all (SR.Data (J));
1733          end loop;
1734
1735          DR.Last := SR.Last;
1736       end if;
1737
1738       return (AF.Controlled with Reference => DR);
1739
1740    exception
1741       when others =>
1742          Unreference (DR);
1743
1744          raise;
1745    end Translate;
1746
1747    procedure Translate
1748      (Source  : in out Unbounded_String;
1749       Mapping : Maps.Character_Mapping_Function)
1750    is
1751       SR : constant Shared_String_Access := Source.Reference;
1752       DR : Shared_String_Access;
1753
1754    begin
1755       --  Nothing to translate
1756
1757       if SR.Last = 0 then
1758          null;
1759
1760       --  Try to reuse shared string
1761
1762       elsif Can_Be_Reused (SR, SR.Last) then
1763          for J in 1 .. SR.Last loop
1764             SR.Data (J) := Mapping.all (SR.Data (J));
1765          end loop;
1766
1767       --  Otherwise allocate new shared string and fill it
1768
1769       else
1770          DR := Allocate (SR.Last);
1771
1772          for J in 1 .. SR.Last loop
1773             DR.Data (J) := Mapping.all (SR.Data (J));
1774          end loop;
1775
1776          DR.Last := SR.Last;
1777          Source.Reference := DR;
1778          Unreference (SR);
1779       end if;
1780
1781    exception
1782       when others =>
1783          if DR /= null then
1784             Unreference (DR);
1785          end if;
1786
1787          raise;
1788    end Translate;
1789
1790    ----------
1791    -- Trim --
1792    ----------
1793
1794    function Trim
1795      (Source : Unbounded_String;
1796       Side   : Trim_End) return Unbounded_String
1797    is
1798       SR   : constant Shared_String_Access := Source.Reference;
1799       DL   : Natural;
1800       DR   : Shared_String_Access;
1801       Low  : Natural;
1802       High : Natural;
1803
1804    begin
1805       Low := Index_Non_Blank (Source, Forward);
1806
1807       --  All blanks, reuse empty shared string
1808
1809       if Low = 0 then
1810          Reference (Empty_Shared_String'Access);
1811          DR := Empty_Shared_String'Access;
1812
1813       else
1814          case Side is
1815             when Left =>
1816                High := SR.Last;
1817                DL   := SR.Last - Low + 1;
1818
1819             when Right =>
1820                Low  := 1;
1821                High := Index_Non_Blank (Source, Backward);
1822                DL   := High;
1823
1824             when Both =>
1825                High := Index_Non_Blank (Source, Backward);
1826                DL   := High - Low + 1;
1827          end case;
1828
1829          --  Length of the result is the same as length of the source string,
1830          --  reuse source shared string.
1831
1832          if DL = SR.Last then
1833             Reference (SR);
1834             DR := SR;
1835
1836          --  Otherwise, allocate new shared string
1837
1838          else
1839             DR := Allocate (DL);
1840             DR.Data (1 .. DL) := SR.Data (Low .. High);
1841             DR.Last := DL;
1842          end if;
1843       end if;
1844
1845       return (AF.Controlled with Reference => DR);
1846    end Trim;
1847
1848    procedure Trim
1849      (Source : in out Unbounded_String;
1850       Side   : Trim_End)
1851    is
1852       SR   : constant Shared_String_Access := Source.Reference;
1853       DL   : Natural;
1854       DR   : Shared_String_Access;
1855       Low  : Natural;
1856       High : Natural;
1857
1858    begin
1859       Low := Index_Non_Blank (Source, Forward);
1860
1861       --  All blanks, reuse empty shared string
1862
1863       if Low = 0 then
1864          Reference (Empty_Shared_String'Access);
1865          Source.Reference := Empty_Shared_String'Access;
1866          Unreference (SR);
1867
1868       else
1869          case Side is
1870             when Left =>
1871                High := SR.Last;
1872                DL   := SR.Last - Low + 1;
1873
1874             when Right =>
1875                Low  := 1;
1876                High := Index_Non_Blank (Source, Backward);
1877                DL   := High;
1878
1879             when Both =>
1880                High := Index_Non_Blank (Source, Backward);
1881                DL   := High - Low + 1;
1882          end case;
1883
1884          --  Length of the result is the same as length of the source string,
1885          --  nothing to do.
1886
1887          if DL = SR.Last then
1888             null;
1889
1890          --  Try to reuse existing shared string
1891
1892          elsif Can_Be_Reused (SR, DL) then
1893             SR.Data (1 .. DL) := SR.Data (Low .. High);
1894             SR.Last := DL;
1895
1896          --  Otherwise, allocate new shared string
1897
1898          else
1899             DR := Allocate (DL);
1900             DR.Data (1 .. DL) := SR.Data (Low .. High);
1901             DR.Last := DL;
1902             Source.Reference := DR;
1903             Unreference (SR);
1904          end if;
1905       end if;
1906    end Trim;
1907
1908    function Trim
1909      (Source : Unbounded_String;
1910       Left   : Maps.Character_Set;
1911       Right  : Maps.Character_Set) return Unbounded_String
1912    is
1913       SR   : constant Shared_String_Access := Source.Reference;
1914       DL   : Natural;
1915       DR   : Shared_String_Access;
1916       Low  : Natural;
1917       High : Natural;
1918
1919    begin
1920       Low := Index (Source, Left, Outside, Forward);
1921
1922       --  Source includes only characters from Left set, reuse empty shared
1923       --  string.
1924
1925       if Low = 0 then
1926          Reference (Empty_Shared_String'Access);
1927          DR := Empty_Shared_String'Access;
1928
1929       else
1930          High := Index (Source, Right, Outside, Backward);
1931          DL   := Integer'Max (0, High - Low + 1);
1932
1933          --  Source includes only characters from Right set or result string
1934          --  is empty, reuse empty shared string.
1935
1936          if High = 0 or else DL = 0 then
1937             Reference (Empty_Shared_String'Access);
1938             DR := Empty_Shared_String'Access;
1939
1940          --  Otherwise, allocate new shared string and fill it
1941
1942          else
1943             DR := Allocate (DL);
1944             DR.Data (1 .. DL) := SR.Data (Low .. High);
1945             DR.Last := DL;
1946          end if;
1947       end if;
1948
1949       return (AF.Controlled with Reference => DR);
1950    end Trim;
1951
1952    procedure Trim
1953      (Source : in out Unbounded_String;
1954       Left   : Maps.Character_Set;
1955       Right  : Maps.Character_Set)
1956    is
1957       SR   : constant Shared_String_Access := Source.Reference;
1958       DL   : Natural;
1959       DR   : Shared_String_Access;
1960       Low  : Natural;
1961       High : Natural;
1962
1963    begin
1964       Low := Index (Source, Left, Outside, Forward);
1965
1966       --  Source includes only characters from Left set, reuse empty shared
1967       --  string.
1968
1969       if Low = 0 then
1970          Reference (Empty_Shared_String'Access);
1971          Source.Reference := Empty_Shared_String'Access;
1972          Unreference (SR);
1973
1974       else
1975          High := Index (Source, Right, Outside, Backward);
1976          DL   := Integer'Max (0, High - Low + 1);
1977
1978          --  Source includes only characters from Right set or result string
1979          --  is empty, reuse empty shared string.
1980
1981          if High = 0 or else DL = 0 then
1982             Reference (Empty_Shared_String'Access);
1983             Source.Reference := Empty_Shared_String'Access;
1984             Unreference (SR);
1985
1986          --  Try to reuse existing shared string
1987
1988          elsif Can_Be_Reused (SR, DL) then
1989             SR.Data (1 .. DL) := SR.Data (Low .. High);
1990             SR.Last := DL;
1991
1992          --  Otherwise, allocate new shared string and fill it
1993
1994          else
1995             DR := Allocate (DL);
1996             DR.Data (1 .. DL) := SR.Data (Low .. High);
1997             DR.Last := DL;
1998             Source.Reference := DR;
1999             Unreference (SR);
2000          end if;
2001       end if;
2002    end Trim;
2003
2004    ---------------------
2005    -- Unbounded_Slice --
2006    ---------------------
2007
2008    function Unbounded_Slice
2009      (Source : Unbounded_String;
2010       Low    : Positive;
2011       High   : Natural) return Unbounded_String
2012    is
2013       SR : constant Shared_String_Access := Source.Reference;
2014       DL : Natural;
2015       DR : Shared_String_Access;
2016
2017    begin
2018       --  Check bounds
2019
2020       if Low > SR.Last + 1 or else High > SR.Last then
2021          raise Index_Error;
2022
2023       --  Result is empty slice, reuse empty shared string
2024
2025       elsif Low > High then
2026          Reference (Empty_Shared_String'Access);
2027          DR := Empty_Shared_String'Access;
2028
2029       --  Otherwise, allocate new shared string and fill it
2030
2031       else
2032          DL := High - Low + 1;
2033          DR := Allocate (DL);
2034          DR.Data (1 .. DL) := SR.Data (Low .. High);
2035          DR.Last := DL;
2036       end if;
2037
2038       return (AF.Controlled with Reference => DR);
2039    end Unbounded_Slice;
2040
2041    procedure Unbounded_Slice
2042      (Source : Unbounded_String;
2043       Target : out Unbounded_String;
2044       Low    : Positive;
2045       High   : Natural)
2046    is
2047       SR : constant Shared_String_Access := Source.Reference;
2048       TR : constant Shared_String_Access := Target.Reference;
2049       DL : Natural;
2050       DR : Shared_String_Access;
2051
2052    begin
2053       --  Check bounds
2054
2055       if Low > SR.Last + 1 or else High > SR.Last then
2056          raise Index_Error;
2057
2058       --  Result is empty slice, reuse empty shared string
2059
2060       elsif Low > High then
2061          Reference (Empty_Shared_String'Access);
2062          Target.Reference := Empty_Shared_String'Access;
2063          Unreference (TR);
2064
2065       else
2066          DL := High - Low + 1;
2067
2068          --  Try to reuse existing shared string
2069
2070          if Can_Be_Reused (TR, DL) then
2071             TR.Data (1 .. DL) := SR.Data (Low .. High);
2072             TR.Last := DL;
2073
2074          --  Otherwise, allocate new shared string and fill it
2075
2076          else
2077             DR := Allocate (DL);
2078             DR.Data (1 .. DL) := SR.Data (Low .. High);
2079             DR.Last := DL;
2080             Target.Reference := DR;
2081             Unreference (TR);
2082          end if;
2083       end if;
2084    end Unbounded_Slice;
2085
2086    -----------------
2087    -- Unreference --
2088    -----------------
2089
2090    procedure Unreference (Item : not null Shared_String_Access) is
2091
2092       procedure Free is
2093         new Ada.Unchecked_Deallocation (Shared_String, Shared_String_Access);
2094
2095       Aux : Shared_String_Access := Item;
2096
2097    begin
2098       if System.Atomic_Counters.Decrement (Aux.Counter) then
2099
2100          --  Reference counter of Empty_Shared_String must never reach zero
2101
2102          pragma Assert (Aux /= Empty_Shared_String'Access);
2103
2104          Free (Aux);
2105       end if;
2106    end Unreference;
2107
2108 end Ada.Strings.Unbounded;