Natools

------------------------------------------------------------------------------
-- Copyright (c) 2013, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Strings.Fixed;

package body Natools.String_Slices.Slice_Sets is

   package Fixed renames Ada.Strings.Fixed;


   ---------------------------
   -- Range_Set subprograms --
   ---------------------------

   function Is_Overlapping (Bounds : String_Range; Set : Range_Set)
     return Boolean
   is
      Cursor : Range_Sets.Cursor := Set.Floor (Bounds);
   begin
      if Range_Sets.Has_Element (Cursor) then
         if Bounds.First <= Last (Range_Sets.Element (Cursor)) then
            return True;
         end if;

         Range_Sets.Next (Cursor);
      else
         Cursor := Set.First;
      end if;

      if Range_Sets.Has_Element (Cursor)
        and then Range_Sets.Element (Cursor).First <= Last (Bounds)
      then
         return True;
      end if;

      return False;
   end Is_Overlapping;


   function Is_Valid (Set : Range_Set) return Boolean is
      Cursor : Range_Sets.Cursor := Set.First;
      Prev, Cur : String_Range;
   begin
      if not Range_Sets.Has_Element (Cursor) then
         return True;
      end if;

      Prev := Range_Sets.Element (Cursor);

      if Prev.Length = 0 then
         return False;
      end if;

      Range_Sets.Next (Cursor);
      while Range_Sets.Has_Element (Cursor) loop
         Cur := Range_Sets.Element (Cursor);

         if Cur.Length = 0 then
            return False;
         end if;

         pragma Assert (Prev.First <= Cur.First);

         if Is_In (Last (Prev), Cur) then
            return False;
         end if;

         Prev := Cur;
         Range_Sets.Next (Cursor);
      end loop;

      return True;
   end Is_Valid;


   function Total_Span (Set : Range_Set) return String_Range is
      Result : String_Range := (1, 0);
      Cursor : Range_Sets.Cursor := Set.First;
   begin
      if not Range_Sets.Has_Element (Cursor) then
         return Result;
      end if;

      Result.First := Range_Sets.Element (Cursor).First;

      Cursor := Set.Last;
      Set_Last (Result, Last (Range_Sets.Element (Cursor)));

      return Result;
   end Total_Span;


   procedure Include_Range
     (Set : in out Range_Set; Bounds : in String_Range)
   is
      Cursor : Range_Sets.Cursor := Set.Floor (Bounds);
      Next : Range_Sets.Cursor;
      Actual : String_Range := Bounds;
      R : String_Range;
   begin
      if Range_Sets.Has_Element (Cursor) then
         R := Range_Sets.Element (Cursor);
         Next := Range_Sets.Next (Cursor);

         --  Do nothing if the given range is already covered

         if Is_Subrange (Actual, R) then
            return;
         end if;

         --  Merge with previous range if overlapping

         if Is_In (Actual.First, R) then
            Set_First (Actual, R.First);
            Set.Delete (Cursor);
         end if;
      else
         Next := Set.First;
      end if;

      while Range_Sets.Has_Element (Next) loop
         Cursor := Next;
         R := Range_Sets.Element (Cursor);
         exit when not Is_In (R.First, Actual);
         Next := Range_Sets.Next (Cursor);

         if Is_Subrange (R, Actual) then
            Set.Delete (Cursor);
         else
            pragma Assert (Last (R) > Last (Actual));
            Set_Last (Actual, Last (R));
            Set.Delete (Cursor);
         end if;
      end loop;

      Set.Insert (Actual);
      pragma Assert (Is_Valid (Set));
   end Include_Range;


   procedure Exclude_Range
     (Set : in out Range_Set; Bounds : in String_Range)
   is
      Cursor : Range_Sets.Cursor;
      R : String_Range;
   begin
      if Bounds.Length = 0 then
         return;
      end if;

      Cursor := Set.Floor (Bounds);

      if Range_Sets.Has_Element (Cursor) then
         R := Range_Sets.Element (Cursor);

         if R.First < Bounds.First then
            if Is_In (Bounds.First, R) then
               if Is_In (Last (Bounds) + 1, R) then
                  Set.Insert (To_Range (Last (Bounds) + 1, Last (R)));
               end if;

               Set_Last (R, Bounds.First - 1);
               pragma Assert (R.Length > 0);
               Set.Replace_Element (Cursor, R);
            end if;

            Range_Sets.Next (Cursor);
         end if;
      else
         Cursor := Set.First;
      end if;

      while Range_Sets.Has_Element (Cursor)
        and then Is_Subrange (Range_Sets.Element (Cursor), Bounds)
      loop
         declare
            Next : constant Range_Sets.Cursor := Range_Sets.Next (Cursor);
         begin
            Set.Delete (Cursor);
            Cursor := Next;
         end;
      end loop;

      if Range_Sets.Has_Element (Cursor)
        and then Is_In (Last (Bounds) + 1, Range_Sets.Element (Cursor))
      then
         R := Range_Sets.Element (Cursor);
         Set_First (R, Last (Bounds) + 1);
         Set.Replace_Element (Cursor, R);
      end if;

      pragma Assert (Is_Valid (Set));
   end Exclude_Range;



   -------------------------------
   -- Public helper subprograms --
   -------------------------------

   function "<" (Left, Right : String_Range) return Boolean is
   begin
      return Left.First < Right.First;
   end "<";



   ----------------------------
   -- Conversion subprograms --
   ----------------------------

   function To_Slice (S : Slice_Set) return Slice is
      use type Ada.Containers.Count_Type;
   begin
      if S.Ref.Is_Empty then
         return Null_Slice;
      end if;

      if S.Bounds.Is_Empty then
         return Slice'(Bounds => (1, 0),
                       Ref => S.Ref);
      elsif S.Bounds.Length = 1 then
         return Slice'(Bounds => S.Bounds.First_Element,
                       Ref => S.Ref);
      end if;

      return To_Slice (To_String (S));
   end To_Slice;


   function To_Slice_Set (S : String) return Slice_Set is
      function Factory return String;

      function Factory return String is
      begin
         return S;
      end Factory;

      Result : Slice_Set;
   begin
      Result.Ref := String_Refs.Create (Factory'Access);
      if S'Length > 0 then
         Result.Bounds.Insert ((S'First, S'Length));
      end if;
      return Result;
   end To_Slice_Set;


   function To_Slice_Set (S : Slice) return Slice_Set is
      Result : Slice_Set;
   begin
      Result.Ref := S.Ref;
      if S.Bounds.Length > 0 then
         Result.Bounds.Insert (S.Bounds);
      end if;
      return Result;
   end To_Slice_Set;


   function To_String (Set : Slice_Set) return String is
      Cursor : Range_Sets.Cursor := Set.Bounds.First;
      R : String_Range;
      I : Positive := 1;
   begin
      return Result : String (1 .. Set.Total_Length) do
         while Range_Sets.Has_Element (Cursor) loop
            R := Range_Sets.Element (Cursor);
            Result (I .. I + R.Length - 1)
              := Set.Ref.Query.Data.all (R.First .. Last (R));
            I := I + R.Length;
            Range_Sets.Next (Cursor);
         end loop;
         pragma Assert (I = Result'Last + 1);
      end return;
   end To_String;


   function To_String (Set : Slice_Set; Subrange : String_Range)
     return String is
   begin
      return Set.Subset (Subrange).To_String;
   end To_String;


   function To_String (Set : Slice_Set; First : Positive; Last : Natural)
     return String is
   begin
      return Set.Subset (To_Range (First, Last)).To_String;
   end To_String;



   ---------------------------------
   -- Basic slice-set subprograms --
   ---------------------------------

   procedure Clear (Set : in out Slice_Set) is
   begin
      Set.Bounds.Clear;
   end Clear;


   function Element (Set : Slice_Set; Index : Positive) return Character is
   begin
      if not Is_In (Set, Index) then
         raise Constraint_Error;
      end if;

      return Set.Ref.Query.Data.all (Index);
   end Element;


   function First (Set : Slice_Set) return Positive is
      Cursor : constant Range_Sets.Cursor := Set.Bounds.First;
   begin
      if Range_Sets.Has_Element (Cursor) then
         return Range_Sets.Element (Cursor).First;
      else
         return 1;
      end if;
   end First;


   function Is_Empty (Set : Slice_Set) return Boolean is
   begin
      return Set.Bounds.Is_Empty;
   end Is_Empty;


   function Is_In (Set : Slice_Set; Index : Natural) return Boolean is
      Cursor : Range_Sets.Cursor;
   begin
      if Index = 0 or else Set.Ref.Is_Empty or else Set.Bounds.Is_Empty then
         return False;
      end if;

      Cursor := Set.Bounds.Floor ((Index, 0));

      return Range_Sets.Has_Element (Cursor)
        and then Is_In (Index, Range_Sets.Element (Cursor));
   end Is_In;


   function Is_Null (Set : Slice_Set) return Boolean is
   begin
      return Set.Ref.Is_Empty;
   end Is_Null;


   function Is_Valid (Set : Slice_Set) return Boolean is
   begin
      if Set.Ref.Is_Empty then
         return Set.Bounds.Is_Empty;
      else
         return Is_Subrange (Total_Span (Set.Bounds),
                             Get_Range (Set.Ref.Query.Data.all))
           and then Is_Valid (Set.Bounds);
      end if;
   end Is_Valid;


   function Last (Set : Slice_Set) return Natural is
      Cursor : constant Range_Sets.Cursor := Set.Bounds.Last;
   begin
      if Range_Sets.Has_Element (Cursor) then
         return Last (Range_Sets.Element (Cursor));
      else
         return 0;
      end if;
   end Last;


--  Multistep version:
--   function Next (Set : Slice_Set; Index : Natural; Steps : Positive := 1)
--     return Natural
--   is
--      Cursor : Range_Sets.Cursor;
--      Target : Positive := Index + Steps;
--      Skipped : Natural;
--      R : String_Range;
--   begin
--      if Index = 0 or else Set.Ref.Is_Empty or else Set.Bounds.Is_Empty then
--         raise Constraint_Error;
--      end if;
--
--      Cursor := Set.Bounds.Floor ((Index, 0));
--
--      if not Range_Sets.Has_Element (Cursor) then
--         raise Constraint_Error with "Next with index out of bounds";
--      end if;
--
--      R := Range_Sets.Element (Cursor);
--      loop
--         if Is_In (Target, R) then
--            return Target;
--         end if;
--
--         Skipped := Last (R) + 1;
--         Range_Sets.Next (Cursor);
--         exit when not Range_Sets.Has_Element (Cursor);
--         R := Range_Sets.Element (Cursor);
--         Skipped := R.First - Skipped;
--         Target := Target + Skipped;
--      end loop;
--
--      return 0;
--   end Next;

   function Next (Set : Slice_Set; Index : Natural) return Natural is
      Cursor : Range_Sets.Cursor;
   begin
      if Index = 0 or else Set.Ref.Is_Empty or else Set.Bounds.Is_Empty then
         raise Constraint_Error;
      end if;

      Cursor := Set.Bounds.Floor ((Index, 0));

      if not Range_Sets.Has_Element (Cursor) then
         raise Constraint_Error with "Next with index out of bounds";
      end if;

      if Is_In (Index + 1, Range_Sets.Element (Cursor)) then
         return Index + 1;
      else
         Range_Sets.Next (Cursor);
         if Range_Sets.Has_Element (Cursor) then
            return Range_Sets.Element (Cursor).First;
         else
            return 0;
         end if;
      end if;
   end Next;


   procedure Next (Set : in Slice_Set; Index : in out Natural) is
   begin
      Index := Next (Set, Index);
   end Next;


--  Multistep version:
--  function Previous (Set : Slice_Set; Index : Natural; Steps : Positive := 1)
--     return Natural
--   is
--      Cursor : Range_Sets.Cursor;
--      Target : Positive;
--      Prev_First : Positive;
--      Skipped : Natural;
--      R : String_Range;
--   begin
--      if Index = 0 or else Set.Ref.Is_Empty or else Set.Bounds.Is_Empty then
--         raise Constraint_Error;
--      end if;
--
--      if Steps >= Index then
--         return 0;
--      end if;
--      Target := Index - Steps;
--
--      Cursor := Set.Bounds.Floor ((Index, 0));
--      if not Range_Sets.Has_Element (Cursor) then
--         raise Constraint_Error with "Previous with index out of bounds";
--      end if;
--
--      loop
--         R := Range_Sets.Element (Cursor);
--         if Is_In (Target, R) then
--            return Target;
--         end if;
--
--         Prev_First := R.First;
--         Range_Sets.Previous (Cursor);
--         exit when not Range_Sets.Has_Element (Cursor);
--         R := Range_Sets.Element (Cursor);
--
--         Skipped := Prev_First - (Last (R) + 1);
--         exit when Skipped >= Target;
--         Target := Target - Skipped;
--      end loop;
--
--      return 0;
--   end Previous;

   function Previous (Set : Slice_Set; Index : Natural) return Natural is
      Cursor : Range_Sets.Cursor;
   begin
      if Index = 0 or else Set.Ref.Is_Empty or else Set.Bounds.Is_Empty then
         raise Constraint_Error;
      end if;

      Cursor := Set.Bounds.Floor ((Index, 0));

      if not Range_Sets.Has_Element (Cursor) then
         raise Constraint_Error with "Previous with index out of bounds";
      end if;

      if Is_In (Index - 1, Range_Sets.Element (Cursor)) then
         return Index - 1;
      else
         Range_Sets.Previous (Cursor);
         if Range_Sets.Has_Element (Cursor) then
            return Last (Range_Sets.Element (Cursor));
         else
            return 0;
         end if;
      end if;
   end Previous;


   procedure Previous (Set : in Slice_Set; Index : in out Natural) is
   begin
      Index := Previous (Set, Index);
   end Previous;


   function Total_Length (Set : Slice_Set) return Natural is
      Cursor : Range_Sets.Cursor := Set.Bounds.First;
      Result : Natural := 0;
   begin
      while Range_Sets.Has_Element (Cursor) loop
         Result := Result + Range_Sets.Element (Cursor).Length;
         Range_Sets.Next (Cursor);
      end loop;

      return Result;
   end Total_Length;



   ----------------------------
   -- Operation on slice set --
   ----------------------------

   procedure Add_Slice (Set : in out Slice_Set; Bounds : in String_Range) is
   begin
      if Bounds.Length = 0 then
         return;
      end if;

      if Set.Ref.Is_Empty then
         raise Constraint_Error with "Cannot add range to null slice set";
      end if;

      if not Is_Subrange (Bounds, Get_Range (Set.Ref.Query.Data.all)) then
         raise Constraint_Error with "Add slice outside of parent";
      end if;

      if Is_Overlapping (Bounds, Set.Bounds) then
         raise Constraint_Error with "Add an overlapping slice to a set";
      end if;

      Set.Bounds.Insert (Bounds);
   end Add_Slice;


   procedure Add_Slice (Set : in out Slice_Set; S : in Slice) is
      use type String_Refs.Reference;
   begin
      if S.Bounds.Length = 0 then
         return;
      end if;

      if Set.Ref.Is_Empty then
         pragma Assert (Set.Bounds.Is_Empty);
         Set.Ref := S.Ref;
         Set.Bounds.Insert (S.Bounds);
         return;
      end if;

      if Set.Ref /= S.Ref then
         raise Constraint_Error with
           "Addition of an unrelated slice to a slice set";
      end if;

      if Is_Overlapping (S.Bounds, Set.Bounds) then
         raise Constraint_Error with
           "Addition of an overlapping slice to a slice set";
      end if;

      Set.Bounds.Insert (S.Bounds);
   end Add_Slice;


   procedure Add_Slice
     (Set : in out Slice_Set;
      First : in Positive;
      Last : in Natural) is
   begin
      Add_Slice (Set, To_Range (First, Last));
   end Add_Slice;


   procedure Include_Slice
     (Set : in out Slice_Set; Bounds : in String_Range) is
   begin
      if Bounds.Length = 0 then
         return;
      end if;

      if Set.Ref.Is_Empty then
         raise Constraint_Error with "Cannot include range to null slice set";
      end if;

      if not Is_Subrange (Bounds, Get_Range (Set.Ref.Query.Data.all)) then
         raise Constraint_Error with "Include slice outside of parent";
      end if;

      Include_Range (Set.Bounds, Bounds);
   end Include_Slice;


   procedure Include_Slice (Set : in out Slice_Set; S : in Slice) is
      use type String_Refs.Reference;
   begin
      if S.Bounds.Length = 0 then
         return;
      end if;

      if Set.Ref.Is_Empty then
         pragma Assert (Set.Bounds.Is_Empty);
         Set.Ref := S.Ref;
         Set.Bounds.Insert (S.Bounds);
         return;
      end if;

      if Set.Ref /= S.Ref then
         raise Constraint_Error with
           "Addition of an unrelated slice to a slice set";
      end if;

      Include_Range (Set.Bounds, S.Bounds);
   end Include_Slice;


   procedure Include_Slice
     (Set : in out Slice_Set;
      First : in Positive;
      Last : in Natural) is
   begin
      Include_Slice (Set, To_Range (First, Last));
   end Include_Slice;


   procedure Exclude_Slice
     (Set : in out Slice_Set; Bounds : in String_Range) is
   begin
      if Bounds.Length = 0 then
         return;
      end if;

      if Set.Ref.Is_Empty then
         raise Constraint_Error with
           "Cannot exclude range from null slice set";
      end if;

      Exclude_Range (Set.Bounds, Bounds);
   end Exclude_Slice;


   procedure Exclude_Slice
     (Set : in out Slice_Set;
      First : in Positive;
      Last : in Natural) is
   begin
      Exclude_Slice (Set, To_Range (First, Last));
   end Exclude_Slice;


   procedure Restrict (Set : in out Slice_Set; Bounds : in String_Range) is
   begin
      if Set.Ref.Is_Empty then
         raise Constraint_Error with "Cannot restrict null slice set";
      end if;

      if Bounds.Length = 0 then
         Set.Bounds.Clear;
      else
         declare
            Set_First : constant Positive := Set.First;
            Set_Last  : constant Natural  := Set.Last;
         begin
            if Set_First < Bounds.First then
               Exclude_Range
                 (Set.Bounds,
                  To_Range (Set_First, Bounds.First - 1));
            end if;

            if Set_Last > Last (Bounds) then
               Exclude_Range
                 (Set.Bounds,
                  To_Range (Last (Bounds) + 1, Set_Last));
            end if;
         end;
      end if;
   end Restrict;


   procedure Restrict
     (Set : in out Slice_Set;
      First : in Positive;
      Last : in Natural) is
   begin
      Restrict (Set, To_Range (First, Last));
   end Restrict;


   function Subset (Set : Slice_Set; Bounds : String_Range) return Slice_Set is
      Result : Slice_Set;
      Cursor : Range_Sets.Cursor;
      R : String_Range;
   begin
      if Set.Ref.Is_Empty then
         raise Constraint_Error with "Subset of null slice set";
      end if;

      Result.Ref := Set.Ref;

      if Bounds.Length = 0 or else Set.Bounds.Is_Empty then
         return Result;
      end if;

      Cursor := Set.Bounds.Floor (Bounds);
      if Range_Sets.Has_Element (Cursor) then
         R := Range_Sets.Element (Cursor);
         if R.First < Bounds.First and then Is_In (Bounds.First, R) then
            Set_First (R, Bounds.First);
            if Is_In (Last (Bounds), R) then
               Set_Last (R, Last (Bounds));
            end if;
            Result.Bounds.Insert (R);
            Range_Sets.Next (Cursor);
         end if;
      else
         Cursor := Set.Bounds.First;
      end if;

      while Range_Sets.Has_Element (Cursor) loop
         R := Range_Sets.Element (Cursor);

         if Is_Subrange (R, Bounds) then
            Result.Bounds.Insert (R);
         else
            if Is_In (Last (Bounds), R) then
               Set_Last (R, Last (Bounds));
               Result.Bounds.Insert (R);
            end if;
            exit;
         end if;

         Range_Sets.Next (Cursor);
      end loop;

      return Result;
   end Subset;


   function Subset (Set : Slice_Set; First : Positive; Last : Natural)
     return Slice_Set is
   begin
      return Subset (Set, To_Range (First, Last));
   end Subset;


   procedure Cut_Before (Set : in out Slice_Set; Index : in Positive) is
      Cursor : Range_Sets.Cursor;
      Lower, Upper : String_Range;
   begin
      if Set.Ref.Is_Empty or else Set.Bounds.Is_Empty then
         raise Constraint_Error;
      end if;

      Cursor := Set.Bounds.Floor ((Index, 0));

      if not Range_Sets.Has_Element (Cursor) then
         raise Constraint_Error;
      end if;

      Lower := Range_Sets.Element (Cursor);

      if not Is_In (Index, Lower) then
         raise Constraint_Error;
      end if;

      if Lower.First = Index then
         return;  --  nothing to do
      end if;

      Upper := Lower;
      Set_Last (Lower, Index - 1);
      Set_First (Upper, Index);
      Set.Bounds.Delete (Cursor);
      Set.Bounds.Insert (Lower);
      Set.Bounds.Insert (Upper);
   end Cut_Before;



   ---------------
   -- Iterators --
   ---------------

   procedure Trim_Slices
     (Set : in out Slice_Set;
      Trim : not null access function (Slice : String) return String_Range)
   is
      Cursor : Range_Sets.Cursor := Set.Bounds.First;
      Old_Range, New_Range : String_Range;
   begin
      while Range_Sets.Has_Element (Cursor) loop
         Old_Range := Range_Sets.Element (Cursor);
         New_Range := Trim.all
           (Set.Ref.Query.Data.all (Old_Range.First .. Last (Old_Range)));

         if New_Range.Length = 0 then
            declare
               Next : constant Range_Sets.Cursor := Range_Sets.Next (Cursor);
            begin
               Set.Bounds.Delete (Cursor);
               Cursor := Next;
            end;
         else
            if not Is_Subrange (New_Range, Old_Range) then
               raise Constraint_Error with "Trim not returning a subrange";
            end if;

            Set.Bounds.Replace_Element (Cursor, New_Range);
            Range_Sets.Next (Cursor);
         end if;
      end loop;
   end Trim_Slices;


   procedure Query_Slices
     (Set : in Slice_Set;
      Process : not null access procedure (S : in Slice))
   is
      Cursor : Range_Sets.Cursor := Set.Bounds.First;
   begin
      while Range_Sets.Has_Element (Cursor) loop
         Process.all (Slice'(Range_Sets.Element (Cursor), Set.Ref));
         Range_Sets.Next (Cursor);
      end loop;
   end Query_Slices;



   ----------------------
   -- Search functions --
   ----------------------

   function Find_Slice
     (Set : Slice_Set;
      From : Positive;
      Test : not null access function (Slice : String) return Boolean;
      Going : Ada.Strings.Direction := Ada.Strings.Forward)
     return String_Range
   is
      Cursor : Range_Sets.Cursor;
      Update : access procedure (C : in out Range_Sets.Cursor);
      R : String_Range;
   begin
      if Set.Ref.Is_Empty then
         raise Constraint_Error with "Find_Slice on null slice set";
      end if;

      case Going is
         when Ada.Strings.Forward  => Update := Range_Sets.Next'Access;
         when Ada.Strings.Backward => Update := Range_Sets.Previous'Access;
      end case;

      Cursor := Set.Bounds.Floor ((From, 0));

      while Range_Sets.Has_Element (Cursor) loop
         R := Range_Sets.Element (Cursor);

         if Test.all (Set.Ref.Query.Data.all (R.First .. Last (R))) then
            return R;
         end if;

         Update.all (Cursor);
      end loop;

      return (1, 0);
   end Find_Slice;


   function Find_Slice
     (Set : Slice_Set;
      Test : not null access function (Slice : String) return Boolean;
      Going : Ada.Strings.Direction := Ada.Strings.Forward)
     return String_Range is
   begin
      case Going is
         when Ada.Strings.Forward =>
            return Find_Slice (Set, Set.First, Test, Going);
         when Ada.Strings.Backward =>
            return Find_Slice (Set, Set.Last, Test, Going);
      end case;
   end Find_Slice;


   function Index
     (Source : Slice_Set;
      Set : Ada.Strings.Maps.Character_Set;
      From : Positive;
      Test : Ada.Strings.Membership := Ada.Strings.Inside;
      Going : Ada.Strings.Direction := Ada.Strings.Forward)
     return Natural
   is
      Cursor : Range_Sets.Cursor;
      Update : access procedure (C : in out Range_Sets.Cursor);
      R : String_Range;
      Result : Natural := 0;
   begin
      case Going is
         when Ada.Strings.Forward  => Update := Range_Sets.Next'Access;
         when Ada.Strings.Backward => Update := Range_Sets.Previous'Access;
      end case;

      Cursor := Source.Bounds.Floor ((From, 0));

      if not Range_Sets.Has_Element (Cursor) then
         raise Ada.Strings.Index_Error;
      end if;

      R := Range_Sets.Element (Cursor);

      if Is_In (From, R) then
         Result := Fixed.Index
           (Source.Ref.Query.Data.all (R.First .. Last (R)),
            Set,
            From,
            Test,
            Going);
      end if;

      while Result = 0 loop
         Update.all (Cursor);
         if not Range_Sets.Has_Element (Cursor) then
            return 0;
         end if;

         R := Range_Sets.Element (Cursor);
         Result := Fixed.Index
           (Source.Ref.Query.Data.all (R.First .. Last (R)),
            Set,
            Test,
            Going);
      end loop;

      return Result;
   end Index;


   function Index
     (Source : Slice_Set;
      Set : Ada.Strings.Maps.Character_Set;
      Test : Ada.Strings.Membership := Ada.Strings.Inside;
      Going : Ada.Strings.Direction := Ada.Strings.Forward)
     return Natural is
   begin
      case Going is
         when Ada.Strings.Forward =>
            return Index (Source, Set, Source.First, Test, Going);
         when Ada.Strings.Backward =>
            return Index (Source, Set, Source.Last, Test, Going);
      end case;
   end Index;

end Natools.String_Slices.Slice_Sets;

------------------------------------------------------------------------------
-- Copyright (c) 2013, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.String_Slices.Slice_Sets implements objects representing a set   --
-- of non-overlapping slices of a single common reference string, sorted    --
-- by appearance order. It can also be viewed as the reference string minus --
-- any subset of indices.                                                   --
--                                                                          --
-- It is implemented on top of Natools.String_Slices to reuse the           --
-- reference-counted string holder infrastructure.                          --
------------------------------------------------------------------------------

with Ada.Strings.Maps;

private with Ada.Containers.Ordered_Sets;

package Natools.String_Slices.Slice_Sets is
   pragma Preelaborate (Slice_Sets);

   type Slice_Set is tagged private;


   ----------------------------
   -- Conversion subprograms --
   ----------------------------

   function To_Slice (S : Slice_Set) return Slice;
      --  Return a slice matching S contents.
      --  It re-uses the existing string reference if possible, and otherwise
      --  a new one is created.

   function To_Slice_Set (S : String) return Slice_Set;
      --  Create a new slice set referring to the given string as a whole

   function To_Slice_Set (S : Slice) return Slice_Set;
      --  Create a new slice set containing only the given slice

   function To_String (Set : Slice_Set) return String;
      --  Return the string represented by the concatenation of slices in Set

   function To_String (Set : Slice_Set; Subrange : String_Range) return String;
   function To_String (Set : Slice_Set; First : Positive; Last : Natural)
     return String;
      --  Return the concatenation of slices in Set and inside Subrage


   ---------------------------------
   -- Basic slice-set subprograms --
   ---------------------------------

   procedure Clear (Set : in out Slice_Set);
      --  Clear the set, keeping the parent string reference

   function Element (Set : Slice_Set; Index : Positive) return Character;
      --  Return the character at the given index
      --  Raise Constraint_Error when the index is outside the slice set

   function First (Set : Slice_Set) return Positive;
      --  Return the lowest index in Set

   function Is_Empty (Set : Slice_Set) return Boolean;
      --  Return whether any slice exists in Set

   function Is_In (Set : Slice_Set; Index : Natural) return Boolean;
      --  Return whether Index is inside Set

   function Is_Null (Set : Slice_Set) return Boolean;
      --  Return whether Set is empty and without parent string reference

   function Is_Valid (Set : Slice_Set) return Boolean;
      --  Check whether Set is in a consistent internal state

   function Last (Set : Slice_Set) return Natural;
      --  Return the largest index in Set

   function Next (Set : Slice_Set; Index : Natural) return Natural;
      --  Return smallest valid index in Set greater than Index

   procedure Next (Set : in Slice_Set; Index : in out Natural);
      --  Update Index to the following valid value

   function Previous (Set : Slice_Set; Index : Natural) return Natural;
      --  Return the greatest valid index in Set smaller than Index

   procedure Previous (Set : in Slice_Set; Index : in out Natural);
      --  Update Index to the preceeding valid value

   function Total_Length (Set : Slice_Set) return Natural;
      --  Return the number of characters in the slice set


   ----------------------------
   -- Operation on slice set --
   ----------------------------

   procedure Add_Slice
     (Set : in out Slice_Set;
      First : in Positive;
      Last : in Natural);
   procedure Add_Slice (Set : in out Slice_Set; Bounds : in String_Range);
   procedure Add_Slice (Set : in out Slice_Set; S : in Slice);
      --  Add the given slice to the set.
      --  Raise Constraint_Error when it overlaps existing slices in the set.

   procedure Include_Slice
     (Set : in out Slice_Set;
      First : in Positive;
      Last : in Natural);
   procedure Include_Slice (Set : in out Slice_Set; Bounds : in String_Range);
   procedure Include_Slice (Set : in out Slice_Set; S : in Slice);
      --  Merge the given slice with the existing set. This is an ensemblist
      --  union that allows overlaps.

   procedure Exclude_Slice
     (Set : in out Slice_Set;
      First : in Positive;
      Last : in Natural);
   procedure Exclude_Slice (Set : in out Slice_Set; Bounds : in String_Range);
      --  Subtract the given range form Set

   procedure Restrict (Set : in out Slice_Set; Bounds : in String_Range);
   procedure Restrict
     (Set : in out Slice_Set;
      First : in Positive;
      Last : in Natural);
      --  Subract from Set indices outside of Bounds

   function Subset (Set : Slice_Set; Bounds : String_Range) return Slice_Set;
   function Subset (Set : Slice_Set; First : Positive; Last : Natural)
     return Slice_Set;
      --  Return a slice set containing indices from Set that are inside Bounds

   procedure Cut_Before (Set : in out Slice_Set; Index : in Positive);
      --  Split the slice containing Index just before it


   ---------------
   -- Iterators --
   ---------------

   procedure Trim_Slices
     (Set : in out Slice_Set;
      Trim : not null access function (Slice : String) return String_Range);
      --  Iterate over slices in Set, and allow the callback to return
      --  a subrange.

   procedure Query_Slices
     (Set : in Slice_Set;
      Process : not null access procedure (S : in Slice));
      --  Call Process with each slice in Set

   function Find_Slice
     (Set : Slice_Set;
      From : Positive;
      Test : not null access function (Slice : String) return Boolean;
      Going : Ada.Strings.Direction := Ada.Strings.Forward)
     return String_Range;
      --  Iterate over slices, starting at From, and return the bounds of
      --  the first slice where Test returns True.

   function Find_Slice
     (Set : Slice_Set;
      Test : not null access function (Slice : String) return Boolean;
      Going : Ada.Strings.Direction := Ada.Strings.Forward)
     return String_Range;
      --  Variant of Find_Slice spanning the whole slice set


   ----------------------
   -- Search functions --
   ----------------------

   function Index
     (Source : Slice_Set;
      Set : Ada.Strings.Maps.Character_Set;
      From : Positive;
      Test : Ada.Strings.Membership := Ada.Strings.Inside;
      Going : Ada.Strings.Direction := Ada.Strings.Forward)
     return Natural;
      --  Equivalent to Ada.Strings.Fixed.Index restriced on the indices in Set

   function Index
     (Source : Slice_Set;
      Set : Ada.Strings.Maps.Character_Set;
      Test : Ada.Strings.Membership := Ada.Strings.Inside;
      Going : Ada.Strings.Direction := Ada.Strings.Forward)
     return Natural;
      --  Equivalent to Ada.Strings.Fixed.Index restriced on the indices in Set

private

   function "<" (Left, Right : String_Range) return Boolean;
      --  Comparison of the first bound, used for the ordered set

   package Range_Sets is new Ada.Containers.Ordered_Sets (String_Range);
   subtype Range_Set is Range_Sets.Set;

   function Is_Overlapping (Bounds : String_Range; Set : Range_Set)
     return Boolean;
      --  Return whether Bounds contains any index also in Set

   function Is_Valid (Set : Range_Set) return Boolean;
      --  Check whether intervals in Set are non-empty and non-overlapping

   function Total_Span (Set : Range_Set) return String_Range;
      --  Return the range formed by first and last indices in the whole set

   procedure Include_Range (Set : in out Range_Set; Bounds : in String_Range);
   procedure Exclude_Range (Set : in out Range_Set; Bounds : in String_Range);
      --  Perform ensemble union and subtraction of index sets


   type Slice_Set is tagged record
      Bounds : Range_Set;
      Ref : String_Refs.Reference;
   end record;

end Natools.String_Slices.Slice_Sets;