------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- G N A T . A R R A Y _ S P L I T -- -- -- -- B o d y -- -- -- -- Copyright (C) 2002-2005, 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, 51 Franklin Street, Fifth Floor, -- -- Boston, MA 02110-1301, 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 separators, last slice ends 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 other 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;