-------------------------------------------------------------------------------
-- (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.Relation_Algebra.String is

   procedure Create_Relation (The_Heap : in out Heap.HeapRecord;
                              R        :    out Relation) is
   begin
      RelationAlgebra.CreateRelation (TheHeap => The_Heap,
                                      R       => R.The_Relation);
   end Create_Relation;

   procedure Dispose_Of_Relation (The_Heap : in out Heap.HeapRecord;
                                  R        : in     Relation) is
   begin
      RelationAlgebra.DisposeOfRelation (TheHeap => The_Heap,
                                         R       => R.The_Relation);
   end Dispose_Of_Relation;

   -- Returns the value of the row value of a matrix element (Pair).
   function Row_Value (The_Heap : Heap.HeapRecord;
                       P        : RelationAlgebra.Pair) return LexTokenManager.Lex_String is
   begin
      return LexTokenManager.Lex_String (Heap.AValue (TheHeap => The_Heap,
                                                      A       => RelationAlgebra.Pair_To_Atom (P => P)));
   end Row_Value;

   -- Returns the row index value of the Row_Leader L.
   function Row_Ldr_Index (The_Heap : Heap.HeapRecord;
                           L        : RelationAlgebra.RowLeader) return LexTokenManager.Lex_String is
   begin
      return LexTokenManager.Lex_String (Heap.AValue (TheHeap => The_Heap,
                                                      A       => RelationAlgebra.RowLeader_To_Atom (R => L)));
   end Row_Ldr_Index;

   -- Inserts an element (Pair) specified by I and J into the matrix
   -- representing relation R.  If row I or column J do not exist in the matrix
   -- they are created.  The new Pair (I, J) is inserted into the matrix and
   -- the Cache is updated such that the current row is I and the current
   -- column is J and the current row and column elements refer to the new
   -- Pair (I, J).
   -- If the element (I, J) already exists in the matrix the operation has no
   -- effect on the matrix but the Cache is updated with the current row set
   -- to I, the current row and column elements set to the Pair (I, J) but
   -- the current column value is not changed --- Is this correct??
   -- R must be non null.
   procedure Cached_Insert_Pair
     (The_Heap : in out Heap.HeapRecord;
      R        : in     Relation;
      I, J     : in     LexTokenManager.Lex_String;
      Cache    : in out RelationAlgebra.Caches)
   --# global in     LexTokenManager.State;
   --#        in out Statistics.TableUsage;
   --# derives Cache,
   --#         Statistics.TableUsage,
   --#         The_Heap              from *,
   --#                                    Cache,
   --#                                    I,
   --#                                    J,
   --#                                    LexTokenManager.State,
   --#                                    R,
   --#                                    The_Heap;
   is
      Current_Pair, Last_Pair, New_Pair : RelationAlgebra.Pair;
      Row_Val, Col_Val                  : LexTokenManager.Lex_String;
      Pair_Present                      : Boolean;

      procedure Insert_Row_Leader
        (The_Heap : in out Heap.HeapRecord;
         R        : in     Relation;
         I        : in     LexTokenManager.Lex_String;
         Cache    : in out RelationAlgebra.Caches)
      --# global in     LexTokenManager.State;
      --#        in out Statistics.TableUsage;
      --# derives Cache,
      --#         The_Heap              from Cache,
      --#                                    I,
      --#                                    LexTokenManager.State,
      --#                                    R,
      --#                                    The_Heap &
      --#         Statistics.TableUsage from *,
      --#                                    Cache,
      --#                                    I,
      --#                                    LexTokenManager.State,
      --#                                    The_Heap;
      is
         Row_Ldr, Last_Ldr : RelationAlgebra.RowLeader;
         Ldr_Present       : Boolean;
         Ldr_Index         : LexTokenManager.Lex_String;

         procedure Create_Row_Leader
           (The_Heap : in out Heap.HeapRecord;
            P        : in     RelationAlgebra.RowLeader;
            I        : in     LexTokenManager.Lex_String;
            L        :    out RelationAlgebra.RowLeader)
         --# global in out Statistics.TableUsage;
         --# derives L                     from The_Heap &
         --#         Statistics.TableUsage from *,
         --#                                    The_Heap &
         --#         The_Heap              from *,
         --#                                    I,
         --#                                    P;
         is
            New_Atom : Heap.Atom;
         begin
            Heap.CreateAtom (TheHeap => The_Heap,
                             NewAtom => New_Atom);
            Heap.UpdateAValue (TheHeap => The_Heap,
                               A       => New_Atom,
                               Value   => Natural (I));
            Heap.UpdateBPointer
              (TheHeap => The_Heap,
               A       => New_Atom,
               Pointer => RelationAlgebra.RowLeader_To_Atom (R => RelationAlgebra.NextRowLeader (TheHeap => The_Heap,
                                                                                                 L       => P)));
            Heap.UpdateBPointer (TheHeap => The_Heap,
                                 A       => RelationAlgebra.RowLeader_To_Atom (R => P),
                                 Pointer => New_Atom);
            L := RelationAlgebra.Atom_To_RowLeader (A => New_Atom);
         end Create_Row_Leader;

      begin
         Row_Ldr     := Cache.RowLdr;
         Last_Ldr    := RelationAlgebra.Atom_To_RowLeader (A => RelationAlgebra.Relation_To_Atom (R => R.The_Relation));
         Ldr_Present := False;
         loop
            exit when Row_Ldr = RelationAlgebra.NullRowLdr;
            Ldr_Index := Row_Ldr_Index (The_Heap => The_Heap,
                                        L        => Row_Ldr);
            if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Ldr_Index,
                                                                    Lex_Str2 => I) =
              LexTokenManager.Str_Eq then
               Ldr_Present := True;
               exit;
            end if;
            exit when LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Ldr_Index,
                                                                           Lex_Str2 => I) =
              LexTokenManager.Str_Second;
            Last_Ldr := Row_Ldr;
            Row_Ldr  := RelationAlgebra.NextRowLeader (TheHeap => The_Heap,
                                                       L       => Row_Ldr);
         end loop;

         if not Ldr_Present then
            Create_Row_Leader (The_Heap => The_Heap,
                               P        => Last_Ldr,
                               I        => I,
                               L        => Row_Ldr);
         end if;

         if Row_Ldr /= Cache.RowLdr then
            Cache.RowLdr  := Row_Ldr;
            Cache.RowPair := RelationAlgebra.FirstInRow (TheHeap => The_Heap,
                                                         L       => Row_Ldr);
         end if;
      end Insert_Row_Leader;

      procedure Create_Pair
        (The_Heap : in out Heap.HeapRecord;
         New_Pair :    out RelationAlgebra.Pair;
         Row, Col : in     LexTokenManager.Lex_String)
      --# global in out Statistics.TableUsage;
      --# derives New_Pair              from The_Heap &
      --#         Statistics.TableUsage from *,
      --#                                    The_Heap &
      --#         The_Heap              from *,
      --#                                    Col,
      --#                                    Row;
      is
         A : Heap.Atom;
      begin
         Heap.CreateAtom (TheHeap => The_Heap,
                          NewAtom => A);
         Heap.UpdateAValue (TheHeap => The_Heap,
                            A       => A,
                            Value   => Natural (Row));
         Heap.UpdateBValue (TheHeap => The_Heap,
                            A       => A,
                            Value   => Natural (Col));
         New_Pair := RelationAlgebra.Atom_To_Pair (A => A);
      end Create_Pair;

   begin
      Insert_Row_Leader (The_Heap => The_Heap,
                         R        => R,
                         I        => I,
                         Cache    => Cache);
      Last_Pair    := RelationAlgebra.Atom_To_Pair (A => RelationAlgebra.RowLeader_To_Atom (R => Cache.RowLdr));
      Current_Pair := Cache.RowPair;
      Pair_Present := False;
      loop
         exit when RelationAlgebra.IsNullPair (P => Current_Pair);
         Col_Val := Relation_Algebra.Column_Value (The_Heap => The_Heap,
                                                   P        => Current_Pair);
         if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Col_Val,
                                                                 Lex_Str2 => J) =
           LexTokenManager.Str_Eq then
            Pair_Present := True;
            exit;
         end if;
         exit when LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Col_Val,
                                                                        Lex_Str2 => J) =
           LexTokenManager.Str_Second;
         Last_Pair    := Current_Pair;
         Current_Pair := RelationAlgebra.RightSuccr (TheHeap => The_Heap,
                                                     P       => Current_Pair);
      end loop;
      if Pair_Present then
         Cache.RowPair := Current_Pair;
         Cache.ColPair := Current_Pair;
      else
         Create_Pair (The_Heap => The_Heap,
                      New_Pair => New_Pair,
                      Row      => I,
                      Col      => J);
         RelationAlgebra.UpdateRight (TheHeap => The_Heap,
                                      P       => New_Pair,
                                      R       => Current_Pair);
         RelationAlgebra.UpdateRight (TheHeap => The_Heap,
                                      P       => Last_Pair,
                                      R       => New_Pair);

         Relation_Algebra.Insert_Col_Leader
           (The_Heap => The_Heap,
            R        => Relation_Algebra.Convert_To_Relation (R => R.The_Relation),
            J        => J,
            Cache    => Cache);
         Last_Pair    := RelationAlgebra.Atom_To_Pair (A => RelationAlgebra.ColLeader_To_Atom (C => Cache.ColLdr));
         Current_Pair := Cache.ColPair;
         loop
            exit when RelationAlgebra.IsNullPair (Current_Pair);
            Row_Val := Row_Value (The_Heap => The_Heap,
                                  P        => Current_Pair);
            exit when LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Row_Val,
                                                                           Lex_Str2 => I) =
              LexTokenManager.Str_Second;
            Last_Pair    := Current_Pair;
            Current_Pair := RelationAlgebra.DownSuccr (TheHeap => The_Heap,
                                                       P       => Current_Pair);
         end loop;
         RelationAlgebra.UpdateDown (TheHeap => The_Heap,
                                     P       => New_Pair,
                                     D       => Current_Pair);
         RelationAlgebra.UpdateDown (TheHeap => The_Heap,
                                     P       => Last_Pair,
                                     D       => New_Pair);

         Cache.RowPair := New_Pair;
         Cache.ColPair := New_Pair;
      end if;
   end Cached_Insert_Pair;

   procedure Insert_Pair (The_Heap : in out Heap.HeapRecord;
                          R        : in     Relation;
                          I, J     : in     LexTokenManager.Lex_String) is
      Cache : RelationAlgebra.Caches;
   begin
      RelationAlgebra.InitialiseCache (TheHeap => The_Heap,
                                       R       => R.The_Relation,
                                       Cache   => Cache);
      -- we do not need the changed value of Cache in this case
      --# accept F, 10, Cache, "Cache unused here";
      Cached_Insert_Pair (The_Heap => The_Heap,
                          R        => R,
                          I        => I,
                          J        => J,
                          Cache    => Cache);
      --# end accept;
   end Insert_Pair;

   procedure Row_Extraction
     (The_Heap    : in out Heap.HeapRecord;
      R           : in     Relation;
      Given_Index : in     LexTokenManager.Lex_String;
      S           :    out Seq_Algebra.Seq)
   is
      Row_Index : LexTokenManager.Lex_String;
      Row_Ldr   : RelationAlgebra.RowLeader;
      Row_Found : Boolean;
      Local_S   : Seq_Algebra.Seq;
      Last_S    : Seq_Algebra.Member_Of_Seq;
      P         : RelationAlgebra.Pair;
   begin
      Seq_Algebra.Create_Seq (The_Heap => The_Heap,
                              S        => Local_S);
      -- The optimisation using sequence operations
      -- BeforeFirstMember and AppendAfter is only permissible
      -- because Indices in a relation are ordered identically to the
      -- set ordering in s SeqAlgebra.  This assumption is implementation
      -- dependent and should be eliminated when a more efficient representation
      -- of sets and relations is implemented.
      Last_S := Seq_Algebra.Before_First_Member (S => Local_S);

      Row_Found := False;
      Row_Ldr   := RelationAlgebra.FirstRowLeader (TheHeap => The_Heap,
                                                   R       => R.The_Relation);
      loop
         exit when Row_Ldr = RelationAlgebra.NullRowLdr;
         Row_Index := Row_Ldr_Index (The_Heap => The_Heap,
                                     L        => Row_Ldr);
         if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Row_Index,
                                                                 Lex_Str2 => Given_Index) =
           LexTokenManager.Str_Eq then
            Row_Found := True;
            exit;
         end if;
         exit when LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Row_Index,
                                                                        Lex_Str2 => Given_Index) =
           LexTokenManager.Str_Second;
         Row_Ldr := RelationAlgebra.NextRowLeader (TheHeap => The_Heap,
                                                   L       => Row_Ldr);
      end loop;

      if Row_Found then
         P := RelationAlgebra.FirstInRow (TheHeap => The_Heap,
                                          L       => Row_Ldr);
         loop
            exit when P = RelationAlgebra.NullPair;
            -- The optimisation using sequence operations
            -- BeforeFirstMember and AppendAfter is only permissible
            -- because Indices in a relation are ordered identically to the
            -- set ordering in s SeqAlgebra.  This assumption is implementation
            -- dependent and should be eliminated when a more efficient representation
            -- of sets and relations is implemented.
            Seq_Algebra.Append_After
              (The_Heap    => The_Heap,
               M           => Last_S,
               Given_Value => Relation_Algebra.Column_Value (The_Heap => The_Heap,
                                                             P        => P));
            P := RelationAlgebra.RightSuccr (TheHeap => The_Heap,
                                             P       => P);
         end loop;
      end if;
      S := Local_S;
   end Row_Extraction;

   procedure Add_Col
     (The_Heap : in out Heap.HeapRecord;
      R        : in     Relation;
      J        : in     LexTokenManager.Lex_String;
      S        : in     Seq_Algebra.Seq)
   is
      M     : Seq_Algebra.Member_Of_Seq;
      Cache : RelationAlgebra.Caches;
   begin
      RelationAlgebra.InitialiseCache (TheHeap => The_Heap,
                                       R       => R.The_Relation,
                                       Cache   => Cache);
      M := Seq_Algebra.First_Member (The_Heap => The_Heap,
                                     S        => S);
      loop
         exit when Seq_Algebra.Is_Null_Member (M => M);
         Cached_Insert_Pair
           (The_Heap => The_Heap,
            R        => R,
            I        => Seq_Algebra.Value_Of_Member (The_Heap => The_Heap,
                                                     M        => M),
            J        => J,
            Cache    => Cache);
         M := Seq_Algebra.Next_Member (The_Heap => The_Heap,
                                       M        => M);
      end loop;
   end Add_Col;

   procedure Augment_Relation (The_Heap : in out Heap.HeapRecord;
                               A, B     : in     Relation)
   --  This procedure augments relation A by adding to it relation B.
   is
      P         : RelationAlgebra.Pair;
      Row_Index : LexTokenManager.Lex_String;
      Row_Ldr   : RelationAlgebra.RowLeader;
      Cache     : RelationAlgebra.Caches;
   begin
      RelationAlgebra.InitialiseCache (TheHeap => The_Heap,
                                       R       => A.The_Relation,
                                       Cache   => Cache);
      Row_Ldr := RelationAlgebra.FirstRowLeader (TheHeap => The_Heap,
                                                 R       => B.The_Relation);
      loop
         exit when Row_Ldr = RelationAlgebra.NullRowLdr;
         Row_Index := Row_Ldr_Index (The_Heap => The_Heap,
                                     L        => Row_Ldr);
         P         := RelationAlgebra.FirstInRow (TheHeap => The_Heap,
                                                  L       => Row_Ldr);
         loop
            exit when P = RelationAlgebra.NullPair;
            Cached_Insert_Pair
              (The_Heap => The_Heap,
               R        => A,
               I        => Row_Index,
               J        => Relation_Algebra.Column_Value (The_Heap => The_Heap,
                                                          P        => P),
               Cache    => Cache);
            P := RelationAlgebra.RightSuccr (TheHeap => The_Heap,
                                             P       => P);
         end loop;
         Row_Ldr := RelationAlgebra.NextRowLeader (TheHeap => The_Heap,
                                                   L       => Row_Ldr);
         RelationAlgebra.ResetColumnCache (TheHeap => The_Heap,
                                           Cache   => Cache);
      end loop;
   end Augment_Relation;

   procedure Debug (The_Heap : in Heap.HeapRecord;
                    R        : in Relation) is
      Row_Ldr : RelationAlgebra.RowLeader;
      P       : RelationAlgebra.Pair;

      procedure Print (S             : in LexTokenManager.Lex_String;
                       Is_Row_Leader : in Boolean)
      --# derives null from Is_Row_Leader,
      --#                   S;
      is
         --# hide Print;
      begin
         if Is_Row_Leader then
            Ada.Text_IO.New_Line;
         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 => " ");
         if Is_Row_Leader then
            Ada.Text_IO.Put (Item => "=> ");
         end if;
      end Print;

   begin
      Print (S             => LexTokenManager.Null_String,
             Is_Row_Leader => True);
      Row_Ldr := RelationAlgebra.FirstRowLeader (TheHeap => The_Heap,
                                                 R       => R.The_Relation);
      loop
         exit when Row_Ldr = RelationAlgebra.NullRowLdr;
         Print (S             => Row_Ldr_Index (The_Heap => The_Heap,
                                                L        => Row_Ldr),
                Is_Row_Leader => True);
         P := RelationAlgebra.FirstInRow (TheHeap => The_Heap,
                                          L       => Row_Ldr);
         loop
            exit when P = RelationAlgebra.NullPair;
            Print (S             => Relation_Algebra.Column_Value (The_Heap => The_Heap,
                                                                   P        => P),
                   Is_Row_Leader => False);
            P := RelationAlgebra.RightSuccr (TheHeap => The_Heap,
                                             P       => P);
         end loop;
         Row_Ldr := RelationAlgebra.NextRowLeader (TheHeap => The_Heap,
                                                   L       => Row_Ldr);
      end loop;
   end Debug;

end LexTokenManager.Relation_Algebra.String;
