gcc/ada/a-stwiun.adb

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