diff options
Diffstat (limited to 'gcc/ada/g-arrspl.adb')
| -rw-r--r-- | gcc/ada/g-arrspl.adb | 309 |
1 files changed, 309 insertions, 0 deletions
diff --git a/gcc/ada/g-arrspl.adb b/gcc/ada/g-arrspl.adb new file mode 100644 index 00000000000..78fa8c46081 --- /dev/null +++ b/gcc/ada/g-arrspl.adb @@ -0,0 +1,309 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . A R R A Y _ S P I T -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2002-2003 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 2, 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- 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 occurences of Pattern elements in Source, 0 is + -- returned if no occurence is found in Source. + + ------------ + -- Adjust -- + ------------ + + procedure Adjust (S : in out Slice_Set) is + begin + S.Ref_Counter.all := S.Ref_Counter.all + 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 + begin + S.Source := new Element_Sequence'(From); + Set (S, Separators, Mode); + 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 (Natural, Counter); + + begin + S.Ref_Counter.all := S.Ref_Counter.all - 1; + + if S.Ref_Counter.all = 0 then + Free (S.Source); + Free (S.Indexes); + Free (S.Slices); + Free (S.Ref_Counter); + end if; + end Finalize; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize (S : in out Slice_Set) is + begin + S.Ref_Counter := new Natural'(1); + end Initialize; + + ---------------- + -- Separators -- + ---------------- + + function Separators + (S : Slice_Set; + Index : Slice_Number) + return Slice_Separators + is + begin + if Index > S.N_Slice then + raise Index_Error; + + elsif Index = 0 + or else (Index = 1 and then S.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.Source (S.Slices (Index).Stop + 1)); + + elsif Index = S.N_Slice then + return (Before => S.Source (S.Slices (Index).Start - 1), + After => Array_End); + + else + return (Before => S.Source (S.Slices (Index).Start - 1), + After => S.Source (S.Slices (Index).Stop + 1)); + end if; + end Separators; + + ---------------- + -- Separators -- + ---------------- + + function Separators (S : Slice_Set) return Separators_Indexes is + begin + return S.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 + Count_Sep : constant Natural := Count (S.Source.all, Separators); + J : Positive; + begin + -- Free old structure + Free (S.Indexes); + Free (S.Slices); + + -- Compute all separator's indexes + + S.Indexes := new Separators_Indexes (1 .. Count_Sep); + J := S.Indexes'First; + + for K in S.Source'Range loop + if Is_In (S.Source (K), Separators) then + S.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.N_Slice := 0; + + Start := S.Source'First; + Stop := 0; + + loop + if K > Count_Sep then + -- No more separator, last slice end at the end of the source + -- string. + Stop := S.Source'Last; + else + Stop := S.Indexes (K) - 1; + end if; + + -- Add slice to the table + + S.N_Slice := S.N_Slice + 1; + S_Info (S.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.Indexes (K) + 1; + K := K + 1; + + when Multiple => + -- In this mode skip separators following each others + loop + Start := S.Indexes (K) + 1; + K := K + 1; + exit when K > Count_Sep + or else S.Indexes (K) > S.Indexes (K - 1) + 1; + end loop; + + end case; + end loop; + + S.Slices := new Slices_Indexes'(S_Info (1 .. S.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.Source.all; + + elsif Index > S.N_Slice then + raise Index_Error; + + else + return S.Source (S.Slices (Index).Start .. S.Slices (Index).Stop); + end if; + end Slice; + + ----------------- + -- Slice_Count -- + ----------------- + + function Slice_Count (S : Slice_Set) return Slice_Number is + begin + return S.N_Slice; + end Slice_Count; + +end GNAT.Array_Split; |