diff options
Diffstat (limited to 'gcc/ada/g-arrspl.adb')
| -rw-r--r-- | gcc/ada/g-arrspl.adb | 352 |
1 files changed, 0 insertions, 352 deletions
diff --git a/gcc/ada/g-arrspl.adb b/gcc/ada/g-arrspl.adb deleted file mode 100644 index f3eaf80..0000000 --- a/gcc/ada/g-arrspl.adb +++ /dev/null @@ -1,352 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G N A T . A R R A Y _ S P L I T -- --- -- --- B o d y -- --- -- --- Copyright (C) 2002-2016, 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; |