------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                     G N A T . A R R A Y _ S P L I T                      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2002-2013, 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;