g-arrspl.adb   [plain text]

------------------------------------------------------------------------------
--                                                                          --
--                         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;