gcc/ada/a-strunb.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-2010, 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.Fixed;
  33 with Ada.Strings.Search;
  34 with Ada.Unchecked_Deallocation;
  35
  36 package body Ada.Strings.Unbounded is
  37
  38    use Ada.Finalization;
  39
  40    ---------
  41    -- "&" --
  42    ---------
  43
  44    function "&"
  45      (Left  : Unbounded_String;
  46       Right : Unbounded_String) return Unbounded_String
  47    is
  48       L_Length : constant Natural := Left.Last;
  49       R_Length : constant Natural := Right.Last;
  50       Result   : Unbounded_String;
  51
  52    begin
  53       Result.Last := L_Length + R_Length;
  54
  55       Result.Reference := new String (1 .. Result.Last);
  56
  57       Result.Reference (1 .. L_Length) :=
  58         Left.Reference (1 .. Left.Last);
  59       Result.Reference (L_Length + 1 .. Result.Last) :=
  60         Right.Reference (1 .. Right.Last);
  61
  62       return Result;
  63    end "&";
  64
  65    function "&"
  66      (Left  : Unbounded_String;
  67       Right : String) return Unbounded_String
  68    is
  69       L_Length : constant Natural := Left.Last;
  70       Result   : Unbounded_String;
  71
  72    begin
  73       Result.Last := L_Length + Right'Length;
  74
  75       Result.Reference := new String (1 .. Result.Last);
  76
  77       Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
  78       Result.Reference (L_Length + 1 .. Result.Last) := Right;
  79
  80       return Result;
  81    end "&";
  82
  83    function "&"
  84      (Left  : String;
  85       Right : Unbounded_String) return Unbounded_String
  86    is
  87       R_Length : constant Natural := Right.Last;
  88       Result   : Unbounded_String;
  89
  90    begin
  91       Result.Last := Left'Length + R_Length;
  92
  93       Result.Reference := new String (1 .. Result.Last);
  94
  95       Result.Reference (1 .. Left'Length) := Left;
  96       Result.Reference (Left'Length + 1 .. Result.Last) :=
  97         Right.Reference (1 .. Right.Last);
  98
  99       return Result;
 100    end "&";
 101
 102    function "&"
 103      (Left  : Unbounded_String;
 104       Right : Character) return Unbounded_String
 105    is
 106       Result : Unbounded_String;
 107
 108    begin
 109       Result.Last := Left.Last + 1;
 110
 111       Result.Reference := new String (1 .. Result.Last);
 112
 113       Result.Reference (1 .. Result.Last - 1) :=
 114         Left.Reference (1 .. Left.Last);
 115       Result.Reference (Result.Last) := Right;
 116
 117       return Result;
 118    end "&";
 119
 120    function "&"
 121      (Left  : Character;
 122       Right : Unbounded_String) return Unbounded_String
 123    is
 124       Result : Unbounded_String;
 125
 126    begin
 127       Result.Last := Right.Last + 1;
 128
 129       Result.Reference := new String (1 .. Result.Last);
 130       Result.Reference (1) := Left;
 131       Result.Reference (2 .. Result.Last) :=
 132         Right.Reference (1 .. Right.Last);
 133       return Result;
 134    end "&";
 135
 136    ---------
 137    -- "*" --
 138    ---------
 139
 140    function "*"
 141      (Left  : Natural;
 142       Right : Character) return Unbounded_String
 143    is
 144       Result : Unbounded_String;
 145
 146    begin
 147       Result.Last   := Left;
 148
 149       Result.Reference := new String (1 .. Left);
 150       for J in Result.Reference'Range loop
 151          Result.Reference (J) := Right;
 152       end loop;
 153
 154       return Result;
 155    end "*";
 156
 157    function "*"
 158      (Left  : Natural;
 159       Right : String) return Unbounded_String
 160    is
 161       Len    : constant Natural := Right'Length;
 162       K      : Positive;
 163       Result : Unbounded_String;
 164
 165    begin
 166       Result.Last := Left * Len;
 167
 168       Result.Reference := new String (1 .. Result.Last);
 169
 170       K := 1;
 171       for J in 1 .. Left loop
 172          Result.Reference (K .. K + Len - 1) := Right;
 173          K := K + Len;
 174       end loop;
 175
 176       return Result;
 177    end "*";
 178
 179    function "*"
 180      (Left  : Natural;
 181       Right : Unbounded_String) return Unbounded_String
 182    is
 183       Len    : constant Natural := Right.Last;
 184       K      : Positive;
 185       Result : Unbounded_String;
 186
 187    begin
 188       Result.Last := Left * Len;
 189
 190       Result.Reference := new String (1 .. Result.Last);
 191
 192       K := 1;
 193       for J in 1 .. Left loop
 194          Result.Reference (K .. K + Len - 1) :=
 195            Right.Reference (1 .. Right.Last);
 196          K := K + Len;
 197       end loop;
 198
 199       return Result;
 200    end "*";
 201
 202    ---------
 203    -- "<" --
 204    ---------
 205
 206    function "<"
 207      (Left  : Unbounded_String;
 208       Right : Unbounded_String) return Boolean
 209    is
 210    begin
 211       return
 212         Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
 213    end "<";
 214
 215    function "<"
 216      (Left  : Unbounded_String;
 217       Right : String) return Boolean
 218    is
 219    begin
 220       return Left.Reference (1 .. Left.Last) < Right;
 221    end "<";
 222
 223    function "<"
 224      (Left  : String;
 225       Right : Unbounded_String) return Boolean
 226    is
 227    begin
 228       return Left < Right.Reference (1 .. Right.Last);
 229    end "<";
 230
 231    ----------
 232    -- "<=" --
 233    ----------
 234
 235    function "<="
 236      (Left  : Unbounded_String;
 237       Right : Unbounded_String) return Boolean
 238    is
 239    begin
 240       return
 241         Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
 242    end "<=";
 243
 244    function "<="
 245      (Left  : Unbounded_String;
 246       Right : String) return Boolean
 247    is
 248    begin
 249       return Left.Reference (1 .. Left.Last) <= Right;
 250    end "<=";
 251
 252    function "<="
 253      (Left  : String;
 254       Right : Unbounded_String) return Boolean
 255    is
 256    begin
 257       return Left <= Right.Reference (1 .. Right.Last);
 258    end "<=";
 259
 260    ---------
 261    -- "=" --
 262    ---------
 263
 264    function "="
 265      (Left  : Unbounded_String;
 266       Right : Unbounded_String) return Boolean
 267    is
 268    begin
 269       return
 270         Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
 271    end "=";
 272
 273    function "="
 274      (Left  : Unbounded_String;
 275       Right : String) return Boolean
 276    is
 277    begin
 278       return Left.Reference (1 .. Left.Last) = Right;
 279    end "=";
 280
 281    function "="
 282      (Left  : String;
 283       Right : Unbounded_String) return Boolean
 284    is
 285    begin
 286       return Left = Right.Reference (1 .. Right.Last);
 287    end "=";
 288
 289    ---------
 290    -- ">" --
 291    ---------
 292
 293    function ">"
 294      (Left  : Unbounded_String;
 295       Right : Unbounded_String) return Boolean
 296    is
 297    begin
 298       return
 299         Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
 300    end ">";
 301
 302    function ">"
 303      (Left  : Unbounded_String;
 304       Right : String) return Boolean
 305    is
 306    begin
 307       return Left.Reference (1 .. Left.Last) > Right;
 308    end ">";
 309
 310    function ">"
 311      (Left  : String;
 312       Right : Unbounded_String) return Boolean
 313    is
 314    begin
 315       return Left > Right.Reference (1 .. Right.Last);
 316    end ">";
 317
 318    ----------
 319    -- ">=" --
 320    ----------
 321
 322    function ">="
 323      (Left  : Unbounded_String;
 324       Right : Unbounded_String) return Boolean
 325    is
 326    begin
 327       return
 328         Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
 329    end ">=";
 330
 331    function ">="
 332      (Left  : Unbounded_String;
 333       Right : String) return Boolean
 334    is
 335    begin
 336       return Left.Reference (1 .. Left.Last) >= Right;
 337    end ">=";
 338
 339    function ">="
 340      (Left  : String;
 341       Right : Unbounded_String) return Boolean
 342    is
 343    begin
 344       return Left >= Right.Reference (1 .. Right.Last);
 345    end ">=";
 346
 347    ------------
 348    -- Adjust --
 349    ------------
 350
 351    procedure Adjust (Object : in out Unbounded_String) is
 352    begin
 353       --  Copy string, except we do not copy the statically allocated null
 354       --  string since it can never be deallocated. Note that we do not copy
 355       --  extra string room here to avoid dragging unused allocated memory.
 356
 357       if Object.Reference /= Null_String'Access then
 358          Object.Reference := new String'(Object.Reference (1 .. Object.Last));
 359       end if;
 360    end Adjust;
 361
 362    ------------
 363    -- Append --
 364    ------------
 365
 366    procedure Append
 367      (Source   : in out Unbounded_String;
 368       New_Item : Unbounded_String)
 369    is
 370    begin
 371       Realloc_For_Chunk (Source, New_Item.Last);
 372       Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
 373         New_Item.Reference (1 .. New_Item.Last);
 374       Source.Last := Source.Last + New_Item.Last;
 375    end Append;
 376
 377    procedure Append
 378      (Source   : in out Unbounded_String;
 379       New_Item : String)
 380    is
 381    begin
 382       Realloc_For_Chunk (Source, New_Item'Length);
 383       Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
 384         New_Item;
 385       Source.Last := Source.Last + New_Item'Length;
 386    end Append;
 387
 388    procedure Append
 389      (Source   : in out Unbounded_String;
 390       New_Item : Character)
 391    is
 392    begin
 393       Realloc_For_Chunk (Source, 1);
 394       Source.Reference (Source.Last + 1) := New_Item;
 395       Source.Last := Source.Last + 1;
 396    end Append;
 397
 398    -----------
 399    -- Count --
 400    -----------
 401
 402    function Count
 403      (Source  : Unbounded_String;
 404       Pattern : String;
 405       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 406    is
 407    begin
 408       return
 409         Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
 410    end Count;
 411
 412    function Count
 413      (Source  : Unbounded_String;
 414       Pattern : String;
 415       Mapping : Maps.Character_Mapping_Function) return Natural
 416    is
 417    begin
 418       return
 419         Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
 420    end Count;
 421
 422    function Count
 423      (Source : Unbounded_String;
 424       Set    : Maps.Character_Set) return Natural
 425    is
 426    begin
 427       return Search.Count (Source.Reference (1 .. Source.Last), Set);
 428    end Count;
 429
 430    ------------
 431    -- Delete --
 432    ------------
 433
 434    function Delete
 435      (Source  : Unbounded_String;
 436       From    : Positive;
 437       Through : Natural) return Unbounded_String
 438    is
 439    begin
 440       return
 441         To_Unbounded_String
 442           (Fixed.Delete (Source.Reference (1 .. Source.Last), From, Through));
 443    end Delete;
 444
 445    procedure Delete
 446      (Source  : in out Unbounded_String;
 447       From    : Positive;
 448       Through : Natural)
 449    is
 450    begin
 451       if From > Through then
 452          null;
 453
 454       elsif From < Source.Reference'First or else Through > Source.Last then
 455          raise Index_Error;
 456
 457       else
 458          declare
 459             Len : constant Natural := Through - From + 1;
 460
 461          begin
 462             Source.Reference (From .. Source.Last - Len) :=
 463               Source.Reference (Through + 1 .. Source.Last);
 464             Source.Last := Source.Last - Len;
 465          end;
 466       end if;
 467    end Delete;
 468
 469    -------------
 470    -- Element --
 471    -------------
 472
 473    function Element
 474      (Source : Unbounded_String;
 475       Index  : Positive) return Character
 476    is
 477    begin
 478       if Index <= Source.Last then
 479          return Source.Reference (Index);
 480       else
 481          raise Strings.Index_Error;
 482       end if;
 483    end Element;
 484
 485    --------------
 486    -- Finalize --
 487    --------------
 488
 489    procedure Finalize (Object : in out Unbounded_String) is
 490       procedure Deallocate is
 491          new Ada.Unchecked_Deallocation (String, String_Access);
 492
 493    begin
 494       --  Note: Don't try to free statically allocated null string
 495
 496       if Object.Reference /= Null_String'Access then
 497          Deallocate (Object.Reference);
 498          Object.Reference := Null_Unbounded_String.Reference;
 499          Object.Last := 0;
 500       end if;
 501    end Finalize;
 502
 503    ----------------
 504    -- Find_Token --
 505    ----------------
 506
 507    procedure Find_Token
 508      (Source : Unbounded_String;
 509       Set    : Maps.Character_Set;
 510       From   : Positive;
 511       Test   : Strings.Membership;
 512       First  : out Positive;
 513       Last   : out Natural)
 514    is
 515    begin
 516       Search.Find_Token
 517         (Source.Reference (From .. Source.Last), Set, Test, First, Last);
 518    end Find_Token;
 519
 520    procedure Find_Token
 521      (Source : Unbounded_String;
 522       Set    : Maps.Character_Set;
 523       Test   : Strings.Membership;
 524       First  : out Positive;
 525       Last   : out Natural)
 526    is
 527    begin
 528       Search.Find_Token
 529         (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
 530    end Find_Token;
 531
 532    ----------
 533    -- Free --
 534    ----------
 535
 536    procedure Free (X : in out String_Access) is
 537       procedure Deallocate is
 538          new Ada.Unchecked_Deallocation (String, String_Access);
 539
 540    begin
 541       --  Note: Do not try to free statically allocated null string
 542
 543       if X /= Null_Unbounded_String.Reference then
 544          Deallocate (X);
 545       end if;
 546    end Free;
 547
 548    ----------
 549    -- Head --
 550    ----------
 551
 552    function Head
 553      (Source : Unbounded_String;
 554       Count  : Natural;
 555       Pad    : Character := Space) return Unbounded_String
 556    is
 557    begin
 558       return To_Unbounded_String
 559         (Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
 560    end Head;
 561
 562    procedure Head
 563      (Source : in out Unbounded_String;
 564       Count  : Natural;
 565       Pad    : Character := Space)
 566    is
 567       Old : String_Access := Source.Reference;
 568    begin
 569       Source.Reference :=
 570         new String'(Fixed.Head (Source.Reference (1 .. Source.Last),
 571                     Count, Pad));
 572       Source.Last := Source.Reference'Length;
 573       Free (Old);
 574    end Head;
 575
 576    -----------
 577    -- Index --
 578    -----------
 579
 580    function Index
 581      (Source  : Unbounded_String;
 582       Pattern : String;
 583       Going   : Strings.Direction := Strings.Forward;
 584       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 585    is
 586    begin
 587       return Search.Index
 588         (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
 589    end Index;
 590
 591    function Index
 592      (Source  : Unbounded_String;
 593       Pattern : String;
 594       Going   : Direction := Forward;
 595       Mapping : Maps.Character_Mapping_Function) return Natural
 596    is
 597    begin
 598       return Search.Index
 599         (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
 600    end Index;
 601
 602    function Index
 603      (Source : Unbounded_String;
 604       Set    : Maps.Character_Set;
 605       Test   : Strings.Membership := Strings.Inside;
 606       Going  : Strings.Direction  := Strings.Forward) return Natural
 607    is
 608    begin
 609       return Search.Index
 610         (Source.Reference (1 .. Source.Last), Set, Test, Going);
 611    end Index;
 612
 613    function Index
 614      (Source  : Unbounded_String;
 615       Pattern : String;
 616       From    : Positive;
 617       Going   : Direction := Forward;
 618       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 619    is
 620    begin
 621       return Search.Index
 622         (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
 623    end Index;
 624
 625    function Index
 626      (Source  : Unbounded_String;
 627       Pattern : String;
 628       From    : Positive;
 629       Going   : Direction := Forward;
 630       Mapping : Maps.Character_Mapping_Function) return Natural
 631    is
 632    begin
 633       return Search.Index
 634         (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
 635    end Index;
 636
 637    function Index
 638      (Source  : Unbounded_String;
 639       Set     : Maps.Character_Set;
 640       From    : Positive;
 641       Test    : Membership := Inside;
 642       Going   : Direction := Forward) return Natural
 643    is
 644    begin
 645       return Search.Index
 646         (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
 647    end Index;
 648
 649    function Index_Non_Blank
 650      (Source : Unbounded_String;
 651       Going  : Strings.Direction := Strings.Forward) return Natural
 652    is
 653    begin
 654       return
 655         Search.Index_Non_Blank
 656           (Source.Reference (1 .. Source.Last), Going);
 657    end Index_Non_Blank;
 658
 659    function Index_Non_Blank
 660      (Source : Unbounded_String;
 661       From   : Positive;
 662       Going  : Direction := Forward) return Natural
 663    is
 664    begin
 665       return
 666         Search.Index_Non_Blank
 667           (Source.Reference (1 .. Source.Last), From, Going);
 668    end Index_Non_Blank;
 669
 670    ----------------
 671    -- Initialize --
 672    ----------------
 673
 674    procedure Initialize (Object : in out Unbounded_String) is
 675    begin
 676       Object.Reference := Null_Unbounded_String.Reference;
 677       Object.Last      := 0;
 678    end Initialize;
 679
 680    ------------
 681    -- Insert --
 682    ------------
 683
 684    function Insert
 685      (Source   : Unbounded_String;
 686       Before   : Positive;
 687       New_Item : String) return Unbounded_String
 688    is
 689    begin
 690       return To_Unbounded_String
 691         (Fixed.Insert (Source.Reference (1 .. Source.Last), Before, New_Item));
 692    end Insert;
 693
 694    procedure Insert
 695      (Source   : in out Unbounded_String;
 696       Before   : Positive;
 697       New_Item : String)
 698    is
 699    begin
 700       if Before not in Source.Reference'First .. Source.Last + 1 then
 701          raise Index_Error;
 702       end if;
 703
 704       Realloc_For_Chunk (Source, New_Item'Length);
 705
 706       Source.Reference
 707         (Before +  New_Item'Length .. Source.Last + New_Item'Length) :=
 708            Source.Reference (Before .. Source.Last);
 709
 710       Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
 711       Source.Last := Source.Last + New_Item'Length;
 712    end Insert;
 713
 714    ------------
 715    -- Length --
 716    ------------
 717
 718    function Length (Source : Unbounded_String) return Natural is
 719    begin
 720       return Source.Last;
 721    end Length;
 722
 723    ---------------
 724    -- Overwrite --
 725    ---------------
 726
 727    function Overwrite
 728      (Source   : Unbounded_String;
 729       Position : Positive;
 730       New_Item : String) return Unbounded_String
 731    is
 732    begin
 733       return To_Unbounded_String
 734         (Fixed.Overwrite
 735           (Source.Reference (1 .. Source.Last), Position, New_Item));
 736    end Overwrite;
 737
 738    procedure Overwrite
 739      (Source    : in out Unbounded_String;
 740       Position  : Positive;
 741       New_Item  : String)
 742    is
 743       NL : constant Natural := New_Item'Length;
 744    begin
 745       if Position <= Source.Last - NL + 1 then
 746          Source.Reference (Position .. Position + NL - 1) := New_Item;
 747       else
 748          declare
 749             Old : String_Access := Source.Reference;
 750          begin
 751             Source.Reference := new String'
 752               (Fixed.Overwrite
 753                 (Source.Reference (1 .. Source.Last), Position, New_Item));
 754             Source.Last := Source.Reference'Length;
 755             Free (Old);
 756          end;
 757       end if;
 758    end Overwrite;
 759
 760    -----------------------
 761    -- Realloc_For_Chunk --
 762    -----------------------
 763
 764    procedure Realloc_For_Chunk
 765      (Source     : in out Unbounded_String;
 766       Chunk_Size : Natural)
 767    is
 768       Growth_Factor : constant := 32;
 769       --  The growth factor controls how much extra space is allocated when
 770       --  we have to increase the size of an allocated unbounded string. By
 771       --  allocating extra space, we avoid the need to reallocate on every
 772       --  append, particularly important when a string is built up by repeated
 773       --  append operations of small pieces. This is expressed as a factor so
 774       --  32 means add 1/32 of the length of the string as growth space.
 775
 776       Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
 777       --  Allocation will be done by a multiple of Min_Mul_Alloc This causes
 778       --  no memory loss as most (all?) malloc implementations are obliged to
 779       --  align the returned memory on the maximum alignment as malloc does not
 780       --  know the target alignment.
 781
 782       S_Length : constant Natural := Source.Reference'Length;
 783
 784    begin
 785       if Chunk_Size > S_Length - Source.Last then
 786          declare
 787             New_Size : constant Positive :=
 788                          S_Length + Chunk_Size + (S_Length / Growth_Factor);
 789
 790             New_Rounded_Up_Size : constant Positive :=
 791                                     ((New_Size - 1) / Min_Mul_Alloc + 1) *
 792                                        Min_Mul_Alloc;
 793
 794             Tmp : constant String_Access :=
 795                     new String (1 .. New_Rounded_Up_Size);
 796
 797          begin
 798             Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
 799             Free (Source.Reference);
 800             Source.Reference := Tmp;
 801          end;
 802       end if;
 803    end Realloc_For_Chunk;
 804
 805    ---------------------
 806    -- Replace_Element --
 807    ---------------------
 808
 809    procedure Replace_Element
 810      (Source : in out Unbounded_String;
 811       Index  : Positive;
 812       By     : Character)
 813    is
 814    begin
 815       if Index <= Source.Last then
 816          Source.Reference (Index) := By;
 817       else
 818          raise Strings.Index_Error;
 819       end if;
 820    end Replace_Element;
 821
 822    -------------------
 823    -- Replace_Slice --
 824    -------------------
 825
 826    function Replace_Slice
 827      (Source : Unbounded_String;
 828       Low    : Positive;
 829       High   : Natural;
 830       By     : String) return Unbounded_String
 831    is
 832    begin
 833       return To_Unbounded_String
 834         (Fixed.Replace_Slice
 835            (Source.Reference (1 .. Source.Last), Low, High, By));
 836    end Replace_Slice;
 837
 838    procedure Replace_Slice
 839      (Source : in out Unbounded_String;
 840       Low    : Positive;
 841       High   : Natural;
 842       By     : String)
 843    is
 844       Old : String_Access := Source.Reference;
 845    begin
 846       Source.Reference := new String'
 847         (Fixed.Replace_Slice
 848            (Source.Reference (1 .. Source.Last), Low, High, By));
 849       Source.Last := Source.Reference'Length;
 850       Free (Old);
 851    end Replace_Slice;
 852
 853    --------------------------
 854    -- Set_Unbounded_String --
 855    --------------------------
 856
 857    procedure Set_Unbounded_String
 858      (Target : out Unbounded_String;
 859       Source : String)
 860    is
 861       Old : String_Access := Target.Reference;
 862    begin
 863       Target.Last          := Source'Length;
 864       Target.Reference     := new String (1 .. Source'Length);
 865       Target.Reference.all := Source;
 866       Free (Old);
 867    end Set_Unbounded_String;
 868
 869    -----------
 870    -- Slice --
 871    -----------
 872
 873    function Slice
 874      (Source : Unbounded_String;
 875       Low    : Positive;
 876       High   : Natural) return String
 877    is
 878    begin
 879       --  Note: test of High > Length is in accordance with AI95-00128
 880
 881       if Low > Source.Last + 1 or else High > Source.Last then
 882          raise Index_Error;
 883       else
 884          return Source.Reference (Low .. High);
 885       end if;
 886    end Slice;
 887
 888    ----------
 889    -- Tail --
 890    ----------
 891
 892    function Tail
 893      (Source : Unbounded_String;
 894       Count  : Natural;
 895       Pad    : Character := Space) return Unbounded_String is
 896    begin
 897       return To_Unbounded_String
 898         (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
 899    end Tail;
 900
 901    procedure Tail
 902      (Source : in out Unbounded_String;
 903       Count  : Natural;
 904       Pad    : Character := Space)
 905    is
 906       Old : String_Access := Source.Reference;
 907    begin
 908       Source.Reference := new String'
 909         (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
 910       Source.Last := Source.Reference'Length;
 911       Free (Old);
 912    end Tail;
 913
 914    ---------------
 915    -- To_String --
 916    ---------------
 917
 918    function To_String (Source : Unbounded_String) return String is
 919    begin
 920       return Source.Reference (1 .. Source.Last);
 921    end To_String;
 922
 923    -------------------------
 924    -- To_Unbounded_String --
 925    -------------------------
 926
 927    function To_Unbounded_String (Source : String) return Unbounded_String is
 928       Result : Unbounded_String;
 929    begin
 930       --  Do not allocate an empty string: keep the default
 931
 932       if Source'Length > 0 then
 933          Result.Last          := Source'Length;
 934          Result.Reference     := new String (1 .. Source'Length);
 935          Result.Reference.all := Source;
 936       end if;
 937
 938       return Result;
 939    end To_Unbounded_String;
 940
 941    function To_Unbounded_String
 942      (Length : Natural) return Unbounded_String
 943    is
 944       Result : Unbounded_String;
 945
 946    begin
 947       --  Do not allocate an empty string: keep the default
 948
 949       if Length > 0 then
 950          Result.Last      := Length;
 951          Result.Reference := new String (1 .. Length);
 952       end if;
 953
 954       return Result;
 955    end To_Unbounded_String;
 956
 957    ---------------
 958    -- Translate --
 959    ---------------
 960
 961    function Translate
 962      (Source  : Unbounded_String;
 963       Mapping : Maps.Character_Mapping) return Unbounded_String
 964    is
 965    begin
 966       return To_Unbounded_String
 967         (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
 968    end Translate;
 969
 970    procedure Translate
 971      (Source  : in out Unbounded_String;
 972       Mapping : Maps.Character_Mapping)
 973    is
 974    begin
 975       Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
 976    end Translate;
 977
 978    function Translate
 979      (Source  : Unbounded_String;
 980       Mapping : Maps.Character_Mapping_Function) return Unbounded_String
 981    is
 982    begin
 983       return To_Unbounded_String
 984         (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
 985    end Translate;
 986
 987    procedure Translate
 988      (Source  : in out Unbounded_String;
 989       Mapping : Maps.Character_Mapping_Function)
 990    is
 991    begin
 992       Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
 993    end Translate;
 994
 995    ----------
 996    -- Trim --
 997    ----------
 998
 999    function Trim
1000      (Source : Unbounded_String;
1001       Side   : Trim_End) return Unbounded_String
1002    is
1003    begin
1004       return To_Unbounded_String
1005         (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1006    end Trim;
1007
1008    procedure Trim
1009      (Source : in out Unbounded_String;
1010       Side   : Trim_End)
1011    is
1012       Old : String_Access := Source.Reference;
1013    begin
1014       Source.Reference := new String'
1015         (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1016       Source.Last      := Source.Reference'Length;
1017       Free (Old);
1018    end Trim;
1019
1020    function Trim
1021      (Source : Unbounded_String;
1022       Left   : Maps.Character_Set;
1023       Right  : Maps.Character_Set) return Unbounded_String
1024    is
1025    begin
1026       return To_Unbounded_String
1027         (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
1028    end Trim;
1029
1030    procedure Trim
1031      (Source : in out Unbounded_String;
1032       Left   : Maps.Character_Set;
1033       Right  : Maps.Character_Set)
1034    is
1035       Old : String_Access := Source.Reference;
1036    begin
1037       Source.Reference := new String'
1038         (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
1039       Source.Last      := Source.Reference'Length;
1040       Free (Old);
1041    end Trim;
1042
1043    ---------------------
1044    -- Unbounded_Slice --
1045    ---------------------
1046
1047    function Unbounded_Slice
1048      (Source : Unbounded_String;
1049       Low    : Positive;
1050       High   : Natural) return Unbounded_String
1051    is
1052    begin
1053       if Low > Source.Last + 1 or else High > Source.Last then
1054          raise Index_Error;
1055       else
1056          return To_Unbounded_String (Source.Reference.all (Low .. High));
1057       end if;
1058    end Unbounded_Slice;
1059
1060    procedure Unbounded_Slice
1061      (Source : Unbounded_String;
1062       Target : out Unbounded_String;
1063       Low    : Positive;
1064       High   : Natural)
1065    is
1066    begin
1067       if Low > Source.Last + 1 or else High > Source.Last then
1068          raise Index_Error;
1069       else
1070          Target := To_Unbounded_String (Source.Reference.all (Low .. High));
1071       end if;
1072    end Unbounded_Slice;
1073
1074 end Ada.Strings.Unbounded;