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