URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-stzunb-shared.adb] - Rev 707
Go to most recent revision | Compare with Previous | Blame | View Log
------------------------------------------------------------------------------ -- -- -- GNAT RUN-TIME COMPONENTS -- -- -- -- A D A . S T R I N G S . W I D E _ W I D E _ U N B O U N D E D -- -- -- -- B o d y -- -- -- -- Copyright (C) 1992-2011, 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_Wide_Search; with Ada.Unchecked_Deallocation; package body Ada.Strings.Wide_Wide_Unbounded is use Ada.Strings.Wide_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_Wide_String; Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String is LR : constant Shared_Wide_Wide_String_Access := Left.Reference; RR : constant Shared_Wide_Wide_String_Access := Right.Reference; DL : constant Natural := LR.Last + RR.Last; DR : Shared_Wide_Wide_String_Access; begin -- Result is an empty string, reuse shared empty string if DL = 0 then Reference (Empty_Shared_Wide_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; Right : Wide_Wide_String) return Unbounded_Wide_Wide_String is LR : constant Shared_Wide_Wide_String_Access := Left.Reference; DL : constant Natural := LR.Last + Right'Length; DR : Shared_Wide_Wide_String_Access; begin -- Result is an empty string, reuse shared empty string if DL = 0 then Reference (Empty_Shared_Wide_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String is RR : constant Shared_Wide_Wide_String_Access := Right.Reference; DL : constant Natural := Left'Length + RR.Last; DR : Shared_Wide_Wide_String_Access; begin -- Result is an empty string, reuse shared one if DL = 0 then Reference (Empty_Shared_Wide_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String is LR : constant Shared_Wide_Wide_String_Access := Left.Reference; DL : constant Natural := LR.Last + 1; DR : Shared_Wide_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_Wide_Character; Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String is RR : constant Shared_Wide_Wide_String_Access := Right.Reference; DL : constant Natural := 1 + RR.Last; DR : Shared_Wide_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_Wide_Character) return Unbounded_Wide_Wide_String is DR : Shared_Wide_Wide_String_Access; begin -- Result is an empty string, reuse shared empty string if Left = 0 then Reference (Empty_Shared_Wide_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String) return Unbounded_Wide_Wide_String is DL : constant Natural := Left * Right'Length; DR : Shared_Wide_Wide_String_Access; K : Positive; begin -- Result is an empty string, reuse shared empty string if DL = 0 then Reference (Empty_Shared_Wide_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String) return Unbounded_Wide_Wide_String is RR : constant Shared_Wide_Wide_String_Access := Right.Reference; DL : constant Natural := Left * RR.Last; DR : Shared_Wide_Wide_String_Access; K : Positive; begin -- Result is an empty string, reuse shared empty string if DL = 0 then Reference (Empty_Shared_Wide_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; Right : Unbounded_Wide_Wide_String) return Boolean is LR : constant Shared_Wide_Wide_String_Access := Left.Reference; RR : constant Shared_Wide_Wide_String_Access := Right.Reference; begin return LR.Data (1 .. LR.Last) < RR.Data (1 .. RR.Last); end "<"; function "<" (Left : Unbounded_Wide_Wide_String; Right : Wide_Wide_String) return Boolean is LR : constant Shared_Wide_Wide_String_Access := Left.Reference; begin return LR.Data (1 .. LR.Last) < Right; end "<"; function "<" (Left : Wide_Wide_String; Right : Unbounded_Wide_Wide_String) return Boolean is RR : constant Shared_Wide_Wide_String_Access := Right.Reference; begin return Left < RR.Data (1 .. RR.Last); end "<"; ---------- -- "<=" -- ---------- function "<=" (Left : Unbounded_Wide_Wide_String; Right : Unbounded_Wide_Wide_String) return Boolean is LR : constant Shared_Wide_Wide_String_Access := Left.Reference; RR : constant Shared_Wide_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_Wide_String; Right : Wide_Wide_String) return Boolean is LR : constant Shared_Wide_Wide_String_Access := Left.Reference; begin return LR.Data (1 .. LR.Last) <= Right; end "<="; function "<=" (Left : Wide_Wide_String; Right : Unbounded_Wide_Wide_String) return Boolean is RR : constant Shared_Wide_Wide_String_Access := Right.Reference; begin return Left <= RR.Data (1 .. RR.Last); end "<="; --------- -- "=" -- --------- function "=" (Left : Unbounded_Wide_Wide_String; Right : Unbounded_Wide_Wide_String) return Boolean is LR : constant Shared_Wide_Wide_String_Access := Left.Reference; RR : constant Shared_Wide_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_Wide_String; Right : Wide_Wide_String) return Boolean is LR : constant Shared_Wide_Wide_String_Access := Left.Reference; begin return LR.Data (1 .. LR.Last) = Right; end "="; function "=" (Left : Wide_Wide_String; Right : Unbounded_Wide_Wide_String) return Boolean is RR : constant Shared_Wide_Wide_String_Access := Right.Reference; begin return Left = RR.Data (1 .. RR.Last); end "="; --------- -- ">" -- --------- function ">" (Left : Unbounded_Wide_Wide_String; Right : Unbounded_Wide_Wide_String) return Boolean is LR : constant Shared_Wide_Wide_String_Access := Left.Reference; RR : constant Shared_Wide_Wide_String_Access := Right.Reference; begin return LR.Data (1 .. LR.Last) > RR.Data (1 .. RR.Last); end ">"; function ">" (Left : Unbounded_Wide_Wide_String; Right : Wide_Wide_String) return Boolean is LR : constant Shared_Wide_Wide_String_Access := Left.Reference; begin return LR.Data (1 .. LR.Last) > Right; end ">"; function ">" (Left : Wide_Wide_String; Right : Unbounded_Wide_Wide_String) return Boolean is RR : constant Shared_Wide_Wide_String_Access := Right.Reference; begin return Left > RR.Data (1 .. RR.Last); end ">"; ---------- -- ">=" -- ---------- function ">=" (Left : Unbounded_Wide_Wide_String; Right : Unbounded_Wide_Wide_String) return Boolean is LR : constant Shared_Wide_Wide_String_Access := Left.Reference; RR : constant Shared_Wide_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_Wide_String; Right : Wide_Wide_String) return Boolean is LR : constant Shared_Wide_Wide_String_Access := Left.Reference; begin return LR.Data (1 .. LR.Last) >= Right; end ">="; function ">=" (Left : Wide_Wide_String; Right : Unbounded_Wide_Wide_String) return Boolean is RR : constant Shared_Wide_Wide_String_Access := Right.Reference; begin return Left >= RR.Data (1 .. RR.Last); end ">="; ------------ -- Adjust -- ------------ procedure Adjust (Object : in out Unbounded_Wide_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_Wide_String'Size / Standard'Storage_Unit; -- Total size of all static components Element_Size : constant Natural := Wide_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_Wide_String_Access is begin -- Empty string requested, return shared empty string if Max_Length = 0 then Reference (Empty_Shared_Wide_Wide_String'Access); return Empty_Shared_Wide_Wide_String'Access; -- Otherwise, allocate requested space (and probably some more room) else return new Shared_Wide_Wide_String (Aligned_Max_Length (Max_Length)); end if; end Allocate; ------------ -- Append -- ------------ procedure Append (Source : in out Unbounded_Wide_Wide_String; New_Item : Unbounded_Wide_Wide_String) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; NR : constant Shared_Wide_Wide_String_Access := New_Item.Reference; DL : constant Natural := SR.Last + NR.Last; DR : Shared_Wide_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_Wide_String; New_Item : Wide_Wide_String) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : constant Natural := SR.Last + New_Item'Length; DR : Shared_Wide_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_Wide_String; New_Item : Wide_Wide_Character) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : constant Natural := SR.Last + 1; DR : Shared_Wide_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_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_Wide_String; Pattern : Wide_Wide_String; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := Wide_Wide_Maps.Identity) return Natural is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; begin return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping); end Count; function Count (Source : Unbounded_Wide_Wide_String; Pattern : Wide_Wide_String; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) return Natural is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; begin return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping); end Count; function Count (Source : Unbounded_Wide_Wide_String; Set : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; begin return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Set); end Count; ------------ -- Delete -- ------------ function Delete (Source : Unbounded_Wide_Wide_String; From : Positive; Through : Natural) return Unbounded_Wide_Wide_String is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : Natural; DR : Shared_Wide_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_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; From : Positive; Through : Natural) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : Natural; DR : Shared_Wide_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_Wide_String'Access); Source.Reference := Empty_Shared_Wide_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_Wide_String; Index : Positive) return Wide_Wide_Character is SR : constant Shared_Wide_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_Wide_String) is SR : constant Shared_Wide_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_Wide_String; Set : Wide_Wide_Maps.Wide_Wide_Character_Set; From : Positive; Test : Strings.Membership; First : out Positive; Last : out Natural) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; begin Wide_Wide_Search.Find_Token (SR.Data (From .. SR.Last), Set, Test, First, Last); end Find_Token; procedure Find_Token (Source : Unbounded_Wide_Wide_String; Set : Wide_Wide_Maps.Wide_Wide_Character_Set; Test : Strings.Membership; First : out Positive; Last : out Natural) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; begin Wide_Wide_Search.Find_Token (SR.Data (1 .. SR.Last), Set, Test, First, Last); end Find_Token; ---------- -- Free -- ---------- procedure Free (X : in out Wide_Wide_String_Access) is procedure Deallocate is new Ada.Unchecked_Deallocation (Wide_Wide_String, Wide_Wide_String_Access); begin Deallocate (X); end Free; ---------- -- Head -- ---------- function Head (Source : Unbounded_Wide_Wide_String; Count : Natural; Pad : Wide_Wide_Character := Wide_Wide_Space) return Unbounded_Wide_Wide_String is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DR : Shared_Wide_Wide_String_Access; begin -- Result is empty, reuse shared empty string if Count = 0 then Reference (Empty_Shared_Wide_Wide_String'Access); DR := Empty_Shared_Wide_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 then 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_Wide_String; Count : Natural; Pad : Wide_Wide_Character := Wide_Wide_Space) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DR : Shared_Wide_Wide_String_Access; begin -- Result is empty, reuse empty shared string if Count = 0 then Reference (Empty_Shared_Wide_Wide_String'Access); Source.Reference := Empty_Shared_Wide_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 then requested, copy -- corresponding slice. if Count < SR.Last then DR.Data (1 .. Count) := SR.Data (1 .. Count); -- Length of the source string is less the 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_Wide_String; Pattern : Wide_Wide_String; Going : Strings.Direction := Strings.Forward; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := Wide_Wide_Maps.Identity) return Natural is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; begin return Wide_Wide_Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping); end Index; function Index (Source : Unbounded_Wide_Wide_String; Pattern : Wide_Wide_String; Going : Direction := Forward; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) return Natural is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; begin return Wide_Wide_Search.Index (SR.Data (1 .. SR.Last), Pattern, Going, Mapping); end Index; function Index (Source : Unbounded_Wide_Wide_String; Set : Wide_Wide_Maps.Wide_Wide_Character_Set; Test : Strings.Membership := Strings.Inside; Going : Strings.Direction := Strings.Forward) return Natural is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; begin return Wide_Wide_Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going); end Index; function Index (Source : Unbounded_Wide_Wide_String; Pattern : Wide_Wide_String; From : Positive; Going : Direction := Forward; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := Wide_Wide_Maps.Identity) return Natural is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; begin return Wide_Wide_Search.Index (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping); end Index; function Index (Source : Unbounded_Wide_Wide_String; Pattern : Wide_Wide_String; From : Positive; Going : Direction := Forward; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) return Natural is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; begin return Wide_Wide_Search.Index (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping); end Index; function Index (Source : Unbounded_Wide_Wide_String; Set : Wide_Wide_Maps.Wide_Wide_Character_Set; From : Positive; Test : Membership := Inside; Going : Direction := Forward) return Natural is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; begin return Wide_Wide_Search.Index (SR.Data (1 .. SR.Last), Set, From, Test, Going); end Index; --------------------- -- Index_Non_Blank -- --------------------- function Index_Non_Blank (Source : Unbounded_Wide_Wide_String; Going : Strings.Direction := Strings.Forward) return Natural is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; begin return Wide_Wide_Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going); end Index_Non_Blank; function Index_Non_Blank (Source : Unbounded_Wide_Wide_String; From : Positive; Going : Direction := Forward) return Natural is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; begin return Wide_Wide_Search.Index_Non_Blank (SR.Data (1 .. SR.Last), From, Going); end Index_Non_Blank; ---------------- -- Initialize -- ---------------- procedure Initialize (Object : in out Unbounded_Wide_Wide_String) is begin Reference (Object.Reference); end Initialize; ------------ -- Insert -- ------------ function Insert (Source : Unbounded_Wide_Wide_String; Before : Positive; New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : constant Natural := SR.Last + New_Item'Length; DR : Shared_Wide_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_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; Before : Positive; New_Item : Wide_Wide_String) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : constant Natural := SR.Last + New_Item'Length; DR : Shared_Wide_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_Wide_String'Access); Source.Reference := Empty_Shared_Wide_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_Wide_String) return Natural is begin return Source.Reference.Last; end Length; --------------- -- Overwrite -- --------------- function Overwrite (Source : Unbounded_Wide_Wide_String; Position : Positive; New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : Natural; DR : Shared_Wide_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_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; Position : Positive; New_Item : Wide_Wide_String) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : Natural; DR : Shared_Wide_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_Wide_String'Access); Source.Reference := Empty_Shared_Wide_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_Wide_String_Access) is begin System.Atomic_Counters.Increment (Item.Counter); end Reference; --------------------- -- Replace_Element -- --------------------- procedure Replace_Element (Source : in out Unbounded_Wide_Wide_String; Index : Positive; By : Wide_Wide_Character) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DR : Shared_Wide_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_Wide_String; Low : Positive; High : Natural; By : Wide_Wide_String) return Unbounded_Wide_Wide_String is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : Natural; DR : Shared_Wide_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_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; Low : Positive; High : Natural; By : Wide_Wide_String) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : Natural; DR : Shared_Wide_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_Wide_String'Access); Source.Reference := Empty_Shared_Wide_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_Wide_String -- ------------------------------- procedure Set_Unbounded_Wide_Wide_String (Target : out Unbounded_Wide_Wide_String; Source : Wide_Wide_String) is TR : constant Shared_Wide_Wide_String_Access := Target.Reference; DR : Shared_Wide_Wide_String_Access; begin -- In case of empty string, reuse empty shared string if Source'Length = 0 then Reference (Empty_Shared_Wide_Wide_String'Access); Target.Reference := Empty_Shared_Wide_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_Wide_String; ----------- -- Slice -- ----------- function Slice (Source : Unbounded_Wide_Wide_String; Low : Positive; High : Natural) return Wide_Wide_String is SR : constant Shared_Wide_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_Wide_String; Count : Natural; Pad : Wide_Wide_Character := Wide_Wide_Space) return Unbounded_Wide_Wide_String is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DR : Shared_Wide_Wide_String_Access; begin -- For empty result reuse empty shared string if Count = 0 then Reference (Empty_Shared_Wide_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; Count : Natural; Pad : Wide_Wide_Character := Wide_Wide_Space) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DR : Shared_Wide_Wide_String_Access; procedure Common (SR : Shared_Wide_Wide_String_Access; DR : Shared_Wide_Wide_String_Access; Count : Natural); -- Common code of tail computation. SR/DR can point to the same object ------------ -- Common -- ------------ procedure Common (SR : Shared_Wide_Wide_String_Access; DR : Shared_Wide_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_Wide_String'Access); Source.Reference := Empty_Shared_Wide_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_Wide_String -- -------------------- function To_Wide_Wide_String (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String is begin return Source.Reference.Data (1 .. Source.Reference.Last); end To_Wide_Wide_String; ------------------------------ -- To_Unbounded_Wide_Wide_String -- ------------------------------ function To_Unbounded_Wide_Wide_String (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String is DR : constant Shared_Wide_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_Wide_String; function To_Unbounded_Wide_Wide_String (Length : Natural) return Unbounded_Wide_Wide_String is DR : constant Shared_Wide_Wide_String_Access := Allocate (Length); begin DR.Last := Length; return (AF.Controlled with Reference => DR); end To_Unbounded_Wide_Wide_String; --------------- -- Translate -- --------------- function Translate (Source : Unbounded_Wide_Wide_String; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping) return Unbounded_Wide_Wide_String is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DR : Shared_Wide_Wide_String_Access; begin -- Nothing to translate, reuse empty shared string if SR.Last = 0 then Reference (Empty_Shared_Wide_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DR : Shared_Wide_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_Wide_String; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) return Unbounded_Wide_Wide_String is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DR : Shared_Wide_Wide_String_Access; begin -- Nothing to translate, reuse empty shared string if SR.Last = 0 then Reference (Empty_Shared_Wide_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DR : Shared_Wide_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_Wide_String; Side : Trim_End) return Unbounded_Wide_Wide_String is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : Natural; DR : Shared_Wide_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_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; Side : Trim_End) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : Natural; DR : Shared_Wide_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_Wide_String'Access); Source.Reference := Empty_Shared_Wide_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_Wide_String; Left : Wide_Wide_Maps.Wide_Wide_Character_Set; Right : Wide_Wide_Maps.Wide_Wide_Character_Set) return Unbounded_Wide_Wide_String is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : Natural; DR : Shared_Wide_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_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; Left : Wide_Wide_Maps.Wide_Wide_Character_Set; Right : Wide_Wide_Maps.Wide_Wide_Character_Set) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : Natural; DR : Shared_Wide_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_Wide_String'Access); Source.Reference := Empty_Shared_Wide_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_Wide_String'Access); Source.Reference := Empty_Shared_Wide_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_Wide_String; Low : Positive; High : Natural) return Unbounded_Wide_Wide_String is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; DL : Natural; DR : Shared_Wide_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_Wide_String'Access); DR := Empty_Shared_Wide_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_Wide_String; Target : out Unbounded_Wide_Wide_String; Low : Positive; High : Natural) is SR : constant Shared_Wide_Wide_String_Access := Source.Reference; TR : constant Shared_Wide_Wide_String_Access := Target.Reference; DL : Natural; DR : Shared_Wide_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_Wide_String'Access); Target.Reference := Empty_Shared_Wide_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_Wide_String_Access) is procedure Free is new Ada.Unchecked_Deallocation (Shared_Wide_Wide_String, Shared_Wide_Wide_String_Access); Aux : Shared_Wide_Wide_String_Access := Item; begin if System.Atomic_Counters.Decrement (Aux.Counter) then -- Reference counter of Empty_Shared_Wide_Wide_String must never -- reach zero. pragma Assert (Aux /= Empty_Shared_Wide_Wide_String'Access); Free (Aux); end if; end Unreference; end Ada.Strings.Wide_Wide_Unbounded;
Go to most recent revision | Compare with Previous | Blame | View Log