gcc/ada/a-strunb.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                          GNAT RUNTIME 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-2005 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 2,  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.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 with Ada.Strings.Fixed;
  35 with Ada.Strings.Search;
  36 with Ada.Unchecked_Deallocation;
  37
  38 package body Ada.Strings.Unbounded is
  39
  40    use Ada.Finalization;
  41
  42    procedure Realloc_For_Chunk
  43      (Source     : in out Unbounded_String;
  44       Chunk_Size : Natural);
  45    pragma Inline (Realloc_For_Chunk);
  46    --  Adjust the size allocated for the string. Add at least Chunk_Size so it
  47    --  is safe to add a string of this size at the end of the current content.
  48    --  The real size allocated for the string is Chunk_Size + x of the current
  49    --  string size. This buffered handling makes the Append unbounded string
  50    --  routines very fast.
  51
  52    ---------
  53    -- "&" --
  54    ---------
  55
  56    function "&"
  57      (Left  : Unbounded_String;
  58       Right : Unbounded_String) return Unbounded_String
  59    is
  60       L_Length : constant Natural := Left.Last;
  61       R_Length : constant Natural := Right.Last;
  62       Result   : Unbounded_String;
  63
  64    begin
  65       Result.Last := L_Length + R_Length;
  66
  67       Result.Reference := new String (1 .. Result.Last);
  68
  69       Result.Reference (1 .. L_Length) :=
  70         Left.Reference (1 .. Left.Last);
  71       Result.Reference (L_Length + 1 .. Result.Last) :=
  72         Right.Reference (1 .. Right.Last);
  73
  74       return Result;
  75    end "&";
  76
  77    function "&"
  78      (Left  : Unbounded_String;
  79       Right : String) return Unbounded_String
  80    is
  81       L_Length : constant Natural := Left.Last;
  82       Result   : Unbounded_String;
  83
  84    begin
  85       Result.Last := L_Length + Right'Length;
  86
  87       Result.Reference := new String (1 .. Result.Last);
  88
  89       Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
  90       Result.Reference (L_Length + 1 .. Result.Last) := Right;
  91
  92       return Result;
  93    end "&";
  94
  95    function "&"
  96      (Left  : String;
  97       Right : Unbounded_String) return Unbounded_String
  98    is
  99       R_Length : constant Natural := Right.Last;
 100       Result   : Unbounded_String;
 101
 102    begin
 103       Result.Last := Left'Length + R_Length;
 104
 105       Result.Reference := new String (1 .. Result.Last);
 106
 107       Result.Reference (1 .. Left'Length) := Left;
 108       Result.Reference (Left'Length + 1 .. Result.Last) :=
 109         Right.Reference (1 .. Right.Last);
 110
 111       return Result;
 112    end "&";
 113
 114    function "&"
 115      (Left  : Unbounded_String;
 116       Right : Character) return Unbounded_String
 117    is
 118       Result : Unbounded_String;
 119
 120    begin
 121       Result.Last := Left.Last + 1;
 122
 123       Result.Reference := new String (1 .. Result.Last);
 124
 125       Result.Reference (1 .. Result.Last - 1) :=
 126         Left.Reference (1 .. Left.Last);
 127       Result.Reference (Result.Last) := Right;
 128
 129       return Result;
 130    end "&";
 131
 132    function "&"
 133      (Left  : Character;
 134       Right : Unbounded_String) return Unbounded_String
 135    is
 136       Result : Unbounded_String;
 137
 138    begin
 139       Result.Last := Right.Last + 1;
 140
 141       Result.Reference := new String (1 .. Result.Last);
 142       Result.Reference (1) := Left;
 143       Result.Reference (2 .. Result.Last) :=
 144         Right.Reference (1 .. Right.Last);
 145       return Result;
 146    end "&";
 147
 148    ---------
 149    -- "*" --
 150    ---------
 151
 152    function "*"
 153      (Left  : Natural;
 154       Right : Character) return Unbounded_String
 155    is
 156       Result : Unbounded_String;
 157
 158    begin
 159       Result.Last   := Left;
 160
 161       Result.Reference := new String (1 .. Left);
 162       for J in Result.Reference'Range loop
 163          Result.Reference (J) := Right;
 164       end loop;
 165
 166       return Result;
 167    end "*";
 168
 169    function "*"
 170      (Left  : Natural;
 171       Right : String) return Unbounded_String
 172    is
 173       Len    : constant Natural := Right'Length;
 174       K      : Positive;
 175       Result : Unbounded_String;
 176
 177    begin
 178       Result.Last := Left * Len;
 179
 180       Result.Reference := new String (1 .. Result.Last);
 181
 182       K := 1;
 183       for J in 1 .. Left loop
 184          Result.Reference (K .. K + Len - 1) := Right;
 185          K := K + Len;
 186       end loop;
 187
 188       return Result;
 189    end "*";
 190
 191    function "*"
 192      (Left  : Natural;
 193       Right : Unbounded_String) return Unbounded_String
 194    is
 195       Len    : constant Natural := Right.Last;
 196       K      : Positive;
 197       Result : Unbounded_String;
 198
 199    begin
 200       Result.Last := Left * Len;
 201
 202       Result.Reference := new String (1 .. Result.Last);
 203
 204       K := 1;
 205       for I in 1 .. Left loop
 206          Result.Reference (K .. K + Len - 1) :=
 207            Right.Reference (1 .. Right.Last);
 208          K := K + Len;
 209       end loop;
 210
 211       return Result;
 212    end "*";
 213
 214    ---------
 215    -- "<" --
 216    ---------
 217
 218    function "<"
 219      (Left  : Unbounded_String;
 220       Right : Unbounded_String) return Boolean
 221    is
 222    begin
 223       return
 224         Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
 225    end "<";
 226
 227    function "<"
 228      (Left  : Unbounded_String;
 229       Right : String) return Boolean
 230    is
 231    begin
 232       return Left.Reference (1 .. Left.Last) < Right;
 233    end "<";
 234
 235    function "<"
 236      (Left  : String;
 237       Right : Unbounded_String) return Boolean
 238    is
 239    begin
 240       return Left < Right.Reference (1 .. Right.Last);
 241    end "<";
 242
 243    ----------
 244    -- "<=" --
 245    ----------
 246
 247    function "<="
 248      (Left  : Unbounded_String;
 249       Right : Unbounded_String) return Boolean
 250    is
 251    begin
 252       return
 253         Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
 254    end "<=";
 255
 256    function "<="
 257      (Left  : Unbounded_String;
 258       Right : String) return Boolean
 259    is
 260    begin
 261       return Left.Reference (1 .. Left.Last) <= Right;
 262    end "<=";
 263
 264    function "<="
 265      (Left  : String;
 266       Right : Unbounded_String) return Boolean
 267    is
 268    begin
 269       return Left <= Right.Reference (1 .. Right.Last);
 270    end "<=";
 271
 272    ---------
 273    -- "=" --
 274    ---------
 275
 276    function "="
 277      (Left  : Unbounded_String;
 278       Right : Unbounded_String) return Boolean
 279    is
 280    begin
 281       return
 282         Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
 283    end "=";
 284
 285    function "="
 286      (Left  : Unbounded_String;
 287       Right : String) return Boolean
 288    is
 289    begin
 290       return Left.Reference (1 .. Left.Last) = Right;
 291    end "=";
 292
 293    function "="
 294      (Left  : String;
 295       Right : Unbounded_String) return Boolean
 296    is
 297    begin
 298       return Left = Right.Reference (1 .. Right.Last);
 299    end "=";
 300
 301    ---------
 302    -- ">" --
 303    ---------
 304
 305    function ">"
 306      (Left  : Unbounded_String;
 307       Right : Unbounded_String) return Boolean
 308    is
 309    begin
 310       return
 311         Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
 312    end ">";
 313
 314    function ">"
 315      (Left  : Unbounded_String;
 316       Right : String) return Boolean
 317    is
 318    begin
 319       return Left.Reference (1 .. Left.Last) > Right;
 320    end ">";
 321
 322    function ">"
 323      (Left  : String;
 324       Right : Unbounded_String) return Boolean
 325    is
 326    begin
 327       return Left > Right.Reference (1 .. Right.Last);
 328    end ">";
 329
 330    ----------
 331    -- ">=" --
 332    ----------
 333
 334    function ">="
 335      (Left  : Unbounded_String;
 336       Right : Unbounded_String) return Boolean
 337    is
 338    begin
 339       return
 340         Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
 341    end ">=";
 342
 343    function ">="
 344      (Left  : Unbounded_String;
 345       Right : String) return Boolean
 346    is
 347    begin
 348       return Left.Reference (1 .. Left.Last) >= Right;
 349    end ">=";
 350
 351    function ">="
 352      (Left  : String;
 353       Right : Unbounded_String) return Boolean
 354    is
 355    begin
 356       return Left >= Right.Reference (1 .. Right.Last);
 357    end ">=";
 358
 359    ------------
 360    -- Adjust --
 361    ------------
 362
 363    procedure Adjust (Object : in out Unbounded_String) is
 364    begin
 365       --  Copy string, except we do not copy the statically allocated null
 366       --  string, since it can never be deallocated. Note that we do not copy
 367       --  extra string room here to avoid dragging unused allocated memory.
 368
 369       if Object.Reference /= Null_String'Access then
 370          Object.Reference := new String'(Object.Reference (1 .. Object.Last));
 371       end if;
 372    end Adjust;
 373
 374    ------------
 375    -- Append --
 376    ------------
 377
 378    procedure Append
 379      (Source   : in out Unbounded_String;
 380       New_Item : Unbounded_String)
 381    is
 382    begin
 383       Realloc_For_Chunk (Source, New_Item.Last);
 384       Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
 385         New_Item.Reference (1 .. New_Item.Last);
 386       Source.Last := Source.Last + New_Item.Last;
 387    end Append;
 388
 389    procedure Append
 390      (Source   : in out Unbounded_String;
 391       New_Item : String)
 392    is
 393    begin
 394       Realloc_For_Chunk (Source, New_Item'Length);
 395       Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
 396         New_Item;
 397       Source.Last := Source.Last + New_Item'Length;
 398    end Append;
 399
 400    procedure Append
 401      (Source   : in out Unbounded_String;
 402       New_Item : Character)
 403    is
 404    begin
 405       Realloc_For_Chunk (Source, 1);
 406       Source.Reference (Source.Last + 1) := New_Item;
 407       Source.Last := Source.Last + 1;
 408    end Append;
 409
 410    -----------
 411    -- Count --
 412    -----------
 413
 414    function Count
 415      (Source  : Unbounded_String;
 416       Pattern : String;
 417       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 418    is
 419    begin
 420       return
 421         Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
 422    end Count;
 423
 424    function Count
 425      (Source  : Unbounded_String;
 426       Pattern : String;
 427       Mapping : Maps.Character_Mapping_Function) return Natural
 428    is
 429    begin
 430       return
 431         Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
 432    end Count;
 433
 434    function Count
 435      (Source : Unbounded_String;
 436       Set    : Maps.Character_Set) return Natural
 437    is
 438    begin
 439       return Search.Count (Source.Reference (1 .. Source.Last), Set);
 440    end Count;
 441
 442    ------------
 443    -- Delete --
 444    ------------
 445
 446    function Delete
 447      (Source  : Unbounded_String;
 448       From    : Positive;
 449       Through : Natural) return Unbounded_String
 450    is
 451    begin
 452       return
 453         To_Unbounded_String
 454           (Fixed.Delete (Source.Reference (1 .. Source.Last), From, Through));
 455    end Delete;
 456
 457    procedure Delete
 458      (Source  : in out Unbounded_String;
 459       From    : Positive;
 460       Through : Natural)
 461    is
 462    begin
 463       if From > Through then
 464          null;
 465
 466       elsif From < Source.Reference'First or else Through > Source.Last then
 467          raise Index_Error;
 468
 469       else
 470          declare
 471             Len : constant Natural := Through - From + 1;
 472
 473          begin
 474             Source.Reference (From .. Source.Last - Len) :=
 475               Source.Reference (Through + 1 .. Source.Last);
 476             Source.Last := Source.Last - Len;
 477          end;
 478       end if;
 479    end Delete;
 480
 481    -------------
 482    -- Element --
 483    -------------
 484
 485    function Element
 486      (Source : Unbounded_String;
 487       Index  : Positive) return Character
 488    is
 489    begin
 490       if Index <= Source.Last then
 491          return Source.Reference (Index);
 492       else
 493          raise Strings.Index_Error;
 494       end if;
 495    end Element;
 496
 497    --------------
 498    -- Finalize --
 499    --------------
 500
 501    procedure Finalize (Object : in out Unbounded_String) is
 502       procedure Deallocate is
 503          new Ada.Unchecked_Deallocation (String, String_Access);
 504
 505    begin
 506       --  Note: Don't try to free statically allocated null string
 507
 508       if Object.Reference /= Null_String'Access then
 509          Deallocate (Object.Reference);
 510          Object.Reference := Null_Unbounded_String.Reference;
 511          Object.Last := 0;
 512       end if;
 513    end Finalize;
 514
 515    ----------------
 516    -- Find_Token --
 517    ----------------
 518
 519    procedure Find_Token
 520      (Source : Unbounded_String;
 521       Set    : Maps.Character_Set;
 522       Test   : Strings.Membership;
 523       First  : out Positive;
 524       Last   : out Natural)
 525    is
 526    begin
 527       Search.Find_Token
 528         (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
 529    end Find_Token;
 530
 531    ----------
 532    -- Free --
 533    ----------
 534
 535    procedure Free (X : in out String_Access) is
 536       procedure Deallocate is
 537          new Ada.Unchecked_Deallocation (String, String_Access);
 538
 539    begin
 540       --  Note: Do not try to free statically allocated null string
 541
 542       if X /= Null_Unbounded_String.Reference then
 543          Deallocate (X);
 544       end if;
 545    end Free;
 546
 547    ----------
 548    -- Head --
 549    ----------
 550
 551    function Head
 552      (Source : Unbounded_String;
 553       Count  : Natural;
 554       Pad    : Character := Space) return Unbounded_String
 555    is
 556    begin
 557       return To_Unbounded_String
 558         (Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
 559    end Head;
 560
 561    procedure Head
 562      (Source : in out Unbounded_String;
 563       Count  : Natural;
 564       Pad    : Character := Space)
 565    is
 566       Old : String_Access := Source.Reference;
 567    begin
 568       Source.Reference :=
 569         new String'(Fixed.Head (Source.Reference (1 .. Source.Last),
 570                     Count, Pad));
 571       Source.Last := Source.Reference'Length;
 572       Free (Old);
 573    end Head;
 574
 575    -----------
 576    -- Index --
 577    -----------
 578
 579    function Index
 580      (Source  : Unbounded_String;
 581       Pattern : String;
 582       Going   : Strings.Direction := Strings.Forward;
 583       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 584    is
 585    begin
 586       return Search.Index
 587         (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
 588    end Index;
 589
 590    function Index
 591      (Source  : Unbounded_String;
 592       Pattern : String;
 593       Going   : Direction := Forward;
 594       Mapping : Maps.Character_Mapping_Function) return Natural
 595    is
 596    begin
 597       return Search.Index
 598         (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
 599    end Index;
 600
 601    function Index
 602      (Source : Unbounded_String;
 603       Set    : Maps.Character_Set;
 604       Test   : Strings.Membership := Strings.Inside;
 605       Going  : Strings.Direction  := Strings.Forward) return Natural
 606    is
 607    begin
 608       return Search.Index
 609         (Source.Reference (1 .. Source.Last), Set, Test, Going);
 610    end Index;
 611
 612    function Index
 613      (Source  : Unbounded_String;
 614       Pattern : String;
 615       From    : Positive;
 616       Going   : Direction := Forward;
 617       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 618    is
 619    begin
 620       return Search.Index
 621         (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
 622    end Index;
 623
 624    function Index
 625      (Source  : Unbounded_String;
 626       Pattern : String;
 627       From    : Positive;
 628       Going   : Direction := Forward;
 629       Mapping : Maps.Character_Mapping_Function) return Natural
 630    is
 631    begin
 632       return Search.Index
 633         (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
 634    end Index;
 635
 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'Size);
 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 := 50;
 769       S_Length      : constant Natural := Source.Reference'Length;
 770
 771    begin
 772       if Chunk_Size > S_Length - Source.Last then
 773          declare
 774             Alloc_Chunk_Size : constant Positive :=
 775                                  Chunk_Size + (S_Length / Growth_Factor);
 776             Tmp : String_Access;
 777          begin
 778             Tmp := new String (1 .. S_Length + Alloc_Chunk_Size);
 779             Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
 780             Free (Source.Reference);
 781             Source.Reference := Tmp;
 782          end;
 783       end if;
 784    end Realloc_For_Chunk;
 785
 786    ---------------------
 787    -- Replace_Element --
 788    ---------------------
 789
 790    procedure Replace_Element
 791      (Source : in out Unbounded_String;
 792       Index  : Positive;
 793       By     : Character)
 794    is
 795    begin
 796       if Index <= Source.Last then
 797          Source.Reference (Index) := By;
 798       else
 799          raise Strings.Index_Error;
 800       end if;
 801    end Replace_Element;
 802
 803    -------------------
 804    -- Replace_Slice --
 805    -------------------
 806
 807    function Replace_Slice
 808      (Source : Unbounded_String;
 809       Low    : Positive;
 810       High   : Natural;
 811       By     : String) return Unbounded_String
 812    is
 813    begin
 814       return To_Unbounded_String
 815         (Fixed.Replace_Slice
 816            (Source.Reference (1 .. Source.Last), Low, High, By));
 817    end Replace_Slice;
 818
 819    procedure Replace_Slice
 820      (Source : in out Unbounded_String;
 821       Low    : Positive;
 822       High   : Natural;
 823       By     : String)
 824    is
 825       Old : String_Access := Source.Reference;
 826    begin
 827       Source.Reference := new String'
 828         (Fixed.Replace_Slice
 829            (Source.Reference (1 .. Source.Last), Low, High, By));
 830       Source.Last := Source.Reference'Length;
 831       Free (Old);
 832    end Replace_Slice;
 833
 834    --------------------------
 835    -- Set_Unbounded_String --
 836    --------------------------
 837
 838    procedure Set_Unbounded_String
 839      (Target : out Unbounded_String;
 840       Source : String)
 841    is
 842    begin
 843       Target.Last          := Source'Length;
 844       Target.Reference     := new String (1 .. Source'Length);
 845       Target.Reference.all := Source;
 846    end Set_Unbounded_String;
 847
 848    -----------
 849    -- Slice --
 850    -----------
 851
 852    function Slice
 853      (Source : Unbounded_String;
 854       Low    : Positive;
 855       High   : Natural) return String
 856    is
 857    begin
 858       --  Note: test of High > Length is in accordance with AI95-00128
 859
 860       if Low > Source.Last + 1 or else High > Source.Last then
 861          raise Index_Error;
 862       else
 863          return Source.Reference (Low .. High);
 864       end if;
 865    end Slice;
 866
 867    ----------
 868    -- Tail --
 869    ----------
 870
 871    function Tail
 872      (Source : Unbounded_String;
 873       Count  : Natural;
 874       Pad    : Character := Space) return Unbounded_String is
 875    begin
 876       return To_Unbounded_String
 877         (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
 878    end Tail;
 879
 880    procedure Tail
 881      (Source : in out Unbounded_String;
 882       Count  : Natural;
 883       Pad    : Character := Space)
 884    is
 885       Old : String_Access := Source.Reference;
 886    begin
 887       Source.Reference := new String'
 888         (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
 889       Source.Last := Source.Reference'Length;
 890       Free (Old);
 891    end Tail;
 892
 893    ---------------
 894    -- To_String --
 895    ---------------
 896
 897    function To_String (Source : Unbounded_String) return String is
 898    begin
 899       return Source.Reference (1 .. Source.Last);
 900    end To_String;
 901
 902    -------------------------
 903    -- To_Unbounded_String --
 904    -------------------------
 905
 906    function To_Unbounded_String (Source : String) return Unbounded_String is
 907       Result : Unbounded_String;
 908    begin
 909       Result.Last          := Source'Length;
 910       Result.Reference     := new String (1 .. Source'Length);
 911       Result.Reference.all := Source;
 912       return Result;
 913    end To_Unbounded_String;
 914
 915    function To_Unbounded_String
 916      (Length : Natural) return Unbounded_String
 917    is
 918       Result : Unbounded_String;
 919    begin
 920       Result.Last      := Length;
 921       Result.Reference := new String (1 .. Length);
 922       return Result;
 923    end To_Unbounded_String;
 924
 925    ---------------
 926    -- Translate --
 927    ---------------
 928
 929    function Translate
 930      (Source  : Unbounded_String;
 931       Mapping : Maps.Character_Mapping) return Unbounded_String
 932    is
 933    begin
 934       return To_Unbounded_String
 935         (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
 936    end Translate;
 937
 938    procedure Translate
 939      (Source  : in out Unbounded_String;
 940       Mapping : Maps.Character_Mapping)
 941    is
 942    begin
 943       Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
 944    end Translate;
 945
 946    function Translate
 947      (Source  : Unbounded_String;
 948       Mapping : Maps.Character_Mapping_Function) return Unbounded_String
 949    is
 950    begin
 951       return To_Unbounded_String
 952         (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
 953    end Translate;
 954
 955    procedure Translate
 956      (Source  : in out Unbounded_String;
 957       Mapping : Maps.Character_Mapping_Function)
 958    is
 959    begin
 960       Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
 961    end Translate;
 962
 963    ----------
 964    -- Trim --
 965    ----------
 966
 967    function Trim
 968      (Source : Unbounded_String;
 969       Side   : Trim_End) return Unbounded_String
 970    is
 971    begin
 972       return To_Unbounded_String
 973         (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
 974    end Trim;
 975
 976    procedure Trim
 977      (Source : in out Unbounded_String;
 978       Side   : Trim_End)
 979    is
 980       Old : String_Access := Source.Reference;
 981    begin
 982       Source.Reference := new String'
 983         (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
 984       Source.Last      := Source.Reference'Length;
 985       Free (Old);
 986    end Trim;
 987
 988    function Trim
 989      (Source : Unbounded_String;
 990       Left   : Maps.Character_Set;
 991       Right  : Maps.Character_Set) return Unbounded_String
 992    is
 993    begin
 994       return To_Unbounded_String
 995         (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
 996    end Trim;
 997
 998    procedure Trim
 999      (Source : in out Unbounded_String;
1000       Left   : Maps.Character_Set;
1001       Right  : Maps.Character_Set)
1002    is
1003       Old : String_Access := Source.Reference;
1004    begin
1005       Source.Reference := new String'
1006         (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
1007       Source.Last      := Source.Reference'Length;
1008       Free (Old);
1009    end Trim;
1010
1011    ---------------------
1012    -- Unbounded_Slice --
1013    ---------------------
1014
1015    function Unbounded_Slice
1016      (Source : Unbounded_String;
1017       Low    : Positive;
1018       High   : Natural) return Unbounded_String
1019    is
1020    begin
1021       if Low > Source.Last + 1 or else High > Source.Last then
1022          raise Index_Error;
1023       else
1024          return To_Unbounded_String (Source.Reference.all (Low .. High));
1025       end if;
1026    end Unbounded_Slice;
1027
1028    procedure Unbounded_Slice
1029      (Source : Unbounded_String;
1030       Target : out Unbounded_String;
1031       Low    : Positive;
1032       High   : Natural)
1033    is
1034    begin
1035       if Low > Source.Last + 1 or else High > Source.Last then
1036          raise Index_Error;
1037       else
1038          Target := To_Unbounded_String (Source.Reference.all (Low .. High));
1039       end if;
1040    end Unbounded_Slice;
1041
1042 end Ada.Strings.Unbounded;