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-2002 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
  48    --  content. The real size allocated for the string is Chunk_Size + x %
  49    --  of the current string size. This buffered handling makes the Append
  50    --  unbounded string routines very fast.
  51
  52    ---------
  53    -- "&" --
  54    ---------
  55
  56    function "&" (Left, Right : Unbounded_String) return Unbounded_String is
  57       L_Length : constant Natural := Left.Last;
  58       R_Length : constant Natural := Right.Last;
  59       Result   : Unbounded_String;
  60
  61    begin
  62       Result.Last := L_Length + R_Length;
  63
  64       Result.Reference := new String (1 .. Result.Last);
  65
  66       Result.Reference (1 .. L_Length) :=
  67         Left.Reference (1 .. Left.Last);
  68       Result.Reference (L_Length + 1 .. Result.Last) :=
  69         Right.Reference (1 .. Right.Last);
  70
  71       return Result;
  72    end "&";
  73
  74    function "&"
  75      (Left  : Unbounded_String;
  76       Right : String)
  77       return  Unbounded_String
  78    is
  79       L_Length : constant Natural := Left.Last;
  80       Result   : Unbounded_String;
  81
  82    begin
  83       Result.Last := L_Length + Right'Length;
  84
  85       Result.Reference := new String (1 .. Result.Last);
  86
  87       Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
  88       Result.Reference (L_Length + 1 .. Result.Last) := Right;
  89
  90       return Result;
  91    end "&";
  92
  93    function "&"
  94      (Left  : String;
  95       Right : Unbounded_String)
  96       return  Unbounded_String
  97    is
  98       R_Length : constant Natural := Right.Last;
  99       Result   : Unbounded_String;
 100
 101    begin
 102       Result.Last := Left'Length + R_Length;
 103
 104       Result.Reference := new String (1 .. Result.Last);
 105
 106       Result.Reference (1 .. Left'Length) := Left;
 107       Result.Reference (Left'Length + 1 .. Result.Last) :=
 108         Right.Reference (1 .. Right.Last);
 109
 110       return Result;
 111    end "&";
 112
 113    function "&"
 114      (Left  : Unbounded_String;
 115       Right : Character)
 116       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)
 135       return  Unbounded_String
 136    is
 137       Result : Unbounded_String;
 138
 139    begin
 140       Result.Last := Right.Last + 1;
 141
 142       Result.Reference := new String (1 .. Result.Last);
 143       Result.Reference (1) := Left;
 144       Result.Reference (2 .. Result.Last) :=
 145         Right.Reference (1 .. Right.Last);
 146       return Result;
 147    end "&";
 148
 149    ---------
 150    -- "*" --
 151    ---------
 152
 153    function "*"
 154      (Left  : Natural;
 155       Right : Character)
 156       return  Unbounded_String
 157    is
 158       Result : Unbounded_String;
 159
 160    begin
 161       Result.Last   := Left;
 162
 163       Result.Reference := new String (1 .. Left);
 164       for J in Result.Reference'Range loop
 165          Result.Reference (J) := Right;
 166       end loop;
 167
 168       return Result;
 169    end "*";
 170
 171    function "*"
 172      (Left  : Natural;
 173       Right : String)
 174      return   Unbounded_String
 175    is
 176       Len    : constant Natural := Right'Length;
 177       K      : Positive;
 178       Result : Unbounded_String;
 179
 180    begin
 181       Result.Last := Left * Len;
 182
 183       Result.Reference := new String (1 .. Result.Last);
 184
 185       K := 1;
 186       for J in 1 .. Left loop
 187          Result.Reference (K .. K + Len - 1) := Right;
 188          K := K + Len;
 189       end loop;
 190
 191       return Result;
 192    end "*";
 193
 194    function "*"
 195      (Left  : Natural;
 196       Right : Unbounded_String)
 197       return  Unbounded_String
 198    is
 199       Len    : constant Natural := Right.Last;
 200       K      : Positive;
 201       Result : Unbounded_String;
 202
 203    begin
 204       Result.Last := Left * Len;
 205
 206       Result.Reference := new String (1 .. Result.Last);
 207
 208       K := 1;
 209       for I in 1 .. Left loop
 210          Result.Reference (K .. K + Len - 1) :=
 211            Right.Reference (1 .. Right.Last);
 212          K := K + Len;
 213       end loop;
 214
 215       return Result;
 216    end "*";
 217
 218    ---------
 219    -- "<" --
 220    ---------
 221
 222    function "<" (Left, Right : Unbounded_String) return Boolean is
 223    begin
 224       return
 225         Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
 226    end "<";
 227
 228    function "<"
 229      (Left  : Unbounded_String;
 230       Right : String)
 231       return  Boolean
 232    is
 233    begin
 234       return Left.Reference (1 .. Left.Last) < Right;
 235    end "<";
 236
 237    function "<"
 238      (Left  : String;
 239       Right : Unbounded_String)
 240       return  Boolean
 241    is
 242    begin
 243       return Left < Right.Reference (1 .. Right.Last);
 244    end "<";
 245
 246    ----------
 247    -- "<=" --
 248    ----------
 249
 250    function "<=" (Left, Right : Unbounded_String) return Boolean 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)
 259       return  Boolean
 260    is
 261    begin
 262       return Left.Reference (1 .. Left.Last) <= Right;
 263    end "<=";
 264
 265    function "<="
 266      (Left  : String;
 267       Right : Unbounded_String)
 268       return  Boolean
 269    is
 270    begin
 271       return Left <= Right.Reference (1 .. Right.Last);
 272    end "<=";
 273
 274    ---------
 275    -- "=" --
 276    ---------
 277
 278    function "=" (Left, Right : Unbounded_String) return Boolean is
 279    begin
 280       return
 281         Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
 282    end "=";
 283
 284    function "="
 285      (Left  : Unbounded_String;
 286       Right : String)
 287       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)
 296       return  Boolean
 297    is
 298    begin
 299       return Left = Right.Reference (1 .. Right.Last);
 300    end "=";
 301
 302    ---------
 303    -- ">" --
 304    ---------
 305
 306    function ">"  (Left, Right : Unbounded_String) return Boolean is
 307    begin
 308       return
 309         Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
 310    end ">";
 311
 312    function ">"
 313      (Left  : Unbounded_String;
 314       Right : String)
 315       return  Boolean
 316    is
 317    begin
 318       return Left.Reference (1 .. Left.Last) > Right;
 319    end ">";
 320
 321    function ">"
 322      (Left  : String;
 323       Right : Unbounded_String)
 324       return  Boolean
 325    is
 326    begin
 327       return Left > Right.Reference (1 .. Right.Last);
 328    end ">";
 329
 330    ----------
 331    -- ">=" --
 332    ----------
 333
 334    function ">=" (Left, Right : Unbounded_String) return Boolean is
 335    begin
 336       return
 337         Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
 338    end ">=";
 339
 340    function ">="
 341      (Left  : Unbounded_String;
 342       Right : String)
 343       return  Boolean
 344    is
 345    begin
 346       return Left.Reference (1 .. Left.Last) >= Right;
 347    end ">=";
 348
 349    function ">="
 350      (Left  : String;
 351       Right : Unbounded_String)
 352       return  Boolean
 353    is
 354    begin
 355       return Left >= Right.Reference (1 .. Right.Last);
 356    end ">=";
 357
 358    ------------
 359    -- Adjust --
 360    ------------
 361
 362    procedure Adjust (Object : in out Unbounded_String) is
 363    begin
 364       --  Copy string, except we do not copy the statically allocated null
 365       --  string, since it can never be deallocated.
 366       --  Note that we do not copy extra string room here to avoid dragging
 367       --  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)
 418       return     Natural
 419    is
 420    begin
 421       return
 422         Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
 423    end Count;
 424
 425    function Count
 426      (Source   : Unbounded_String;
 427       Pattern  : String;
 428       Mapping  : Maps.Character_Mapping_Function)
 429       return     Natural
 430    is
 431    begin
 432       return
 433         Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
 434    end Count;
 435
 436    function Count
 437      (Source   : Unbounded_String;
 438       Set      : Maps.Character_Set)
 439       return     Natural
 440    is
 441    begin
 442       return Search.Count (Source.Reference (1 .. Source.Last), Set);
 443    end Count;
 444
 445    ------------
 446    -- Delete --
 447    ------------
 448
 449    function Delete
 450      (Source  : Unbounded_String;
 451       From    : Positive;
 452       Through : Natural)
 453       return    Unbounded_String
 454    is
 455    begin
 456       return
 457         To_Unbounded_String
 458           (Fixed.Delete (Source.Reference (1 .. Source.Last), From, Through));
 459    end Delete;
 460
 461    procedure Delete
 462      (Source  : in out Unbounded_String;
 463       From    : Positive;
 464       Through : Natural)
 465    is
 466    begin
 467       if From > Through then
 468          null;
 469
 470       elsif From < Source.Reference'First or else Through > Source.Last then
 471          raise Index_Error;
 472
 473       else
 474          declare
 475             Len : constant Natural := Through - From + 1;
 476
 477          begin
 478             Source.Reference (From .. Source.Last - Len) :=
 479               Source.Reference (Through + 1 .. Source.Last);
 480             Source.Last := Source.Last - Len;
 481          end;
 482       end if;
 483    end Delete;
 484
 485    -------------
 486    -- Element --
 487    -------------
 488
 489    function Element
 490      (Source : Unbounded_String;
 491       Index  : Positive)
 492       return   Character
 493    is
 494    begin
 495       if Index <= Source.Last then
 496          return Source.Reference (Index);
 497       else
 498          raise Strings.Index_Error;
 499       end if;
 500    end Element;
 501
 502    --------------
 503    -- Finalize --
 504    --------------
 505
 506    procedure Finalize (Object : in out Unbounded_String) is
 507       procedure Deallocate is
 508          new Ada.Unchecked_Deallocation (String, String_Access);
 509
 510    begin
 511       --  Note: Don't try to free statically allocated null string
 512
 513       if Object.Reference /= Null_String'Access then
 514          Deallocate (Object.Reference);
 515          Object.Reference := Null_Unbounded_String.Reference;
 516          Object.Last := 0;
 517       end if;
 518    end Finalize;
 519
 520    ----------------
 521    -- Find_Token --
 522    ----------------
 523
 524    procedure Find_Token
 525      (Source : Unbounded_String;
 526       Set    : Maps.Character_Set;
 527       Test   : Strings.Membership;
 528       First  : out Positive;
 529       Last   : out Natural)
 530    is
 531    begin
 532       Search.Find_Token
 533         (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
 534    end Find_Token;
 535
 536    ----------
 537    -- Free --
 538    ----------
 539
 540    procedure Free (X : in out String_Access) is
 541       procedure Deallocate is
 542          new Ada.Unchecked_Deallocation (String, String_Access);
 543
 544    begin
 545       --  Note: Do not try to free statically allocated null string
 546
 547       if X /= Null_Unbounded_String.Reference then
 548          Deallocate (X);
 549       end if;
 550    end Free;
 551
 552    ----------
 553    -- Head --
 554    ----------
 555
 556    function Head
 557      (Source : Unbounded_String;
 558       Count  : Natural;
 559       Pad    : Character := Space)
 560       return   Unbounded_String
 561    is
 562    begin
 563       return To_Unbounded_String
 564         (Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
 565    end Head;
 566
 567    procedure Head
 568      (Source : in out Unbounded_String;
 569       Count  : Natural;
 570       Pad    : Character := Space)
 571    is
 572       Old : String_Access := Source.Reference;
 573
 574    begin
 575       Source.Reference :=
 576         new String'(Fixed.Head (Source.Reference (1 .. Source.Last),
 577                     Count, Pad));
 578       Source.Last := Source.Reference'Length;
 579       Free (Old);
 580    end Head;
 581
 582    -----------
 583    -- Index --
 584    -----------
 585
 586    function Index
 587      (Source   : Unbounded_String;
 588       Pattern  : String;
 589       Going    : Strings.Direction := Strings.Forward;
 590       Mapping  : Maps.Character_Mapping := Maps.Identity)
 591       return     Natural
 592    is
 593    begin
 594       return Search.Index
 595         (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
 596    end Index;
 597
 598    function Index
 599      (Source   : Unbounded_String;
 600       Pattern  : String;
 601       Going    : Direction := Forward;
 602       Mapping  : Maps.Character_Mapping_Function)
 603       return     Natural
 604    is
 605    begin
 606       return Search.Index
 607         (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
 608    end Index;
 609
 610    function Index
 611      (Source : Unbounded_String;
 612       Set    : Maps.Character_Set;
 613       Test   : Strings.Membership := Strings.Inside;
 614       Going  : Strings.Direction  := Strings.Forward)
 615       return   Natural
 616    is
 617    begin
 618       return Search.Index
 619         (Source.Reference (1 .. Source.Last), Set, Test, Going);
 620    end Index;
 621
 622    function Index_Non_Blank
 623      (Source : Unbounded_String;
 624       Going  : Strings.Direction := Strings.Forward)
 625       return   Natural
 626    is
 627    begin
 628       return
 629         Search.Index_Non_Blank (Source.Reference (1 .. Source.Last), Going);
 630    end Index_Non_Blank;
 631
 632    ----------------
 633    -- Initialize --
 634    ----------------
 635
 636    procedure Initialize (Object : in out Unbounded_String) is
 637    begin
 638       Object.Reference := Null_Unbounded_String.Reference;
 639       Object.Last      := 0;
 640    end Initialize;
 641
 642    ------------
 643    -- Insert --
 644    ------------
 645
 646    function Insert
 647      (Source   : Unbounded_String;
 648       Before   : Positive;
 649       New_Item : String)
 650       return     Unbounded_String
 651    is
 652    begin
 653       return To_Unbounded_String
 654         (Fixed.Insert (Source.Reference (1 .. Source.Last), Before, New_Item));
 655    end Insert;
 656
 657    procedure Insert
 658      (Source   : in out Unbounded_String;
 659       Before   : Positive;
 660       New_Item : String)
 661    is
 662    begin
 663       if Before not in Source.Reference'First .. Source.Last + 1 then
 664          raise Index_Error;
 665       end if;
 666
 667       Realloc_For_Chunk (Source, New_Item'Size);
 668
 669       Source.Reference
 670         (Before +  New_Item'Length .. Source.Last + New_Item'Length) :=
 671            Source.Reference (Before .. Source.Last);
 672
 673       Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
 674       Source.Last := Source.Last + New_Item'Length;
 675    end Insert;
 676
 677    ------------
 678    -- Length --
 679    ------------
 680
 681    function Length (Source : Unbounded_String) return Natural is
 682    begin
 683       return Source.Last;
 684    end Length;
 685
 686    ---------------
 687    -- Overwrite --
 688    ---------------
 689
 690    function Overwrite
 691      (Source    : Unbounded_String;
 692       Position  : Positive;
 693       New_Item  : String)
 694       return      Unbounded_String is
 695
 696    begin
 697       return To_Unbounded_String
 698         (Fixed.Overwrite
 699           (Source.Reference (1 .. Source.Last), Position, New_Item));
 700    end Overwrite;
 701
 702    procedure Overwrite
 703      (Source    : in out Unbounded_String;
 704       Position  : Positive;
 705       New_Item  : String)
 706    is
 707       NL : constant Natural := New_Item'Length;
 708
 709    begin
 710       if Position <= Source.Last - NL + 1 then
 711          Source.Reference (Position .. Position + NL - 1) := New_Item;
 712
 713       else
 714          declare
 715             Old : String_Access := Source.Reference;
 716
 717          begin
 718             Source.Reference := new String'
 719               (Fixed.Overwrite
 720                 (Source.Reference (1 .. Source.Last), Position, New_Item));
 721             Source.Last := Source.Reference'Length;
 722             Free (Old);
 723          end;
 724       end if;
 725    end Overwrite;
 726
 727    -----------------------
 728    -- Realloc_For_Chunk --
 729    -----------------------
 730
 731    procedure Realloc_For_Chunk
 732      (Source     : in out Unbounded_String;
 733       Chunk_Size : Natural)
 734    is
 735       Growth_Factor : constant := 50;
 736       S_Length      : constant Natural := Source.Reference'Length;
 737
 738    begin
 739       if Chunk_Size > S_Length - Source.Last then
 740          declare
 741             Alloc_Chunk_Size : constant Positive :=
 742                                  Chunk_Size + (S_Length / Growth_Factor);
 743             Tmp : String_Access;
 744
 745          begin
 746             Tmp := new String (1 .. S_Length + Alloc_Chunk_Size);
 747             Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
 748             Free (Source.Reference);
 749             Source.Reference := Tmp;
 750          end;
 751       end if;
 752    end Realloc_For_Chunk;
 753
 754    ---------------------
 755    -- Replace_Element --
 756    ---------------------
 757
 758    procedure Replace_Element
 759      (Source : in out Unbounded_String;
 760       Index  : Positive;
 761       By     : Character)
 762    is
 763    begin
 764       if Index <= Source.Last then
 765          Source.Reference (Index) := By;
 766       else
 767          raise Strings.Index_Error;
 768       end if;
 769    end Replace_Element;
 770
 771    -------------------
 772    -- Replace_Slice --
 773    -------------------
 774
 775    function Replace_Slice
 776      (Source   : Unbounded_String;
 777       Low      : Positive;
 778       High     : Natural;
 779       By       : String)
 780       return     Unbounded_String
 781    is
 782    begin
 783       return To_Unbounded_String
 784         (Fixed.Replace_Slice
 785            (Source.Reference (1 .. Source.Last), Low, High, By));
 786    end Replace_Slice;
 787
 788    procedure Replace_Slice
 789      (Source   : in out Unbounded_String;
 790       Low      : Positive;
 791       High     : Natural;
 792       By       : String)
 793    is
 794       Old : String_Access := Source.Reference;
 795
 796    begin
 797       Source.Reference := new String'
 798         (Fixed.Replace_Slice
 799            (Source.Reference (1 .. Source.Last), Low, High, By));
 800       Source.Last := Source.Reference'Length;
 801       Free (Old);
 802    end Replace_Slice;
 803
 804    -----------
 805    -- Slice --
 806    -----------
 807
 808    function Slice
 809      (Source : Unbounded_String;
 810       Low    : Positive;
 811       High   : Natural)
 812       return   String
 813    is
 814    begin
 815       --  Note: test of High > Length is in accordance with AI95-00128
 816
 817       if Low > Source.Last + 1 or else High > Source.Last then
 818          raise Index_Error;
 819       else
 820          return Source.Reference (Low .. High);
 821       end if;
 822    end Slice;
 823
 824    ----------
 825    -- Tail --
 826    ----------
 827
 828    function Tail
 829      (Source : Unbounded_String;
 830       Count  : Natural;
 831       Pad    : Character := Space)
 832       return   Unbounded_String is
 833
 834    begin
 835       return To_Unbounded_String
 836         (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
 837    end Tail;
 838
 839    procedure Tail
 840      (Source : in out Unbounded_String;
 841       Count  : Natural;
 842       Pad    : Character := Space)
 843    is
 844       Old : String_Access := Source.Reference;
 845
 846    begin
 847       Source.Reference := new String'
 848         (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
 849       Source.Last := Source.Reference'Length;
 850       Free (Old);
 851    end Tail;
 852
 853    ---------------
 854    -- To_String --
 855    ---------------
 856
 857    function To_String (Source : Unbounded_String) return String is
 858    begin
 859       return Source.Reference (1 .. Source.Last);
 860    end To_String;
 861
 862    -------------------------
 863    -- To_Unbounded_String --
 864    -------------------------
 865
 866    function To_Unbounded_String (Source : String) return Unbounded_String is
 867       Result : Unbounded_String;
 868
 869    begin
 870       Result.Last          := Source'Length;
 871       Result.Reference     := new String (1 .. Source'Length);
 872       Result.Reference.all := Source;
 873       return Result;
 874    end To_Unbounded_String;
 875
 876    function To_Unbounded_String
 877      (Length : Natural)
 878       return   Unbounded_String
 879    is
 880       Result : Unbounded_String;
 881
 882    begin
 883       Result.Last      := Length;
 884       Result.Reference := new String (1 .. Length);
 885       return Result;
 886    end To_Unbounded_String;
 887
 888    ---------------
 889    -- Translate --
 890    ---------------
 891
 892    function Translate
 893      (Source  : Unbounded_String;
 894       Mapping : Maps.Character_Mapping)
 895       return    Unbounded_String
 896    is
 897    begin
 898       return To_Unbounded_String
 899         (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
 900    end Translate;
 901
 902    procedure Translate
 903      (Source  : in out Unbounded_String;
 904       Mapping : Maps.Character_Mapping)
 905    is
 906    begin
 907       Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
 908    end Translate;
 909
 910    function Translate
 911      (Source  : Unbounded_String;
 912       Mapping : Maps.Character_Mapping_Function)
 913       return    Unbounded_String
 914    is
 915    begin
 916       return To_Unbounded_String
 917         (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
 918    end Translate;
 919
 920    procedure Translate
 921      (Source  : in out Unbounded_String;
 922       Mapping : Maps.Character_Mapping_Function)
 923    is
 924    begin
 925       Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
 926    end Translate;
 927
 928    ----------
 929    -- Trim --
 930    ----------
 931
 932    function Trim
 933      (Source : Unbounded_String;
 934       Side   : Trim_End)
 935       return   Unbounded_String
 936    is
 937    begin
 938       return To_Unbounded_String
 939         (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
 940    end Trim;
 941
 942    procedure Trim
 943      (Source : in out Unbounded_String;
 944       Side   : Trim_End)
 945    is
 946       Old : String_Access := Source.Reference;
 947
 948    begin
 949       Source.Reference := new String'
 950         (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
 951       Source.Last      := Source.Reference'Length;
 952       Free (Old);
 953    end Trim;
 954
 955    function Trim
 956      (Source : Unbounded_String;
 957       Left   : Maps.Character_Set;
 958       Right  : Maps.Character_Set)
 959       return   Unbounded_String
 960    is
 961    begin
 962       return To_Unbounded_String
 963         (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
 964    end Trim;
 965
 966    procedure Trim
 967      (Source : in out Unbounded_String;
 968       Left   : Maps.Character_Set;
 969       Right  : Maps.Character_Set)
 970    is
 971       Old : String_Access := Source.Reference;
 972
 973    begin
 974       Source.Reference := new String'
 975         (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
 976       Source.Last      := Source.Reference'Length;
 977       Free (Old);
 978    end Trim;
 979
 980 end Ada.Strings.Unbounded;