aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.8.3/gcc/ada/a-stwiun-shared.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.8.3/gcc/ada/a-stwiun-shared.adb')
-rw-r--r--gcc-4.8.3/gcc/ada/a-stwiun-shared.adb2110
1 files changed, 2110 insertions, 0 deletions
diff --git a/gcc-4.8.3/gcc/ada/a-stwiun-shared.adb b/gcc-4.8.3/gcc/ada/a-stwiun-shared.adb
new file mode 100644
index 000000000..6c3be5408
--- /dev/null
+++ b/gcc-4.8.3/gcc/ada/a-stwiun-shared.adb
@@ -0,0 +1,2110 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . S T R I N G S . W I D E _ U N B O U N D E D --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Strings.Wide_Search;
+with Ada.Unchecked_Deallocation;
+
+package body Ada.Strings.Wide_Unbounded is
+
+ use Ada.Strings.Wide_Maps;
+
+ Growth_Factor : constant := 32;
+ -- The growth factor controls how much extra space is allocated when
+ -- we have to increase the size of an allocated unbounded string. By
+ -- allocating extra space, we avoid the need to reallocate on every
+ -- append, particularly important when a string is built up by repeated
+ -- append operations of small pieces. This is expressed as a factor so
+ -- 32 means add 1/32 of the length of the string as growth space.
+
+ Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
+ -- Allocation will be done by a multiple of Min_Mul_Alloc. This causes
+ -- no memory loss as most (all?) malloc implementations are obliged to
+ -- align the returned memory on the maximum alignment as malloc does not
+ -- know the target alignment.
+
+ function Aligned_Max_Length (Max_Length : Natural) return Natural;
+ -- Returns recommended length of the shared string which is greater or
+ -- equal to specified length. Calculation take in sense alignment of
+ -- the allocated memory segments to use memory effectively by
+ -- Append/Insert/etc operations.
+
+ ---------
+ -- "&" --
+ ---------
+
+ function "&"
+ (Left : Unbounded_Wide_String;
+ Right : Unbounded_Wide_String) return Unbounded_Wide_String
+ is
+ LR : constant Shared_Wide_String_Access := Left.Reference;
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+ DL : constant Natural := LR.Last + RR.Last;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Result is an empty string, reuse shared empty string
+
+ if DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Left string is empty, return Rigth string
+
+ elsif LR.Last = 0 then
+ Reference (RR);
+ DR := RR;
+
+ -- Right string is empty, return Left string
+
+ elsif RR.Last = 0 then
+ Reference (LR);
+ DR := LR;
+
+ -- Overwise, allocate new shared string and fill data
+
+ else
+ DR := Allocate (LR.Last + RR.Last);
+ DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
+ DR.Data (LR.Last + 1 .. DL) := RR.Data (1 .. RR.Last);
+ DR.Last := DL;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end "&";
+
+ function "&"
+ (Left : Unbounded_Wide_String;
+ Right : Wide_String) return Unbounded_Wide_String
+ is
+ LR : constant Shared_Wide_String_Access := Left.Reference;
+ DL : constant Natural := LR.Last + Right'Length;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Result is an empty string, reuse shared empty string
+
+ if DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Right is an empty string, return Left string
+
+ elsif Right'Length = 0 then
+ Reference (LR);
+ DR := LR;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL);
+ DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
+ DR.Data (LR.Last + 1 .. DL) := Right;
+ DR.Last := DL;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end "&";
+
+ function "&"
+ (Left : Wide_String;
+ Right : Unbounded_Wide_String) return Unbounded_Wide_String
+ is
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+ DL : constant Natural := Left'Length + RR.Last;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Result is an empty string, reuse shared one
+
+ if DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Left is empty string, return Right string
+
+ elsif Left'Length = 0 then
+ Reference (RR);
+ DR := RR;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL);
+ DR.Data (1 .. Left'Length) := Left;
+ DR.Data (Left'Length + 1 .. DL) := RR.Data (1 .. RR.Last);
+ DR.Last := DL;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end "&";
+
+ function "&"
+ (Left : Unbounded_Wide_String;
+ Right : Wide_Character) return Unbounded_Wide_String
+ is
+ LR : constant Shared_Wide_String_Access := Left.Reference;
+ DL : constant Natural := LR.Last + 1;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ DR := Allocate (DL);
+ DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
+ DR.Data (DL) := Right;
+ DR.Last := DL;
+
+ return (AF.Controlled with Reference => DR);
+ end "&";
+
+ function "&"
+ (Left : Wide_Character;
+ Right : Unbounded_Wide_String) return Unbounded_Wide_String
+ is
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+ DL : constant Natural := 1 + RR.Last;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ DR := Allocate (DL);
+ DR.Data (1) := Left;
+ DR.Data (2 .. DL) := RR.Data (1 .. RR.Last);
+ DR.Last := DL;
+
+ return (AF.Controlled with Reference => DR);
+ end "&";
+
+ ---------
+ -- "*" --
+ ---------
+
+ function "*"
+ (Left : Natural;
+ Right : Wide_Character) return Unbounded_Wide_String
+ is
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Result is an empty string, reuse shared empty string
+
+ if Left = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (Left);
+
+ for J in 1 .. Left loop
+ DR.Data (J) := Right;
+ end loop;
+
+ DR.Last := Left;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end "*";
+
+ function "*"
+ (Left : Natural;
+ Right : Wide_String) return Unbounded_Wide_String
+ is
+ DL : constant Natural := Left * Right'Length;
+ DR : Shared_Wide_String_Access;
+ K : Positive;
+
+ begin
+ -- Result is an empty string, reuse shared empty string
+
+ if DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL);
+ K := 1;
+
+ for J in 1 .. Left loop
+ DR.Data (K .. K + Right'Length - 1) := Right;
+ K := K + Right'Length;
+ end loop;
+
+ DR.Last := DL;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end "*";
+
+ function "*"
+ (Left : Natural;
+ Right : Unbounded_Wide_String) return Unbounded_Wide_String
+ is
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+ DL : constant Natural := Left * RR.Last;
+ DR : Shared_Wide_String_Access;
+ K : Positive;
+
+ begin
+ -- Result is an empty string, reuse shared empty string
+
+ if DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Coefficient is one, just return string itself
+
+ elsif Left = 1 then
+ Reference (RR);
+ DR := RR;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL);
+ K := 1;
+
+ for J in 1 .. Left loop
+ DR.Data (K .. K + RR.Last - 1) := RR.Data (1 .. RR.Last);
+ K := K + RR.Last;
+ end loop;
+
+ DR.Last := DL;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end "*";
+
+ ---------
+ -- "<" --
+ ---------
+
+ function "<"
+ (Left : Unbounded_Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
+ is
+ LR : constant Shared_Wide_String_Access := Left.Reference;
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+ begin
+ return LR.Data (1 .. LR.Last) < RR.Data (1 .. RR.Last);
+ end "<";
+
+ function "<"
+ (Left : Unbounded_Wide_String;
+ Right : Wide_String) return Boolean
+ is
+ LR : constant Shared_Wide_String_Access := Left.Reference;
+ begin
+ return LR.Data (1 .. LR.Last) < Right;
+ end "<";
+
+ function "<"
+ (Left : Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
+ is
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+ begin
+ return Left < RR.Data (1 .. RR.Last);
+ end "<";
+
+ ----------
+ -- "<=" --
+ ----------
+
+ function "<="
+ (Left : Unbounded_Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
+ is
+ LR : constant Shared_Wide_String_Access := Left.Reference;
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+
+ begin
+ -- LR = RR means two strings shares shared string, thus they are equal
+
+ return LR = RR or else LR.Data (1 .. LR.Last) <= RR.Data (1 .. RR.Last);
+ end "<=";
+
+ function "<="
+ (Left : Unbounded_Wide_String;
+ Right : Wide_String) return Boolean
+ is
+ LR : constant Shared_Wide_String_Access := Left.Reference;
+ begin
+ return LR.Data (1 .. LR.Last) <= Right;
+ end "<=";
+
+ function "<="
+ (Left : Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
+ is
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+ begin
+ return Left <= RR.Data (1 .. RR.Last);
+ end "<=";
+
+ ---------
+ -- "=" --
+ ---------
+
+ function "="
+ (Left : Unbounded_Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
+ is
+ LR : constant Shared_Wide_String_Access := Left.Reference;
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+
+ begin
+ return LR = RR or else LR.Data (1 .. LR.Last) = RR.Data (1 .. RR.Last);
+ -- LR = RR means two strings shares shared string, thus they are equal
+ end "=";
+
+ function "="
+ (Left : Unbounded_Wide_String;
+ Right : Wide_String) return Boolean
+ is
+ LR : constant Shared_Wide_String_Access := Left.Reference;
+ begin
+ return LR.Data (1 .. LR.Last) = Right;
+ end "=";
+
+ function "="
+ (Left : Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
+ is
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+ begin
+ return Left = RR.Data (1 .. RR.Last);
+ end "=";
+
+ ---------
+ -- ">" --
+ ---------
+
+ function ">"
+ (Left : Unbounded_Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
+ is
+ LR : constant Shared_Wide_String_Access := Left.Reference;
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+ begin
+ return LR.Data (1 .. LR.Last) > RR.Data (1 .. RR.Last);
+ end ">";
+
+ function ">"
+ (Left : Unbounded_Wide_String;
+ Right : Wide_String) return Boolean
+ is
+ LR : constant Shared_Wide_String_Access := Left.Reference;
+ begin
+ return LR.Data (1 .. LR.Last) > Right;
+ end ">";
+
+ function ">"
+ (Left : Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
+ is
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+ begin
+ return Left > RR.Data (1 .. RR.Last);
+ end ">";
+
+ ----------
+ -- ">=" --
+ ----------
+
+ function ">="
+ (Left : Unbounded_Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
+ is
+ LR : constant Shared_Wide_String_Access := Left.Reference;
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+
+ begin
+ -- LR = RR means two strings shares shared string, thus they are equal
+
+ return LR = RR or else LR.Data (1 .. LR.Last) >= RR.Data (1 .. RR.Last);
+ end ">=";
+
+ function ">="
+ (Left : Unbounded_Wide_String;
+ Right : Wide_String) return Boolean
+ is
+ LR : constant Shared_Wide_String_Access := Left.Reference;
+ begin
+ return LR.Data (1 .. LR.Last) >= Right;
+ end ">=";
+
+ function ">="
+ (Left : Wide_String;
+ Right : Unbounded_Wide_String) return Boolean
+ is
+ RR : constant Shared_Wide_String_Access := Right.Reference;
+ begin
+ return Left >= RR.Data (1 .. RR.Last);
+ end ">=";
+
+ ------------
+ -- Adjust --
+ ------------
+
+ procedure Adjust (Object : in out Unbounded_Wide_String) is
+ begin
+ Reference (Object.Reference);
+ end Adjust;
+
+ ------------------------
+ -- Aligned_Max_Length --
+ ------------------------
+
+ function Aligned_Max_Length (Max_Length : Natural) return Natural is
+ Static_Size : constant Natural :=
+ Empty_Shared_Wide_String'Size / Standard'Storage_Unit;
+ -- Total size of all static components
+
+ Element_Size : constant Natural :=
+ Wide_Character'Size / Standard'Storage_Unit;
+
+ begin
+ return
+ (((Static_Size + Max_Length * Element_Size - 1) / Min_Mul_Alloc + 2)
+ * Min_Mul_Alloc - Static_Size) / Element_Size;
+ end Aligned_Max_Length;
+
+ --------------
+ -- Allocate --
+ --------------
+
+ function Allocate (Max_Length : Natural) return Shared_Wide_String_Access is
+ begin
+ -- Empty string requested, return shared empty string
+
+ if Max_Length = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ return Empty_Shared_Wide_String'Access;
+
+ -- Otherwise, allocate requested space (and probably some more room)
+
+ else
+ return new Shared_Wide_String (Aligned_Max_Length (Max_Length));
+ end if;
+ end Allocate;
+
+ ------------
+ -- Append --
+ ------------
+
+ procedure Append
+ (Source : in out Unbounded_Wide_String;
+ New_Item : Unbounded_Wide_String)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ NR : constant Shared_Wide_String_Access := New_Item.Reference;
+ DL : constant Natural := SR.Last + NR.Last;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Source is an empty string, reuse New_Item data
+
+ if SR.Last = 0 then
+ Reference (NR);
+ Source.Reference := NR;
+ Unreference (SR);
+
+ -- New_Item is empty string, nothing to do
+
+ elsif NR.Last = 0 then
+ null;
+
+ -- Try to reuse existent shared string
+
+ elsif Can_Be_Reused (SR, DL) then
+ SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
+ SR.Last := DL;
+
+ -- Otherwise, allocate new one and fill it
+
+ else
+ DR := Allocate (DL + DL / Growth_Factor);
+ DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
+ DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
+ DR.Last := DL;
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+ end Append;
+
+ procedure Append
+ (Source : in out Unbounded_Wide_String;
+ New_Item : Wide_String)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : constant Natural := SR.Last + New_Item'Length;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- New_Item is an empty string, nothing to do
+
+ if New_Item'Length = 0 then
+ null;
+
+ -- Try to reuse existing shared string
+
+ elsif Can_Be_Reused (SR, DL) then
+ SR.Data (SR.Last + 1 .. DL) := New_Item;
+ SR.Last := DL;
+
+ -- Otherwise, allocate new one and fill it
+
+ else
+ DR := Allocate (DL + DL / Growth_Factor);
+ DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
+ DR.Data (SR.Last + 1 .. DL) := New_Item;
+ DR.Last := DL;
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+ end Append;
+
+ procedure Append
+ (Source : in out Unbounded_Wide_String;
+ New_Item : Wide_Character)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : constant Natural := SR.Last + 1;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Try to reuse existing shared string
+
+ if Can_Be_Reused (SR, SR.Last + 1) then
+ SR.Data (SR.Last + 1) := New_Item;
+ SR.Last := SR.Last + 1;
+
+ -- Otherwise, allocate new one and fill it
+
+ else
+ DR := Allocate (DL + DL / Growth_Factor);
+ DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
+ DR.Data (DL) := New_Item;
+ DR.Last := DL;
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+ end Append;
+
+ -------------------
+ -- Can_Be_Reused --
+ -------------------
+
+ function Can_Be_Reused
+ (Item : Shared_Wide_String_Access;
+ Length : Natural) return Boolean is
+ begin
+ return
+ System.Atomic_Counters.Is_One (Item.Counter)
+ and then Item.Max_Length >= Length
+ and then Item.Max_Length <=
+ Aligned_Max_Length (Length + Length / Growth_Factor);
+ end Can_Be_Reused;
+
+ -----------
+ -- Count --
+ -----------
+
+ function Count
+ (Source : Unbounded_Wide_String;
+ Pattern : Wide_String;
+ Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
+ return Natural
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ return Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
+ end Count;
+
+ function Count
+ (Source : Unbounded_Wide_String;
+ Pattern : Wide_String;
+ Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ return Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
+ end Count;
+
+ function Count
+ (Source : Unbounded_Wide_String;
+ Set : Wide_Maps.Wide_Character_Set) return Natural
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ return Wide_Search.Count (SR.Data (1 .. SR.Last), Set);
+ end Count;
+
+ ------------
+ -- Delete --
+ ------------
+
+ function Delete
+ (Source : Unbounded_Wide_String;
+ From : Positive;
+ Through : Natural) return Unbounded_Wide_String
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : Natural;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Empty slice is deleted, use the same shared string
+
+ if From > Through then
+ Reference (SR);
+ DR := SR;
+
+ -- Index is out of range
+
+ elsif Through > SR.Last then
+ raise Index_Error;
+
+ -- Compute size of the result
+
+ else
+ DL := SR.Last - (Through - From + 1);
+
+ -- Result is an empty string, reuse shared empty string
+
+ if DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL);
+ DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
+ DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
+ DR.Last := DL;
+ end if;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end Delete;
+
+ procedure Delete
+ (Source : in out Unbounded_Wide_String;
+ From : Positive;
+ Through : Natural)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : Natural;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Nothing changed, return
+
+ if From > Through then
+ null;
+
+ -- Through is outside of the range
+
+ elsif Through > SR.Last then
+ raise Index_Error;
+
+ else
+ DL := SR.Last - (Through - From + 1);
+
+ -- Result is empty, reuse shared empty string
+
+ if DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ Source.Reference := Empty_Shared_Wide_String'Access;
+ Unreference (SR);
+
+ -- Try to reuse existent shared string
+
+ elsif Can_Be_Reused (SR, DL) then
+ SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
+ SR.Last := DL;
+
+ -- Otherwise, allocate new shared string
+
+ else
+ DR := Allocate (DL);
+ DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
+ DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
+ DR.Last := DL;
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+ end if;
+ end Delete;
+
+ -------------
+ -- Element --
+ -------------
+
+ function Element
+ (Source : Unbounded_Wide_String;
+ Index : Positive) return Wide_Character
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ if Index <= SR.Last then
+ return SR.Data (Index);
+ else
+ raise Index_Error;
+ end if;
+ end Element;
+
+ --------------
+ -- Finalize --
+ --------------
+
+ procedure Finalize (Object : in out Unbounded_Wide_String) is
+ SR : constant Shared_Wide_String_Access := Object.Reference;
+
+ begin
+ if SR /= null then
+
+ -- The same controlled object can be finalized several times for
+ -- some reason. As per 7.6.1(24) this should have no ill effect,
+ -- so we need to add a guard for the case of finalizing the same
+ -- object twice.
+
+ Object.Reference := null;
+ Unreference (SR);
+ end if;
+ end Finalize;
+
+ ----------------
+ -- Find_Token --
+ ----------------
+
+ procedure Find_Token
+ (Source : Unbounded_Wide_String;
+ Set : Wide_Maps.Wide_Character_Set;
+ From : Positive;
+ Test : Strings.Membership;
+ First : out Positive;
+ Last : out Natural)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ Wide_Search.Find_Token
+ (SR.Data (From .. SR.Last), Set, Test, First, Last);
+ end Find_Token;
+
+ procedure Find_Token
+ (Source : Unbounded_Wide_String;
+ Set : Wide_Maps.Wide_Character_Set;
+ Test : Strings.Membership;
+ First : out Positive;
+ Last : out Natural)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ Wide_Search.Find_Token
+ (SR.Data (1 .. SR.Last), Set, Test, First, Last);
+ end Find_Token;
+
+ ----------
+ -- Free --
+ ----------
+
+ procedure Free (X : in out Wide_String_Access) is
+ procedure Deallocate is
+ new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
+ begin
+ Deallocate (X);
+ end Free;
+
+ ----------
+ -- Head --
+ ----------
+
+ function Head
+ (Source : Unbounded_Wide_String;
+ Count : Natural;
+ Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Result is empty, reuse shared empty string
+
+ if Count = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Length of the string is the same as requested, reuse source shared
+ -- string.
+
+ elsif Count = SR.Last then
+ Reference (SR);
+ DR := SR;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (Count);
+
+ -- Length of the source string is more than requested, copy
+ -- corresponding slice.
+
+ if Count < SR.Last then
+ DR.Data (1 .. Count) := SR.Data (1 .. Count);
+
+ -- Length of the source string is less than requested, copy all
+ -- contents and fill others by Pad character.
+
+ else
+ DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
+
+ for J in SR.Last + 1 .. Count loop
+ DR.Data (J) := Pad;
+ end loop;
+ end if;
+
+ DR.Last := Count;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end Head;
+
+ procedure Head
+ (Source : in out Unbounded_Wide_String;
+ Count : Natural;
+ Pad : Wide_Character := Wide_Space)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Result is empty, reuse empty shared string
+
+ if Count = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ Source.Reference := Empty_Shared_Wide_String'Access;
+ Unreference (SR);
+
+ -- Result is same with source string, reuse source shared string
+
+ elsif Count = SR.Last then
+ null;
+
+ -- Try to reuse existent shared string
+
+ elsif Can_Be_Reused (SR, Count) then
+ if Count > SR.Last then
+ for J in SR.Last + 1 .. Count loop
+ SR.Data (J) := Pad;
+ end loop;
+ end if;
+
+ SR.Last := Count;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (Count);
+
+ -- Length of the source string is greater than requested, copy
+ -- corresponding slice.
+
+ if Count < SR.Last then
+ DR.Data (1 .. Count) := SR.Data (1 .. Count);
+
+ -- Length of the source string is less than requested, copy all
+ -- exists data and fill others by Pad character.
+
+ else
+ DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
+
+ for J in SR.Last + 1 .. Count loop
+ DR.Data (J) := Pad;
+ end loop;
+ end if;
+
+ DR.Last := Count;
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+ end Head;
+
+ -----------
+ -- Index --
+ -----------
+
+ function Index
+ (Source : Unbounded_Wide_String;
+ Pattern : Wide_String;
+ Going : Strings.Direction := Strings.Forward;
+ Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
+ return Natural
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ return Wide_Search.Index
+ (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
+ end Index;
+
+ function Index
+ (Source : Unbounded_Wide_String;
+ Pattern : Wide_String;
+ Going : Direction := Forward;
+ Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ return Wide_Search.Index
+ (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
+ end Index;
+
+ function Index
+ (Source : Unbounded_Wide_String;
+ Set : Wide_Maps.Wide_Character_Set;
+ Test : Strings.Membership := Strings.Inside;
+ Going : Strings.Direction := Strings.Forward) return Natural
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ return Wide_Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going);
+ end Index;
+
+ function Index
+ (Source : Unbounded_Wide_String;
+ Pattern : Wide_String;
+ From : Positive;
+ Going : Direction := Forward;
+ Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
+ return Natural
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ return Wide_Search.Index
+ (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
+ end Index;
+
+ function Index
+ (Source : Unbounded_Wide_String;
+ Pattern : Wide_String;
+ From : Positive;
+ Going : Direction := Forward;
+ Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ return Wide_Search.Index
+ (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
+ end Index;
+
+ function Index
+ (Source : Unbounded_Wide_String;
+ Set : Wide_Maps.Wide_Character_Set;
+ From : Positive;
+ Test : Membership := Inside;
+ Going : Direction := Forward) return Natural
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ return Wide_Search.Index
+ (SR.Data (1 .. SR.Last), Set, From, Test, Going);
+ end Index;
+
+ ---------------------
+ -- Index_Non_Blank --
+ ---------------------
+
+ function Index_Non_Blank
+ (Source : Unbounded_Wide_String;
+ Going : Strings.Direction := Strings.Forward) return Natural
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ return Wide_Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going);
+ end Index_Non_Blank;
+
+ function Index_Non_Blank
+ (Source : Unbounded_Wide_String;
+ From : Positive;
+ Going : Direction := Forward) return Natural
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ begin
+ return Wide_Search.Index_Non_Blank
+ (SR.Data (1 .. SR.Last), From, Going);
+ end Index_Non_Blank;
+
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize (Object : in out Unbounded_Wide_String) is
+ begin
+ Reference (Object.Reference);
+ end Initialize;
+
+ ------------
+ -- Insert --
+ ------------
+
+ function Insert
+ (Source : Unbounded_Wide_String;
+ Before : Positive;
+ New_Item : Wide_String) return Unbounded_Wide_String
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : constant Natural := SR.Last + New_Item'Length;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Check index first
+
+ if Before > SR.Last + 1 then
+ raise Index_Error;
+ end if;
+
+ -- Result is empty, reuse empty shared string
+
+ if DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Inserted string is empty, reuse source shared string
+
+ elsif New_Item'Length = 0 then
+ Reference (SR);
+ DR := SR;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL + DL / Growth_Factor);
+ DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
+ DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
+ DR.Data (Before + New_Item'Length .. DL) :=
+ SR.Data (Before .. SR.Last);
+ DR.Last := DL;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end Insert;
+
+ procedure Insert
+ (Source : in out Unbounded_Wide_String;
+ Before : Positive;
+ New_Item : Wide_String)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : constant Natural := SR.Last + New_Item'Length;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Check bounds
+
+ if Before > SR.Last + 1 then
+ raise Index_Error;
+ end if;
+
+ -- Result is empty string, reuse empty shared string
+
+ if DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ Source.Reference := Empty_Shared_Wide_String'Access;
+ Unreference (SR);
+
+ -- Inserted string is empty, nothing to do
+
+ elsif New_Item'Length = 0 then
+ null;
+
+ -- Try to reuse existent shared string first
+
+ elsif Can_Be_Reused (SR, DL) then
+ SR.Data (Before + New_Item'Length .. DL) :=
+ SR.Data (Before .. SR.Last);
+ SR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
+ SR.Last := DL;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL + DL / Growth_Factor);
+ DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
+ DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
+ DR.Data (Before + New_Item'Length .. DL) :=
+ SR.Data (Before .. SR.Last);
+ DR.Last := DL;
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+ end Insert;
+
+ ------------
+ -- Length --
+ ------------
+
+ function Length (Source : Unbounded_Wide_String) return Natural is
+ begin
+ return Source.Reference.Last;
+ end Length;
+
+ ---------------
+ -- Overwrite --
+ ---------------
+
+ function Overwrite
+ (Source : Unbounded_Wide_String;
+ Position : Positive;
+ New_Item : Wide_String) return Unbounded_Wide_String
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : Natural;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Check bounds
+
+ if Position > SR.Last + 1 then
+ raise Index_Error;
+ end if;
+
+ DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
+
+ -- Result is empty string, reuse empty shared string
+
+ if DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Result is same with source string, reuse source shared string
+
+ elsif New_Item'Length = 0 then
+ Reference (SR);
+ DR := SR;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL);
+ DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
+ DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
+ DR.Data (Position + New_Item'Length .. DL) :=
+ SR.Data (Position + New_Item'Length .. SR.Last);
+ DR.Last := DL;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end Overwrite;
+
+ procedure Overwrite
+ (Source : in out Unbounded_Wide_String;
+ Position : Positive;
+ New_Item : Wide_String)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : Natural;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Bounds check
+
+ if Position > SR.Last + 1 then
+ raise Index_Error;
+ end if;
+
+ DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
+
+ -- Result is empty string, reuse empty shared string
+
+ if DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ Source.Reference := Empty_Shared_Wide_String'Access;
+ Unreference (SR);
+
+ -- String unchanged, nothing to do
+
+ elsif New_Item'Length = 0 then
+ null;
+
+ -- Try to reuse existent shared string
+
+ elsif Can_Be_Reused (SR, DL) then
+ SR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
+ SR.Last := DL;
+
+ -- Otherwise allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL);
+ DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
+ DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
+ DR.Data (Position + New_Item'Length .. DL) :=
+ SR.Data (Position + New_Item'Length .. SR.Last);
+ DR.Last := DL;
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+ end Overwrite;
+
+ ---------------
+ -- Reference --
+ ---------------
+
+ procedure Reference (Item : not null Shared_Wide_String_Access) is
+ begin
+ System.Atomic_Counters.Increment (Item.Counter);
+ end Reference;
+
+ ---------------------
+ -- Replace_Element --
+ ---------------------
+
+ procedure Replace_Element
+ (Source : in out Unbounded_Wide_String;
+ Index : Positive;
+ By : Wide_Character)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Bounds check
+
+ if Index <= SR.Last then
+
+ -- Try to reuse existent shared string
+
+ if Can_Be_Reused (SR, SR.Last) then
+ SR.Data (Index) := By;
+
+ -- Otherwise allocate new shared string and fill it
+
+ else
+ DR := Allocate (SR.Last);
+ DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
+ DR.Data (Index) := By;
+ DR.Last := SR.Last;
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+
+ else
+ raise Index_Error;
+ end if;
+ end Replace_Element;
+
+ -------------------
+ -- Replace_Slice --
+ -------------------
+
+ function Replace_Slice
+ (Source : Unbounded_Wide_String;
+ Low : Positive;
+ High : Natural;
+ By : Wide_String) return Unbounded_Wide_String
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : Natural;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Check bounds
+
+ if Low > SR.Last + 1 then
+ raise Index_Error;
+ end if;
+
+ -- Do replace operation when removed slice is not empty
+
+ if High >= Low then
+ DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
+ -- This is the number of characters remaining in the string after
+ -- replacing the slice.
+
+ -- Result is empty string, reuse empty shared string
+
+ if DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Otherwise allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL);
+ DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
+ DR.Data (Low .. Low + By'Length - 1) := By;
+ DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
+ DR.Last := DL;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+
+ -- Otherwise just insert string
+
+ else
+ return Insert (Source, Low, By);
+ end if;
+ end Replace_Slice;
+
+ procedure Replace_Slice
+ (Source : in out Unbounded_Wide_String;
+ Low : Positive;
+ High : Natural;
+ By : Wide_String)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : Natural;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Bounds check
+
+ if Low > SR.Last + 1 then
+ raise Index_Error;
+ end if;
+
+ -- Do replace operation only when replaced slice is not empty
+
+ if High >= Low then
+ DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
+ -- This is the number of characters remaining in the string after
+ -- replacing the slice.
+
+ -- Result is empty string, reuse empty shared string
+
+ if DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ Source.Reference := Empty_Shared_Wide_String'Access;
+ Unreference (SR);
+
+ -- Try to reuse existent shared string
+
+ elsif Can_Be_Reused (SR, DL) then
+ SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
+ SR.Data (Low .. Low + By'Length - 1) := By;
+ SR.Last := DL;
+
+ -- Otherwise allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL);
+ DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
+ DR.Data (Low .. Low + By'Length - 1) := By;
+ DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
+ DR.Last := DL;
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+
+ -- Otherwise just insert item
+
+ else
+ Insert (Source, Low, By);
+ end if;
+ end Replace_Slice;
+
+ -------------------------------
+ -- Set_Unbounded_Wide_String --
+ -------------------------------
+
+ procedure Set_Unbounded_Wide_String
+ (Target : out Unbounded_Wide_String;
+ Source : Wide_String)
+ is
+ TR : constant Shared_Wide_String_Access := Target.Reference;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- In case of empty string, reuse empty shared string
+
+ if Source'Length = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ Target.Reference := Empty_Shared_Wide_String'Access;
+
+ else
+ -- Try to reuse existent shared string
+
+ if Can_Be_Reused (TR, Source'Length) then
+ Reference (TR);
+ DR := TR;
+
+ -- Otherwise allocate new shared string
+
+ else
+ DR := Allocate (Source'Length);
+ Target.Reference := DR;
+ end if;
+
+ DR.Data (1 .. Source'Length) := Source;
+ DR.Last := Source'Length;
+ end if;
+
+ Unreference (TR);
+ end Set_Unbounded_Wide_String;
+
+ -----------
+ -- Slice --
+ -----------
+
+ function Slice
+ (Source : Unbounded_Wide_String;
+ Low : Positive;
+ High : Natural) return Wide_String
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+
+ begin
+ -- Note: test of High > Length is in accordance with AI95-00128
+
+ if Low > SR.Last + 1 or else High > SR.Last then
+ raise Index_Error;
+
+ else
+ return SR.Data (Low .. High);
+ end if;
+ end Slice;
+
+ ----------
+ -- Tail --
+ ----------
+
+ function Tail
+ (Source : Unbounded_Wide_String;
+ Count : Natural;
+ Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- For empty result reuse empty shared string
+
+ if Count = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Result is hole source string, reuse source shared string
+
+ elsif Count = SR.Last then
+ Reference (SR);
+ DR := SR;
+
+ -- Otherwise allocate new shared string and fill it
+
+ else
+ DR := Allocate (Count);
+
+ if Count < SR.Last then
+ DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
+
+ else
+ for J in 1 .. Count - SR.Last loop
+ DR.Data (J) := Pad;
+ end loop;
+
+ DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
+ end if;
+
+ DR.Last := Count;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end Tail;
+
+ procedure Tail
+ (Source : in out Unbounded_Wide_String;
+ Count : Natural;
+ Pad : Wide_Character := Wide_Space)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DR : Shared_Wide_String_Access;
+
+ procedure Common
+ (SR : Shared_Wide_String_Access;
+ DR : Shared_Wide_String_Access;
+ Count : Natural);
+ -- Common code of tail computation. SR/DR can point to the same object
+
+ ------------
+ -- Common --
+ ------------
+
+ procedure Common
+ (SR : Shared_Wide_String_Access;
+ DR : Shared_Wide_String_Access;
+ Count : Natural) is
+ begin
+ if Count < SR.Last then
+ DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
+
+ else
+ DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
+
+ for J in 1 .. Count - SR.Last loop
+ DR.Data (J) := Pad;
+ end loop;
+ end if;
+
+ DR.Last := Count;
+ end Common;
+
+ begin
+ -- Result is empty string, reuse empty shared string
+
+ if Count = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ Source.Reference := Empty_Shared_Wide_String'Access;
+ Unreference (SR);
+
+ -- Length of the result is the same with length of the source string,
+ -- reuse source shared string.
+
+ elsif Count = SR.Last then
+ null;
+
+ -- Try to reuse existent shared string
+
+ elsif Can_Be_Reused (SR, Count) then
+ Common (SR, SR, Count);
+
+ -- Otherwise allocate new shared string and fill it
+
+ else
+ DR := Allocate (Count);
+ Common (SR, DR, Count);
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+ end Tail;
+
+ --------------------
+ -- To_Wide_String --
+ --------------------
+
+ function To_Wide_String
+ (Source : Unbounded_Wide_String) return Wide_String is
+ begin
+ return Source.Reference.Data (1 .. Source.Reference.Last);
+ end To_Wide_String;
+
+ ------------------------------
+ -- To_Unbounded_Wide_String --
+ ------------------------------
+
+ function To_Unbounded_Wide_String
+ (Source : Wide_String) return Unbounded_Wide_String
+ is
+ DR : constant Shared_Wide_String_Access := Allocate (Source'Length);
+ begin
+ DR.Data (1 .. Source'Length) := Source;
+ DR.Last := Source'Length;
+ return (AF.Controlled with Reference => DR);
+ end To_Unbounded_Wide_String;
+
+ function To_Unbounded_Wide_String
+ (Length : Natural) return Unbounded_Wide_String
+ is
+ DR : constant Shared_Wide_String_Access := Allocate (Length);
+ begin
+ DR.Last := Length;
+ return (AF.Controlled with Reference => DR);
+ end To_Unbounded_Wide_String;
+
+ ---------------
+ -- Translate --
+ ---------------
+
+ function Translate
+ (Source : Unbounded_Wide_String;
+ Mapping : Wide_Maps.Wide_Character_Mapping) return Unbounded_Wide_String
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Nothing to translate, reuse empty shared string
+
+ if SR.Last = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (SR.Last);
+
+ for J in 1 .. SR.Last loop
+ DR.Data (J) := Value (Mapping, SR.Data (J));
+ end loop;
+
+ DR.Last := SR.Last;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end Translate;
+
+ procedure Translate
+ (Source : in out Unbounded_Wide_String;
+ Mapping : Wide_Maps.Wide_Character_Mapping)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Nothing to translate
+
+ if SR.Last = 0 then
+ null;
+
+ -- Try to reuse shared string
+
+ elsif Can_Be_Reused (SR, SR.Last) then
+ for J in 1 .. SR.Last loop
+ SR.Data (J) := Value (Mapping, SR.Data (J));
+ end loop;
+
+ -- Otherwise, allocate new shared string
+
+ else
+ DR := Allocate (SR.Last);
+
+ for J in 1 .. SR.Last loop
+ DR.Data (J) := Value (Mapping, SR.Data (J));
+ end loop;
+
+ DR.Last := SR.Last;
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+ end Translate;
+
+ function Translate
+ (Source : Unbounded_Wide_String;
+ Mapping : Wide_Maps.Wide_Character_Mapping_Function)
+ return Unbounded_Wide_String
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Nothing to translate, reuse empty shared string
+
+ if SR.Last = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (SR.Last);
+
+ for J in 1 .. SR.Last loop
+ DR.Data (J) := Mapping.all (SR.Data (J));
+ end loop;
+
+ DR.Last := SR.Last;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+
+ exception
+ when others =>
+ Unreference (DR);
+
+ raise;
+ end Translate;
+
+ procedure Translate
+ (Source : in out Unbounded_Wide_String;
+ Mapping : Wide_Maps.Wide_Character_Mapping_Function)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Nothing to translate
+
+ if SR.Last = 0 then
+ null;
+
+ -- Try to reuse shared string
+
+ elsif Can_Be_Reused (SR, SR.Last) then
+ for J in 1 .. SR.Last loop
+ SR.Data (J) := Mapping.all (SR.Data (J));
+ end loop;
+
+ -- Otherwise allocate new shared string and fill it
+
+ else
+ DR := Allocate (SR.Last);
+
+ for J in 1 .. SR.Last loop
+ DR.Data (J) := Mapping.all (SR.Data (J));
+ end loop;
+
+ DR.Last := SR.Last;
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+
+ exception
+ when others =>
+ if DR /= null then
+ Unreference (DR);
+ end if;
+
+ raise;
+ end Translate;
+
+ ----------
+ -- Trim --
+ ----------
+
+ function Trim
+ (Source : Unbounded_Wide_String;
+ Side : Trim_End) return Unbounded_Wide_String
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : Natural;
+ DR : Shared_Wide_String_Access;
+ Low : Natural;
+ High : Natural;
+
+ begin
+ Low := Index_Non_Blank (Source, Forward);
+
+ -- All blanks, reuse empty shared string
+
+ if Low = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ else
+ case Side is
+ when Left =>
+ High := SR.Last;
+ DL := SR.Last - Low + 1;
+
+ when Right =>
+ Low := 1;
+ High := Index_Non_Blank (Source, Backward);
+ DL := High;
+
+ when Both =>
+ High := Index_Non_Blank (Source, Backward);
+ DL := High - Low + 1;
+ end case;
+
+ -- Length of the result is the same as length of the source string,
+ -- reuse source shared string.
+
+ if DL = SR.Last then
+ Reference (SR);
+ DR := SR;
+
+ -- Otherwise, allocate new shared string
+
+ else
+ DR := Allocate (DL);
+ DR.Data (1 .. DL) := SR.Data (Low .. High);
+ DR.Last := DL;
+ end if;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end Trim;
+
+ procedure Trim
+ (Source : in out Unbounded_Wide_String;
+ Side : Trim_End)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : Natural;
+ DR : Shared_Wide_String_Access;
+ Low : Natural;
+ High : Natural;
+
+ begin
+ Low := Index_Non_Blank (Source, Forward);
+
+ -- All blanks, reuse empty shared string
+
+ if Low = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ Source.Reference := Empty_Shared_Wide_String'Access;
+ Unreference (SR);
+
+ else
+ case Side is
+ when Left =>
+ High := SR.Last;
+ DL := SR.Last - Low + 1;
+
+ when Right =>
+ Low := 1;
+ High := Index_Non_Blank (Source, Backward);
+ DL := High;
+
+ when Both =>
+ High := Index_Non_Blank (Source, Backward);
+ DL := High - Low + 1;
+ end case;
+
+ -- Length of the result is the same as length of the source string,
+ -- nothing to do.
+
+ if DL = SR.Last then
+ null;
+
+ -- Try to reuse existent shared string
+
+ elsif Can_Be_Reused (SR, DL) then
+ SR.Data (1 .. DL) := SR.Data (Low .. High);
+ SR.Last := DL;
+
+ -- Otherwise, allocate new shared string
+
+ else
+ DR := Allocate (DL);
+ DR.Data (1 .. DL) := SR.Data (Low .. High);
+ DR.Last := DL;
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+ end if;
+ end Trim;
+
+ function Trim
+ (Source : Unbounded_Wide_String;
+ Left : Wide_Maps.Wide_Character_Set;
+ Right : Wide_Maps.Wide_Character_Set) return Unbounded_Wide_String
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : Natural;
+ DR : Shared_Wide_String_Access;
+ Low : Natural;
+ High : Natural;
+
+ begin
+ Low := Index (Source, Left, Outside, Forward);
+
+ -- Source includes only characters from Left set, reuse empty shared
+ -- string.
+
+ if Low = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ else
+ High := Index (Source, Right, Outside, Backward);
+ DL := Integer'Max (0, High - Low + 1);
+
+ -- Source includes only characters from Right set or result string
+ -- is empty, reuse empty shared string.
+
+ if High = 0 or else DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL);
+ DR.Data (1 .. DL) := SR.Data (Low .. High);
+ DR.Last := DL;
+ end if;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end Trim;
+
+ procedure Trim
+ (Source : in out Unbounded_Wide_String;
+ Left : Wide_Maps.Wide_Character_Set;
+ Right : Wide_Maps.Wide_Character_Set)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : Natural;
+ DR : Shared_Wide_String_Access;
+ Low : Natural;
+ High : Natural;
+
+ begin
+ Low := Index (Source, Left, Outside, Forward);
+
+ -- Source includes only characters from Left set, reuse empty shared
+ -- string.
+
+ if Low = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ Source.Reference := Empty_Shared_Wide_String'Access;
+ Unreference (SR);
+
+ else
+ High := Index (Source, Right, Outside, Backward);
+ DL := Integer'Max (0, High - Low + 1);
+
+ -- Source includes only characters from Right set or result string
+ -- is empty, reuse empty shared string.
+
+ if High = 0 or else DL = 0 then
+ Reference (Empty_Shared_Wide_String'Access);
+ Source.Reference := Empty_Shared_Wide_String'Access;
+ Unreference (SR);
+
+ -- Try to reuse existent shared string
+
+ elsif Can_Be_Reused (SR, DL) then
+ SR.Data (1 .. DL) := SR.Data (Low .. High);
+ SR.Last := DL;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL);
+ DR.Data (1 .. DL) := SR.Data (Low .. High);
+ DR.Last := DL;
+ Source.Reference := DR;
+ Unreference (SR);
+ end if;
+ end if;
+ end Trim;
+
+ ---------------------
+ -- Unbounded_Slice --
+ ---------------------
+
+ function Unbounded_Slice
+ (Source : Unbounded_Wide_String;
+ Low : Positive;
+ High : Natural) return Unbounded_Wide_String
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ DL : Natural;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Check bounds
+
+ if Low > SR.Last + 1 or else High > SR.Last then
+ raise Index_Error;
+
+ -- Result is empty slice, reuse empty shared string
+
+ elsif Low > High then
+ Reference (Empty_Shared_Wide_String'Access);
+ DR := Empty_Shared_Wide_String'Access;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DL := High - Low + 1;
+ DR := Allocate (DL);
+ DR.Data (1 .. DL) := SR.Data (Low .. High);
+ DR.Last := DL;
+ end if;
+
+ return (AF.Controlled with Reference => DR);
+ end Unbounded_Slice;
+
+ procedure Unbounded_Slice
+ (Source : Unbounded_Wide_String;
+ Target : out Unbounded_Wide_String;
+ Low : Positive;
+ High : Natural)
+ is
+ SR : constant Shared_Wide_String_Access := Source.Reference;
+ TR : constant Shared_Wide_String_Access := Target.Reference;
+ DL : Natural;
+ DR : Shared_Wide_String_Access;
+
+ begin
+ -- Check bounds
+
+ if Low > SR.Last + 1 or else High > SR.Last then
+ raise Index_Error;
+
+ -- Result is empty slice, reuse empty shared string
+
+ elsif Low > High then
+ Reference (Empty_Shared_Wide_String'Access);
+ Target.Reference := Empty_Shared_Wide_String'Access;
+ Unreference (TR);
+
+ else
+ DL := High - Low + 1;
+
+ -- Try to reuse existent shared string
+
+ if Can_Be_Reused (TR, DL) then
+ TR.Data (1 .. DL) := SR.Data (Low .. High);
+ TR.Last := DL;
+
+ -- Otherwise, allocate new shared string and fill it
+
+ else
+ DR := Allocate (DL);
+ DR.Data (1 .. DL) := SR.Data (Low .. High);
+ DR.Last := DL;
+ Target.Reference := DR;
+ Unreference (TR);
+ end if;
+ end if;
+ end Unbounded_Slice;
+
+ -----------------
+ -- Unreference --
+ -----------------
+
+ procedure Unreference (Item : not null Shared_Wide_String_Access) is
+
+ procedure Free is
+ new Ada.Unchecked_Deallocation
+ (Shared_Wide_String, Shared_Wide_String_Access);
+
+ Aux : Shared_Wide_String_Access := Item;
+
+ begin
+ if System.Atomic_Counters.Decrement (Aux.Counter) then
+
+ -- Reference counter of Empty_Shared_Wide_String must never reach
+ -- zero.
+
+ pragma Assert (Aux /= Empty_Shared_Wide_String'Access);
+
+ Free (Aux);
+ end if;
+ end Unreference;
+
+end Ada.Strings.Wide_Unbounded;