-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT 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 the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

with Ada.Text_IO;
with E_Strings.Not_SPARK;

package body LexTokenManager.Seq_Algebra is

   function Is_Null_Seq (S : Seq) return Boolean is
   begin
      return SeqAlgebra.Is_Null_Seq (S => S.The_Seq);
   end Is_Null_Seq;

   function Is_Null_Member (M : Member_Of_Seq) return Boolean is
   begin
      return SeqAlgebra.IsNullMember (M => M.Member);
   end Is_Null_Member;

   function First_Member (The_Heap : Heap.HeapRecord;
                          S        : Seq) return Member_Of_Seq is
   begin
      return Member_Of_Seq'(Member => SeqAlgebra.FirstMember (TheHeap => The_Heap,
                                                              S       => S.The_Seq));
   end First_Member;

   function Next_Member (The_Heap : Heap.HeapRecord;
                         M        : Member_Of_Seq) return Member_Of_Seq is
   begin
      return Member_Of_Seq'(Member => SeqAlgebra.NextMember (TheHeap => The_Heap,
                                                             M       => M.Member));
   end Next_Member;

   -- Puts a marker atom (index S) onto TheHeap,
   -- with no members (A pointer is 0).
   procedure Create_Seq (The_Heap : in out Heap.HeapRecord;
                         S        :    out Seq) is
   begin
      SeqAlgebra.CreateSeq (TheHeap => The_Heap,
                            S       => S.The_Seq);
   end Create_Seq;

   function Is_Empty_Seq (The_Heap : Heap.HeapRecord;
                          S        : Seq) return Boolean is
   begin
      return SeqAlgebra.IsEmptySeq (TheHeap => The_Heap,
                                    S       => S.The_Seq);
   end Is_Empty_Seq;

   -- Frees all the atoms on the heap relating to
   --  sequence S.
   procedure Dispose_Of_Seq (The_Heap : in out Heap.HeapRecord;
                             S        : in     Seq) is
   begin
      SeqAlgebra.DisposeOfSeq (TheHeap => The_Heap,
                               S       => S.The_Seq);
   end Dispose_Of_Seq;

   function Before_First_Member (S : Seq) return Member_Of_Seq is
   begin
      return Member_Of_Seq'(Member => SeqAlgebra.BeforeFirstMember (S => S.The_Seq));
   end Before_First_Member;

   --  Note if this is used with a Seq representing a set this will
   --  destroy the numerical ordering of the set.
   procedure Append_After
     (The_Heap    : in out Heap.HeapRecord;
      M           : in out Member_Of_Seq;
      Given_Value : in     LexTokenManager.Lex_String)
   is
   begin
      SeqAlgebra.AppendAfter (TheHeap    => The_Heap,
                              M          => M.Member,
                              GivenValue => Natural (Given_Value));
   end Append_After;

   function Value_Of_Member (The_Heap : Heap.HeapRecord;
                             M        : Member_Of_Seq) return LexTokenManager.Lex_String is
   begin
      return LexTokenManager.Lex_String (SeqAlgebra.Value_Of_Member (The_Heap => The_Heap,
                                                                     M        => M.Member));
   end Value_Of_Member;

   -- Preserves the lexical ordering of the set.
   -- Do not use with a Seq representingg a sequence it may
   -- destroy the sequence order.
   procedure Add_Member (The_Heap    : in out Heap.HeapRecord;
                         S           : in     Seq;
                         Given_Value : in     LexTokenManager.Lex_String) is
      Member_Present : Boolean;
      M, N           : Member_Of_Seq;
      Value_Of_N     : LexTokenManager.Lex_String;
   begin
      Member_Present := False;
      M              := Before_First_Member (S => S);
      N              := First_Member (The_Heap => The_Heap,
                                      S        => S);
      loop
         exit when SeqAlgebra.IsNullMember (M => N.Member);
         Value_Of_N := Value_Of_Member (The_Heap => The_Heap,
                                        M        => N);
         if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Value_Of_N,
                                                                 Lex_Str2 => Given_Value) =
           LexTokenManager.Str_Eq then
            Member_Present := True;
            exit;
         end if;
         exit when LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Value_Of_N,
                                                                        Lex_Str2 => Given_Value) =
           LexTokenManager.Str_Second;
         M := N;
         N := Next_Member (The_Heap => The_Heap,
                           M        => N);
      end loop;
      if not Member_Present then
         -- we don't need the updated value of M in this case
         --# accept F, 10, M, "M unused here";
         SeqAlgebra.AppendAfter (TheHeap    => The_Heap,
                                 M          => M.Member,
                                 GivenValue => Natural (Given_Value));
         --# end accept;
      end if;
   end Add_Member;

   -- This operation uses the lexical ordering of a set.
   -- It might not remove an element from a sequence even if the element exists.
   procedure Remove_Member (The_Heap    : in out Heap.HeapRecord;
                            S           : in     Seq;
                            Given_Value : in     LexTokenManager.Lex_String) is
      Member_Present : Boolean;
      M, N           : Member_Of_Seq;
      Value_Of_N     : LexTokenManager.Lex_String;
   begin
      Member_Present := False;
      M              := Before_First_Member (S => S);
      N              := First_Member (The_Heap => The_Heap,
                                      S        => S);
      loop
         exit when SeqAlgebra.IsNullMember (M => N.Member);
         Value_Of_N := Value_Of_Member (The_Heap => The_Heap,
                                        M        => N);
         if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Value_Of_N,
                                                                 Lex_Str2 => Given_Value) =
           LexTokenManager.Str_Eq then
            Member_Present := True;
            exit;
         end if;
         exit when LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Value_Of_N,
                                                                        Lex_Str2 => Given_Value) =
           LexTokenManager.Str_Second;
         M := N;
         N := Next_Member (The_Heap => The_Heap,
                           M        => N);
      end loop;
      if Member_Present then
         SeqAlgebra.EliminateAfter (TheHeap => The_Heap,
                                    M       => M.Member);
      end if;
   end Remove_Member;

   -- This operation uses the lexical ordering of a set.
   -- It might not find an element from a sequence even if the element exists.
   function Is_Member
     (The_Heap    : Heap.HeapRecord;
      S           : Seq;
      Given_Value : LexTokenManager.Lex_String)
     return        Boolean
   is
      Member_Present : Boolean;
      N              : Member_Of_Seq;
      Value_Of_N     : LexTokenManager.Lex_String;
   begin
      Member_Present := False;
      N              := First_Member (The_Heap => The_Heap,
                                      S        => S);
      loop
         exit when SeqAlgebra.IsNullMember (M => N.Member);
         Value_Of_N := Value_Of_Member (The_Heap => The_Heap,
                                        M        => N);
         if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Value_Of_N,
                                                                 Lex_Str2 => Given_Value) =
           LexTokenManager.Str_Eq then
            Member_Present := True;
            exit;
         end if;
         exit when LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Value_Of_N,
                                                                        Lex_Str2 => Given_Value) =
           LexTokenManager.Str_Second;
         N := Next_Member (The_Heap => The_Heap,
                           M        => N);
      end loop;
      return Member_Present;
   end Is_Member;

   ----------- Set Operations on Seq representing Sets -----------

   --  Assumes A and B are in numerical order, i.e. a set, in which case
   --  C will be set too.
   --  The operation is meaningless for a Seq representing a sequence.
   procedure Union (The_Heap : in out Heap.HeapRecord;
                    A, B     : in     Seq;
                    C        :    out Seq) is
      Local_C                : Seq;
      M, N                   : Member_Of_Seq;
      Value_Of_M, Value_Of_N : LexTokenManager.Lex_String;
      Last_C                 : Member_Of_Seq;
   begin
      Create_Seq (The_Heap => The_Heap,
                  S        => Local_C);
      Last_C := Before_First_Member (S => Local_C);
      M      := First_Member (The_Heap => The_Heap,
                              S        => A);
      N      := First_Member (The_Heap => The_Heap,
                              S        => B);
      loop
         exit when SeqAlgebra.IsNullMember (M => M.Member) or SeqAlgebra.IsNullMember (M => N.Member);
         Value_Of_M := Value_Of_Member (The_Heap => The_Heap,
                                        M        => M);
         Value_Of_N := Value_Of_Member (The_Heap => The_Heap,
                                        M        => N);
         if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Value_Of_M,
                                                                 Lex_Str2 => Value_Of_N) =
           LexTokenManager.Str_Eq then
            Append_After (The_Heap    => The_Heap,
                          M           => Last_C,
                          Given_Value => Value_Of_M);
            M := Next_Member (The_Heap => The_Heap,
                              M        => M);
            N := Next_Member (The_Heap => The_Heap,
                              M        => N);
         elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Value_Of_M,
                                                                    Lex_Str2 => Value_Of_N) =
           LexTokenManager.Str_First then
            Append_After (The_Heap    => The_Heap,
                          M           => Last_C,
                          Given_Value => Value_Of_M);
            M := Next_Member (The_Heap => The_Heap,
                              M        => M);
         else
            Append_After (The_Heap    => The_Heap,
                          M           => Last_C,
                          Given_Value => Value_Of_N);
            N := Next_Member (The_Heap => The_Heap,
                              M        => N);
         end if;
      end loop;
      loop
         exit when SeqAlgebra.IsNullMember (M => M.Member);
         Append_After (The_Heap    => The_Heap,
                       M           => Last_C,
                       Given_Value => Value_Of_Member (The_Heap => The_Heap,
                                                       M        => M));
         M := Next_Member (The_Heap => The_Heap,
                           M        => M);
      end loop;
      loop
         exit when SeqAlgebra.IsNullMember (M => N.Member);
         Append_After (The_Heap    => The_Heap,
                       M           => Last_C,
                       Given_Value => Value_Of_Member (The_Heap => The_Heap,
                                                       M        => N));
         N := Next_Member (The_Heap => The_Heap,
                           M        => N);
      end loop;
      C := Local_C;
   end Union;

   -- This operation uses the lexical ordering of a set.
   --  The operation is meaningless for a Seq representing a sequence.
   procedure Augment_Seq (The_Heap : in out Heap.HeapRecord;
                          A, B     : in     Seq) is
      M, N                   : Member_Of_Seq;
      Value_Of_M, Value_Of_N : LexTokenManager.Lex_String;
      Last_M                 : Member_Of_Seq;
   begin
      M      := First_Member (The_Heap => The_Heap,
                              S        => A);
      Last_M := Before_First_Member (S => A);
      N      := First_Member (The_Heap => The_Heap,
                              S        => B);
      loop
         exit when SeqAlgebra.IsNullMember (M => M.Member) or SeqAlgebra.IsNullMember (M => N.Member);
         Value_Of_M := Value_Of_Member (The_Heap => The_Heap,
                                        M        => M);
         Value_Of_N := Value_Of_Member (The_Heap => The_Heap,
                                        M        => N);
         if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Value_Of_M,
                                                                 Lex_Str2 => Value_Of_N) =
           LexTokenManager.Str_Eq then
            Last_M := M;
            M      := Next_Member (The_Heap => The_Heap,
                                   M        => M);
            N      := Next_Member (The_Heap => The_Heap,
                                   M        => N);
         elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Value_Of_M,
                                                                    Lex_Str2 => Value_Of_N) =
           LexTokenManager.Str_First then
            Last_M := M;
            M      := Next_Member (The_Heap => The_Heap,
                                   M        => M);
         else
            Append_After (The_Heap    => The_Heap,
                          M           => Last_M,
                          Given_Value => Value_Of_N);
            N := Next_Member (The_Heap => The_Heap,
                              M        => N);
         end if;
      end loop;
      loop
         exit when SeqAlgebra.IsNullMember (M => N.Member);
         Append_After (The_Heap    => The_Heap,
                       M           => Last_M,
                       Given_Value => Value_Of_Member (The_Heap => The_Heap,
                                                       M        => N));
         N := Next_Member (The_Heap => The_Heap,
                           M        => N);
      end loop;
   end Augment_Seq;

   -- This operation uses the numerical ordering of a set.
   -- The operation is meaningless for a Seq representing a sequence.
   procedure Reduction (The_Heap : in out Heap.HeapRecord;
                        A, B     : in     Seq) is
      M, N                   : Member_Of_Seq;
      Value_Of_M, Value_Of_N : LexTokenManager.Lex_String;
      Last_M                 : Member_Of_Seq;
   begin
      M      := First_Member (The_Heap => The_Heap,
                              S        => A);
      Last_M := Before_First_Member (S => A);
      N      := First_Member (The_Heap => The_Heap,
                              S        => B);
      loop
         exit when SeqAlgebra.IsNullMember (M => M.Member) or SeqAlgebra.IsNullMember (M => N.Member);
         Value_Of_M := Value_Of_Member (The_Heap => The_Heap,
                                        M        => M);
         Value_Of_N := Value_Of_Member (The_Heap => The_Heap,
                                        M        => N);
         if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Value_Of_M,
                                                                 Lex_Str2 => Value_Of_N) =
           LexTokenManager.Str_Eq then
            M := Next_Member (The_Heap => The_Heap,
                              M        => M);
            N := Next_Member (The_Heap => The_Heap,
                              M        => N);
            SeqAlgebra.EliminateAfter (TheHeap => The_Heap,
                                       M       => Last_M.Member);
         elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Value_Of_M,
                                                                    Lex_Str2 => Value_Of_N) =
           LexTokenManager.Str_First then
            Last_M := M;
            M      := Next_Member (The_Heap => The_Heap,
                                   M        => M);
         else
            N := Next_Member (The_Heap => The_Heap,
                              M        => N);
         end if;
      end loop;
   end Reduction;

   procedure Debug (The_Heap : in Heap.HeapRecord;
                    S        : in Seq) is
      N               : Member_Of_Seq;
      Is_First_Member : Boolean;

      procedure Print (S               : in     LexTokenManager.Lex_String;
                       Is_First_Member : in out Boolean)
      --# derives Is_First_Member from *,
      --#                              S;
      is
         --# hide Print;
      begin
         if Is_First_Member then
            Ada.Text_IO.New_Line;
            Is_First_Member := False;
         end if;
         Ada.Text_IO.Put (Item => E_Strings.Not_SPARK.Get_String (E_Str => LexTokenManager.Lex_String_To_String (Lex_Str => S)));
         Ada.Text_IO.Put (Item => " ");
      end Print;

   begin
      --# accept F, 10, "Ineffective statement OK";
      Is_First_Member := True;
      N               := First_Member (The_Heap => The_Heap,
                                       S        => S);
      loop
         exit when SeqAlgebra.IsNullMember (M => N.Member);
         --# accept F, 10, Is_First_Member, "Assignment is ineffective OK";
         Print (S               => Value_Of_Member (The_Heap => The_Heap,
                                                    M        => N),
                Is_First_Member => Is_First_Member);
         --# end accept;
         N := Next_Member (The_Heap => The_Heap,
                           M        => N);
      end loop;
      --# accept F, 35, The_Heap, "Importation of the initial value is ineffective OK" &
      --#        F, 35, S, "Importation of the initial value is ineffective OK";
   end Debug;

end LexTokenManager.Seq_Algebra;
