diff options
Diffstat (limited to 'gcc/ada/libgnat/g-arrspl.adb')
| -rw-r--r-- | gcc/ada/libgnat/g-arrspl.adb | 352 |
1 files changed, 352 insertions, 0 deletions
diff --git a/gcc/ada/libgnat/g-arrspl.adb b/gcc/ada/libgnat/g-arrspl.adb new file mode 100644 index 0000000..4e1e90e --- /dev/null +++ b/gcc/ada/libgnat/g-arrspl.adb @@ -0,0 +1,352 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . A R R A Y _ S P L I T -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2002-2017, 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.Unchecked_Deallocation; + +package body GNAT.Array_Split is + + procedure Free is + new Ada.Unchecked_Deallocation (Slices_Indexes, Slices_Access); + + procedure Free is + new Ada.Unchecked_Deallocation (Separators_Indexes, Indexes_Access); + + function Count + (Source : Element_Sequence; + Pattern : Element_Set) return Natural; + -- Returns the number of occurrences of Pattern elements in Source, 0 is + -- returned if no occurrence is found in Source. + + ------------ + -- Adjust -- + ------------ + + procedure Adjust (S : in out Slice_Set) is + begin + S.D.Ref_Counter := S.D.Ref_Counter + 1; + end Adjust; + + ------------ + -- Create -- + ------------ + + procedure Create + (S : out Slice_Set; + From : Element_Sequence; + Separators : Element_Sequence; + Mode : Separator_Mode := Single) + is + begin + Create (S, From, To_Set (Separators), Mode); + end Create; + + ------------ + -- Create -- + ------------ + + procedure Create + (S : out Slice_Set; + From : Element_Sequence; + Separators : Element_Set; + Mode : Separator_Mode := Single) + is + Result : Slice_Set; + begin + Result.D.Source := new Element_Sequence'(From); + Set (Result, Separators, Mode); + S := Result; + end Create; + + ----------- + -- Count -- + ----------- + + function Count + (Source : Element_Sequence; + Pattern : Element_Set) return Natural + is + C : Natural := 0; + begin + for K in Source'Range loop + if Is_In (Source (K), Pattern) then + C := C + 1; + end if; + end loop; + + return C; + end Count; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize (S : in out Slice_Set) is + + procedure Free is + new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access); + + procedure Free is + new Ada.Unchecked_Deallocation (Data, Data_Access); + + D : Data_Access := S.D; + + begin + -- Ensure call is idempotent + + S.D := null; + + if D /= null then + D.Ref_Counter := D.Ref_Counter - 1; + + if D.Ref_Counter = 0 then + Free (D.Source); + Free (D.Indexes); + Free (D.Slices); + Free (D); + end if; + end if; + end Finalize; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize (S : in out Slice_Set) is + begin + S.D := new Data'(1, null, 0, null, null); + end Initialize; + + ---------------- + -- Separators -- + ---------------- + + function Separators + (S : Slice_Set; + Index : Slice_Number) return Slice_Separators + is + begin + if Index > S.D.N_Slice then + raise Index_Error; + + elsif Index = 0 + or else (Index = 1 and then S.D.N_Slice = 1) + then + -- Whole string, or no separator used + + return (Before => Array_End, + After => Array_End); + + elsif Index = 1 then + return (Before => Array_End, + After => S.D.Source (S.D.Slices (Index).Stop + 1)); + + elsif Index = S.D.N_Slice then + return (Before => S.D.Source (S.D.Slices (Index).Start - 1), + After => Array_End); + + else + return (Before => S.D.Source (S.D.Slices (Index).Start - 1), + After => S.D.Source (S.D.Slices (Index).Stop + 1)); + end if; + end Separators; + + ---------------- + -- Separators -- + ---------------- + + function Separators (S : Slice_Set) return Separators_Indexes is + begin + return S.D.Indexes.all; + end Separators; + + --------- + -- Set -- + --------- + + procedure Set + (S : in out Slice_Set; + Separators : Element_Sequence; + Mode : Separator_Mode := Single) + is + begin + Set (S, To_Set (Separators), Mode); + end Set; + + --------- + -- Set -- + --------- + + procedure Set + (S : in out Slice_Set; + Separators : Element_Set; + Mode : Separator_Mode := Single) + is + + procedure Copy_On_Write (S : in out Slice_Set); + -- Make a copy of S if shared with another variable + + ------------------- + -- Copy_On_Write -- + ------------------- + + procedure Copy_On_Write (S : in out Slice_Set) is + begin + if S.D.Ref_Counter > 1 then + -- First let's remove our count from the current data + + S.D.Ref_Counter := S.D.Ref_Counter - 1; + + -- Then duplicate the data + + S.D := new Data'(S.D.all); + S.D.Ref_Counter := 1; + + if S.D.Source /= null then + S.D.Source := new Element_Sequence'(S.D.Source.all); + S.D.Indexes := null; + S.D.Slices := null; + end if; + + else + -- If there is a single reference to this variable, free it now + -- as it will be redefined below. + + Free (S.D.Indexes); + Free (S.D.Slices); + end if; + end Copy_On_Write; + + Count_Sep : constant Natural := Count (S.D.Source.all, Separators); + J : Positive; + + begin + Copy_On_Write (S); + + -- Compute all separator's indexes + + S.D.Indexes := new Separators_Indexes (1 .. Count_Sep); + J := S.D.Indexes'First; + + for K in S.D.Source'Range loop + if Is_In (S.D.Source (K), Separators) then + S.D.Indexes (J) := K; + J := J + 1; + end if; + end loop; + + -- Compute slice info for fast slice access + + declare + S_Info : Slices_Indexes (1 .. Slice_Number (Count_Sep) + 1); + K : Natural := 1; + Start, Stop : Natural; + + begin + S.D.N_Slice := 0; + + Start := S.D.Source'First; + Stop := 0; + + loop + if K > Count_Sep then + + -- No more separators, last slice ends at end of source string + + Stop := S.D.Source'Last; + + else + Stop := S.D.Indexes (K) - 1; + end if; + + -- Add slice to the table + + S.D.N_Slice := S.D.N_Slice + 1; + S_Info (S.D.N_Slice) := (Start, Stop); + + exit when K > Count_Sep; + + case Mode is + when Single => + + -- In this mode just set start to character next to the + -- current separator, advance the separator index. + + Start := S.D.Indexes (K) + 1; + K := K + 1; + + when Multiple => + + -- In this mode skip separators following each other + + loop + Start := S.D.Indexes (K) + 1; + K := K + 1; + exit when K > Count_Sep + or else S.D.Indexes (K) > S.D.Indexes (K - 1) + 1; + end loop; + end case; + end loop; + + S.D.Slices := new Slices_Indexes'(S_Info (1 .. S.D.N_Slice)); + end; + end Set; + + ----------- + -- Slice -- + ----------- + + function Slice + (S : Slice_Set; + Index : Slice_Number) return Element_Sequence + is + begin + if Index = 0 then + return S.D.Source.all; + + elsif Index > S.D.N_Slice then + raise Index_Error; + + else + return + S.D.Source (S.D.Slices (Index).Start .. S.D.Slices (Index).Stop); + end if; + end Slice; + + ----------------- + -- Slice_Count -- + ----------------- + + function Slice_Count (S : Slice_Set) return Slice_Number is + begin + return S.D.N_Slice; + end Slice_Count; + +end GNAT.Array_Split; |