-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

-- The matrices required to represent binary relations
-- associated with flow analysis are, in general, sparse.  The implementation of
-- the matrix uses a space efficient but not necessarily computationally
-- efficient representation. To improve computational efficiency the
-- implementation provides a cacheing mechanism.
-- Each element of the matrix is a pair of Natural numbers representing the
-- the row and column values.  The values also act as the row and column indices.
-- Each row of the matrix may be accessed by a RowLeader value and similarly
-- each column via ColLeader value.
-- A matrix has the following general structure:
--
--     Relation-------|      |----|     |----|     |----|
--          |        \|/     |   \|/    |   \|/    |   \|/
--          |         ColLeader ColLeader ColLeader ....
--         \|/        \|/         \|/       \|/        \|/
--    --RowLeader---->Pair------>Pair------>Pair------>...
--    |               \|/         \|/       \|/        \|/
--    ->RowLeader---->Pair------>Pair------>Pair------>...
--    |               \|/         \|/       \|/        \|/
--    ->RowLeader---->Pair------>Pair------>Pair------>...
--    |               \|/         \|/       \|/        \|/
--    ->RowLeader---->Pair------>Pair------>Pair------>...
--    |               \|/         \|/       \|/        \|/
--    ->RowLeader---->Pair------>Pair------>Pair------>...
--    |               \|/         \|/       \|/        \|/
--    -> ...--------->...-------->...------>...------->...
--
-- From a Relation object the first row and column leaders are directly
-- accessible and from each RowLeader and ColumnLeader the successive row or
-- column leader respectively is directly accessible.
-- From each row and column leader the first pair in the row or column is
-- directly accessible.
-- From a pair P it is possible to directly access the immediately adjacent
-- pair of the row and column.  The next pair in the row is notionally to the
-- right of P and will have a higher column index than P and the next pair in
-- the column is notionally down from P and will have a higher row index than P.
-- A pair is only included in the representation if the there exists an element
-- in the matrix.  This allows the representation of a sparse matrix with
-- minimal storage.  As a consequence of this row and column indices are not
-- successive values of the natural numbers so a given row or column may not
-- exist.  However it is guaranteed that the rows and columns of the matrix
-- representation are strictly increasing (there are no duplicates).

package body RelationAlgebra is

   ------ Functions and operations for implementation of RelationAlgebra ------

   function IsNullPair (P : Pair) return Boolean is
   begin
      return P = NullPair;
   end IsNullPair;

   -- Returns the value of the row value of a matrix element (Pair).
   function RowValue (TheHeap : Heap.HeapRecord;
                      P       : Pair) return Natural is
   begin
      return Heap.AValue (TheHeap, Heap.Atom (P));
   end RowValue;

   -- Returns the value of the column value of a matrix element (Pair).
   function ColumnValue (TheHeap : Heap.HeapRecord;
                         P       : Pair) return Natural is
   begin
      return Heap.BValue (TheHeap, Heap.Atom (P));
   end ColumnValue;

   -- Gets the next matrix element (Pair) in the row adjacent to Pair P.
   function RightSuccr (TheHeap : Heap.HeapRecord;
                        P       : Pair) return Pair is
   begin
      return Pair (Heap.APointer (TheHeap, Heap.Atom (P)));
   end RightSuccr;

   -- Gets the next matrix element (Pair) in the column adjacent to Pair P.
   function DownSuccr (TheHeap : Heap.HeapRecord;
                       P       : Pair) return Pair is
   begin
      return Pair (Heap.BPointer (TheHeap, Heap.Atom (P)));
   end DownSuccr;

   -- Obtains the first row (Row_Leader) of the relation R.
   function FirstRowLeader (TheHeap : Heap.HeapRecord;
                            R       : Relation) return RowLeader is
   begin
      return RowLeader (Heap.BPointer (TheHeap, Heap.Atom (R)));
   end FirstRowLeader;

   -- Obtains the succeeding row (Row_Leader) from the given Row_Leader L.
   function NextRowLeader (TheHeap : Heap.HeapRecord;
                           L       : RowLeader) return RowLeader is
   begin
      return RowLeader (Heap.BPointer (TheHeap, Heap.Atom (L)));
   end NextRowLeader;

   -- Obtains the first column (Col_Leader) of the relation R.
   function FirstColLeader (TheHeap : Heap.HeapRecord;
                            R       : Relation) return ColLeader is
   begin
      return ColLeader (Heap.APointer (TheHeap, Heap.Atom (R)));
   end FirstColLeader;

   -- Obtains the succeeding column (Col_Leader) from the given Col_Leader L.
   function NextColLeader (TheHeap : Heap.HeapRecord;
                           L       : ColLeader) return ColLeader is
   begin
      return ColLeader (Heap.APointer (TheHeap, Heap.Atom (L)));
   end NextColLeader;

   -- Obtains the first matrix element (Pair) in the row specified by
   -- Row_Leader L.
   function FirstInRow (TheHeap : Heap.HeapRecord;
                        L       : RowLeader) return Pair is
   begin
      return Pair (Heap.APointer (TheHeap, Heap.Atom (L)));
   end FirstInRow;

   -- Obtains the first matrix element (Pair) in the column specified by
   -- Col_Leader L.
   function FirstInCol (TheHeap : Heap.HeapRecord;
                        L       : ColLeader) return Pair is
   begin
      return Pair (Heap.BPointer (TheHeap, Heap.Atom (L)));
   end FirstInCol;

   procedure CreateRelation (TheHeap : in out Heap.HeapRecord;
                             R       :    out Relation) is
      A : Heap.Atom;
   begin
      Heap.CreateAtom (TheHeap, A);
      R := Relation (A);
   end CreateRelation;

   procedure DisposeOfRelation (TheHeap : in out Heap.HeapRecord;
                                R       : in     Relation) is
      K, L : RowLeader;
      M, N : ColLeader;
      P, Q : Pair;
   begin
      K := FirstRowLeader (TheHeap, R);
      while K /= NullRowLdr loop
         P := FirstInRow (TheHeap, K);
         while P /= NullPair loop
            Q := RightSuccr (TheHeap, P);
            Heap.DisposeOfAtom (TheHeap, Heap.Atom (P));
            P := Q;
         end loop;
         L := NextRowLeader (TheHeap, K);
         Heap.DisposeOfAtom (TheHeap, Heap.Atom (K));
         K := L;
      end loop;
      M := FirstColLeader (TheHeap, R);
      while M /= NullColLdr loop
         N := NextColLeader (TheHeap, M);
         Heap.DisposeOfAtom (TheHeap, Heap.Atom (M));
         M := N;
      end loop;
      Heap.DisposeOfAtom (TheHeap, Heap.Atom (R));
   end DisposeOfRelation;

   procedure UpdateRight (TheHeap : in out Heap.HeapRecord;
                          P, R    : in     Pair) is
   begin
      Heap.UpdateAPointer (TheHeap, Heap.Atom (P), Heap.Atom (R));
   end UpdateRight;

   procedure UpdateDown (TheHeap : in out Heap.HeapRecord;
                         P, D    : in     Pair) is
   begin
      Heap.UpdateBPointer (TheHeap, Heap.Atom (P), Heap.Atom (D));
   end UpdateDown;

   function Relation_To_Atom (R : Relation) return Heap.Atom is
   begin
      return Heap.Atom (R);
   end Relation_To_Atom;

   function Pair_To_Atom (P : Pair) return Heap.Atom is
   begin
      return Heap.Atom (P);
   end Pair_To_Atom;

   function Atom_To_Pair (A : Heap.Atom) return Pair is
   begin
      return Pair (A);
   end Atom_To_Pair;

   function RowLeader_To_Atom (R : RowLeader) return Heap.Atom is
   begin
      return Heap.Atom (R);
   end RowLeader_To_Atom;

   function Atom_To_RowLeader (A : Heap.Atom) return RowLeader is
   begin
      return RowLeader (A);
   end Atom_To_RowLeader;

   function ColLeader_To_Atom (C : ColLeader) return Heap.Atom is
   begin
      return Heap.Atom (C);
   end ColLeader_To_Atom;

   function Atom_To_ColLeader (A : Heap.Atom) return ColLeader is
   begin
      return ColLeader (A);
   end Atom_To_ColLeader;

   -- Initalizes the Cache from relation R and must be called prior to its use.
   -- Once initialized a cache is associated with R and should not be used to
   -- access any other relation.
   procedure InitialiseCache (TheHeap : in     Heap.HeapRecord;
                              R       : in     Relation;
                              Cache   :    out Caches) is
      RL : RowLeader;
      CL : ColLeader;
   begin
      RL := FirstRowLeader (TheHeap, R);
      CL := FirstColLeader (TheHeap, R);

      Cache :=
        Caches'(Rtion   => R,
                RowLdr  => RL,
                ColLdr  => CL,
                RowPair => FirstInRow (TheHeap, RL),
                ColPair => FirstInCol (TheHeap, CL));
   end InitialiseCache;

   -- Returns the row index value of the Row_Leader L.
   function RowLdrIndex (TheHeap : Heap.HeapRecord;
                         L       : RowLeader) return Natural is
   begin
      return Heap.AValue (TheHeap, Heap.Atom (L));
   end RowLdrIndex;

   -- Returns the column index value of the Col_Leader L.
   function ColLdrIndex (TheHeap : Heap.HeapRecord;
                         L       : ColLeader) return Natural is
   begin
      return Heap.BValue (TheHeap, Heap.Atom (L));
   end ColLdrIndex;

   procedure Insert_Row_Leader
     (The_Heap : in out Heap.HeapRecord;
      R        : in     Relation;
      I        : in     Natural;
      Cache    : in out Caches)
   is
      Row_Ldr, Last_Ldr : RowLeader;
      Ldr_Present       : Boolean;
      Ldr_Index         : Natural;

      procedure Create_Row_Leader
        (The_Heap : in out Heap.HeapRecord;
         P        : in     RowLeader;
         I        : in     Natural;
         L        :    out 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   => I);
         Heap.UpdateBPointer
           (TheHeap => The_Heap,
            A       => New_Atom,
            Pointer => Heap.Atom (NextRowLeader (TheHeap => The_Heap,
                                                 L       => P)));
         Heap.UpdateBPointer (TheHeap => The_Heap,
                              A       => Heap.Atom (P),
                              Pointer => New_Atom);
         L := RowLeader (New_Atom);
      end Create_Row_Leader;

   begin
      Row_Ldr     := Cache.RowLdr;
      Last_Ldr    := RowLeader (R);
      Ldr_Present := False;
      loop
         exit when Row_Ldr = NullRowLdr;
         Ldr_Index   := RowLdrIndex (TheHeap => The_Heap,
                                     L       => Row_Ldr);
         Ldr_Present := Ldr_Index = I;
         exit when Ldr_Index >= I;
         Last_Ldr := Row_Ldr;
         Row_Ldr  := 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 := FirstInRow (TheHeap => The_Heap,
                                      L       => Row_Ldr);
      end if;
   end Insert_Row_Leader;

   --------------------------exported procedure-----------------------------

   -- 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 CachedInsertPair
     (TheHeap : in out Heap.HeapRecord;
      R       : in     Relation;
      I, J    : in     Natural;
      Cache   : in out Caches)
   --# global in out Statistics.TableUsage;
   --# derives Cache,
   --#         Statistics.TableUsage,
   --#         TheHeap               from *,
   --#                                    Cache,
   --#                                    I,
   --#                                    J,
   --#                                    R,
   --#                                    TheHeap;
   is
      CurrentPair, LastPair, NewPair : Pair;
      RowVal, ColVal                 : Natural;
      PairPresent                    : Boolean;

      procedure InsertColLeader
        (TheHeap : in out Heap.HeapRecord;
         R       : in     Relation;
         J       : in     Natural;
         Cache   : in out Caches)
      --# global in out Statistics.TableUsage;
      --# derives Cache,
      --#         TheHeap               from Cache,
      --#                                    J,
      --#                                    R,
      --#                                    TheHeap &
      --#         Statistics.TableUsage from *,
      --#                                    Cache,
      --#                                    J,
      --#                                    TheHeap;
      is
         ColLdr, LastLdr : ColLeader;
         LdrPresent      : Boolean;
         LdrIndex        : Natural;

         procedure CreateColLeader
           (TheHeap : in out Heap.HeapRecord;
            P       : in     ColLeader;
            J       : in     Natural;
            L       :    out ColLeader)
         --# global in out Statistics.TableUsage;
         --# derives L                     from TheHeap &
         --#         Statistics.TableUsage from *,
         --#                                    TheHeap &
         --#         TheHeap               from *,
         --#                                    J,
         --#                                    P;
         is
            NewAtom : Heap.Atom;
         begin
            Heap.CreateAtom (TheHeap, NewAtom);
            Heap.UpdateBValue (TheHeap, NewAtom, J);
            Heap.UpdateAPointer (TheHeap, NewAtom, Heap.Atom (NextColLeader (TheHeap, P)));
            Heap.UpdateAPointer (TheHeap, Heap.Atom (P), NewAtom);
            L := ColLeader (NewAtom);
         end CreateColLeader;

      begin
         ColLdr     := Cache.ColLdr;
         LastLdr    := ColLeader (R);
         LdrPresent := False;
         loop
            exit when ColLdr = NullColLdr;
            LdrIndex   := ColLdrIndex (TheHeap, ColLdr);
            LdrPresent := LdrIndex = J;
            exit when LdrIndex >= J;
            LastLdr := ColLdr;
            ColLdr  := NextColLeader (TheHeap, ColLdr);
         end loop;

         if not LdrPresent then
            CreateColLeader (TheHeap, LastLdr, J, ColLdr);
         end if;

         if ColLdr /= Cache.ColLdr then
            Cache.ColLdr  := ColLdr;
            Cache.ColPair := FirstInCol (TheHeap, ColLdr);
         end if;
      end InsertColLeader;

      procedure CreatePair (TheHeap  : in out Heap.HeapRecord;
                            NewPair  :    out Pair;
                            Row, Col : in     Natural)
      --# global in out Statistics.TableUsage;
      --# derives NewPair               from TheHeap &
      --#         Statistics.TableUsage from *,
      --#                                    TheHeap &
      --#         TheHeap               from *,
      --#                                    Col,
      --#                                    Row;
      is
         A : Heap.Atom;
      begin
         Heap.CreateAtom (TheHeap, A);
         Heap.UpdateAValue (TheHeap, A, Row);
         Heap.UpdateBValue (TheHeap, A, Col);
         NewPair := Pair (A);
      end CreatePair;

   begin
      Insert_Row_Leader (The_Heap => TheHeap,
                         R        => R,
                         I        => I,
                         Cache    => Cache);
      LastPair    := Pair (Cache.RowLdr);
      CurrentPair := Cache.RowPair;
      PairPresent := False;
      loop
         exit when IsNullPair (CurrentPair);
         ColVal      := ColumnValue (TheHeap, CurrentPair);
         PairPresent := ColVal = J;
         exit when ColVal >= J;
         LastPair    := CurrentPair;
         CurrentPair := RightSuccr (TheHeap, CurrentPair);
      end loop;
      if PairPresent then
         Cache.RowPair := CurrentPair;
         Cache.ColPair := CurrentPair;
      else
         CreatePair (TheHeap, NewPair, I, J);
         UpdateRight (TheHeap, NewPair, CurrentPair);
         UpdateRight (TheHeap, LastPair, NewPair);

         InsertColLeader (TheHeap, R, J, Cache);
         LastPair    := Pair (Cache.ColLdr);
         CurrentPair := Cache.ColPair;
         loop
            exit when IsNullPair (CurrentPair);
            RowVal := RowValue (TheHeap, CurrentPair);
            exit when RowVal > I;
            LastPair    := CurrentPair;
            CurrentPair := DownSuccr (TheHeap, CurrentPair);
         end loop;
         UpdateDown (TheHeap, NewPair, CurrentPair);
         UpdateDown (TheHeap, LastPair, NewPair);

         Cache.RowPair := NewPair;
         Cache.ColPair := NewPair;
      end if;
   end CachedInsertPair;

   procedure InsertPair (TheHeap : in out Heap.HeapRecord;
                         R       : in     Relation;
                         I, J    : in     Natural) is
      Cache : Caches;
   begin
      InitialiseCache (TheHeap, R, Cache);
      -- we do not need the changed value of Cache in this case
      --# accept F, 10, Cache, "Cache unused here";
      CachedInsertPair (TheHeap, R, I, J, Cache);
      --# end accept;
   end InsertPair;

   procedure AddRow
     (TheHeap : in out Heap.HeapRecord;
      R       : in     Relation;
      I       : in     Natural;
      S       : in     SeqAlgebra.Seq)
   is
      M     : SeqAlgebra.MemberOfSeq;
      Cache : Caches;
   begin
      InitialiseCache (TheHeap, R, Cache);
      M := SeqAlgebra.FirstMember (TheHeap, S);
      loop
         exit when SeqAlgebra.IsNullMember (M);
         CachedInsertPair (TheHeap, R, I, SeqAlgebra.Value_Of_Member (The_Heap => TheHeap,
                                                                      M        => M), Cache);
         M := SeqAlgebra.NextMember (TheHeap, M);
      end loop;
   end AddRow;

   procedure AddCol
     (TheHeap : in out Heap.HeapRecord;
      R       : in     Relation;
      J       : in     Natural;
      S       : in     SeqAlgebra.Seq)
   is
      M     : SeqAlgebra.MemberOfSeq;
      Cache : Caches;
   begin
      InitialiseCache (TheHeap, R, Cache);
      M := SeqAlgebra.FirstMember (TheHeap, S);
      loop
         exit when SeqAlgebra.IsNullMember (M);
         CachedInsertPair (TheHeap, R, SeqAlgebra.Value_Of_Member (The_Heap => TheHeap,
                                                                   M        => M), J, Cache);
         M := SeqAlgebra.NextMember (TheHeap, M);
      end loop;
   end AddCol;

   --------- Fundamental functions and operations of RelationAlgebra ---------

   function IsEmptyRow
     (TheHeap : Heap.HeapRecord;
      R       : Relation;
      I       : Natural)
     return    Boolean
   is
      RowLdr : RowLeader;
   begin
      RowLdr := FirstRowLeader (TheHeap, R);
      while (RowLdr /= NullRowLdr) and then (RowLdrIndex (TheHeap, RowLdr) < I) loop
         RowLdr := NextRowLeader (TheHeap, RowLdr);
      end loop;
      return (RowLdr = NullRowLdr)
        or else (RowLdrIndex (TheHeap, RowLdr) /= I)
        or else (FirstInRow (TheHeap, RowLdr) = NullPair);
   end IsEmptyRow;

   function ColumnCount
     (TheHeap : Heap.HeapRecord;
      R       : Relation;
      J       : Natural)
     return    Natural
   is
      Counter : Natural;
      ColLdr  : ColLeader;
      Q       : Pair;
   begin
      Counter := 0;
      ColLdr  := FirstColLeader (TheHeap, R);
      while ColLdr /= NullColLdr loop
         exit when ColLdrIndex (TheHeap, ColLdr) >= J;
         ColLdr := NextColLeader (TheHeap, ColLdr);
      end loop;
      if ColLdrIndex (TheHeap, ColLdr) = J then
         Q := FirstInCol (TheHeap, ColLdr);
         while Q /= NullPair loop
            Counter := Counter + 1;
            Q       := DownSuccr (TheHeap, Q);
         end loop;
      end if;
      return Counter;
   end ColumnCount;

   procedure ResetColumnCache (TheHeap : in     Heap.HeapRecord;
                               Cache   : in out Caches) is
   begin
      Cache.ColLdr  := FirstColLeader (TheHeap, Cache.Rtion);
      Cache.ColPair := FirstInCol (TheHeap, Cache.ColLdr);
   end ResetColumnCache;

   procedure RowRemoval
     (TheHeap : in out Heap.HeapRecord;
      R       : in     Relation;
      S       : in     SeqAlgebra.Seq;
      T       :    out Relation)
   is
      LocalT   : Relation;
      P        : Pair;
      RowIndex : Natural;
      RowLdr   : RowLeader;
      Cache    : Caches;
   begin
      CreateRelation (TheHeap, LocalT);
      InitialiseCache (TheHeap, LocalT, Cache);
      RowLdr := FirstRowLeader (TheHeap, R);
      while RowLdr /= NullRowLdr loop
         RowIndex := RowLdrIndex (TheHeap, RowLdr);
         if not SeqAlgebra.IsMember (TheHeap, S, RowIndex) then
            P := FirstInRow (TheHeap, RowLdr);
            while P /= NullPair loop
               CachedInsertPair (TheHeap, LocalT, RowIndex, ColumnValue (TheHeap, P), Cache);
               P := RightSuccr (TheHeap, P);
            end loop;
         end if;
         RowLdr := NextRowLeader (TheHeap, RowLdr);
         ResetColumnCache (TheHeap, Cache);
      end loop;
      T := LocalT;
   end RowRemoval;

   procedure RowExtraction
     (TheHeap    : in out Heap.HeapRecord;
      R          : in     Relation;
      GivenIndex : in     Natural;
      S          :    out SeqAlgebra.Seq)
   is
      RowIndex : Natural;
      RowLdr   : RowLeader;
      RowFound : Boolean;
      LocalS   : SeqAlgebra.Seq;
      LastS    : SeqAlgebra.MemberOfSeq;
      P        : Pair;
   begin
      SeqAlgebra.CreateSeq (TheHeap, LocalS);
      -- 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.
      LastS := SeqAlgebra.BeforeFirstMember (LocalS);

      RowFound := False;
      RowLdr   := FirstRowLeader (TheHeap, R);
      loop
         exit when RowLdr = NullRowLdr;
         RowIndex := RowLdrIndex (TheHeap, RowLdr);
         RowFound := (RowIndex = GivenIndex);
         exit when RowIndex >= GivenIndex;
         RowLdr := NextRowLeader (TheHeap, RowLdr);
      end loop;

      if RowFound then
         P := FirstInRow (TheHeap, RowLdr);
         loop
            exit when P = 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.
            SeqAlgebra.AppendAfter (TheHeap, LastS, ColumnValue (TheHeap, P));
            P := RightSuccr (TheHeap, P);
         end loop;
      end if;
      S := LocalS;
   end RowExtraction;

   procedure ColExtraction
     (TheHeap    : in out Heap.HeapRecord;
      R          : in     Relation;
      GivenIndex : in     Natural;
      S          :    out SeqAlgebra.Seq)
   is
      ColIndex : Natural;
      ColLdr   : ColLeader;
      ColFound : Boolean;
      LocalS   : SeqAlgebra.Seq;
      LastS    : SeqAlgebra.MemberOfSeq;
      P        : Pair;
   begin
      SeqAlgebra.CreateSeq (TheHeap, LocalS);
      -- 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.
      LastS := SeqAlgebra.BeforeFirstMember (LocalS);

      ColFound := False;
      ColLdr   := FirstColLeader (TheHeap, R);
      loop
         exit when ColLdr = NullColLdr;
         ColIndex := ColLdrIndex (TheHeap, ColLdr);
         ColFound := (ColIndex = GivenIndex);
         exit when ColIndex >= GivenIndex;
         ColLdr := NextColLeader (TheHeap, ColLdr);
      end loop;
      if ColFound then
         P := FirstInCol (TheHeap, ColLdr);
         loop
            exit when P = 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.
            SeqAlgebra.AppendAfter (TheHeap, LastS, RowValue (TheHeap, P));
            P := DownSuccr (TheHeap, P);
         end loop;
      end if;
      S := LocalS;
   end ColExtraction;

   procedure ExtractSubRelation (TheHeap : in out Heap.HeapRecord;
                                 R       : in out Relation;
                                 S       : in     SeqAlgebra.Seq) is
      LocalR             : Relation;
      P                  : Pair;
      ColIndex, RowIndex : Natural;
      RowLdr             : RowLeader;
      Cache              : Caches;
   begin
      CreateRelation (TheHeap, LocalR);
      InitialiseCache (TheHeap, LocalR, Cache);
      RowLdr := FirstRowLeader (TheHeap, R);
      loop
         exit when RowLdr = NullRowLdr;
         RowIndex := RowLdrIndex (TheHeap, RowLdr);
         if SeqAlgebra.IsMember (TheHeap, S, RowIndex) then
            P := FirstInRow (TheHeap, RowLdr);
            loop
               exit when P = NullPair;
               ColIndex := ColumnValue (TheHeap, P);
               if SeqAlgebra.IsMember (TheHeap, S, ColIndex) then
                  CachedInsertPair (TheHeap, LocalR, RowIndex, ColIndex, Cache);
               end if;
               P := RightSuccr (TheHeap, P);
            end loop;
         end if;
         RowLdr := NextRowLeader (TheHeap, RowLdr);
         ResetColumnCache (TheHeap, Cache);
      end loop;
      DisposeOfRelation (TheHeap, R);
      R := LocalR;
   end ExtractSubRelation;

   procedure AddIdentity (TheHeap : in out Heap.HeapRecord;
                          R       : in     Relation;
                          S       : in     SeqAlgebra.Seq) is
      M     : SeqAlgebra.MemberOfSeq;
      Cache : Caches;
   begin
      InitialiseCache (TheHeap, R, Cache);
      M := SeqAlgebra.FirstMember (TheHeap, S);
      loop
         exit when SeqAlgebra.IsNullMember (M);
         CachedInsertPair
           (TheHeap,
            R,
            SeqAlgebra.Value_Of_Member (The_Heap => TheHeap,
                                        M        => M),
            SeqAlgebra.Value_Of_Member (The_Heap => TheHeap,
                                        M        => M),
            Cache);
         M := SeqAlgebra.NextMember (TheHeap, M);
      end loop;
   end AddIdentity;

   procedure AugmentRelation (TheHeap : in out Heap.HeapRecord;
                              A, B    : in     Relation)
   --  This procedure augments relation A by adding to it relation B.
   is
      P        : Pair;
      RowIndex : Natural;
      RowLdr   : RowLeader;
      Cache    : Caches;
   begin
      InitialiseCache (TheHeap, A, Cache);
      RowLdr := FirstRowLeader (TheHeap, B);
      loop
         exit when RowLdr = NullRowLdr;
         RowIndex := RowLdrIndex (TheHeap, RowLdr);
         P        := FirstInRow (TheHeap, RowLdr);
         loop
            exit when P = NullPair;
            CachedInsertPair (TheHeap, A, RowIndex, ColumnValue (TheHeap, P), Cache);
            P := RightSuccr (TheHeap, P);
         end loop;
         RowLdr := NextRowLeader (TheHeap, RowLdr);
         ResetColumnCache (TheHeap, Cache);
      end loop;
   end AugmentRelation;

   procedure Sum (TheHeap : in out Heap.HeapRecord;
                  A, B    : in     Relation;
                  C       :    out Relation) is
      LocalC : Relation;
   begin
      CreateRelation (TheHeap, LocalC);
      AugmentRelation (TheHeap, LocalC, A);
      AugmentRelation (TheHeap, LocalC, B);
      C := LocalC;
   end Sum;

   procedure Composition (TheHeap : in out Heap.HeapRecord;
                          A, B    : in     Relation;
                          C       :    out Relation) is
      LocalC               : Relation;
      RowLdr               : RowLeader;
      ColLdr               : ColLeader;
      RowIndex             : Natural;
      MatchFound           : Boolean;
      P, Q                 : Pair;
      PColValue, QRowValue : Natural;
      Cache                : Caches;
   begin
      CreateRelation (TheHeap, LocalC);
      InitialiseCache (TheHeap, LocalC, Cache);
      RowLdr := FirstRowLeader (TheHeap, A);
      while RowLdr /= NullRowLdr loop
         RowIndex := RowLdrIndex (TheHeap, RowLdr);
         ColLdr   := FirstColLeader (TheHeap, B);
         loop
            exit when ColLdr = NullColLdr;
            P          := FirstInRow (TheHeap, RowLdr);
            Q          := FirstInCol (TheHeap, ColLdr);
            MatchFound := False;
            loop
               exit when (P = NullPair) or (Q = NullPair) or MatchFound;
               PColValue := ColumnValue (TheHeap, P);
               QRowValue := RowValue (TheHeap, Q);
               if PColValue < QRowValue then
                  P := RightSuccr (TheHeap, P);
               elsif PColValue > QRowValue then
                  Q := DownSuccr (TheHeap, Q);
               else
                  MatchFound := True;
               end if;
            end loop;
            if MatchFound then
               CachedInsertPair (TheHeap, LocalC, RowIndex, ColLdrIndex (TheHeap, ColLdr), Cache);
            end if;
            ColLdr := NextColLeader (TheHeap, ColLdr);
         end loop;
         RowLdr := NextRowLeader (TheHeap, RowLdr);
         ResetColumnCache (TheHeap, Cache);
      end loop;
      C := LocalC;
   end Composition;

   procedure CloseRelation (TheHeap : in out Heap.HeapRecord;
                            R       : in     Relation) is
      RowLdr               : RowLeader;
      ColLdr               : ColLeader;
      RowIndex, ColIndex   : Natural;
      P, Q                 : Pair;
      PColValue, QRowValue : Natural;
   begin
      RowLdr := FirstRowLeader (TheHeap, R);
      ColLdr := FirstColLeader (TheHeap, R);
      loop
         exit when (RowLdr = NullRowLdr) or (ColLdr = NullColLdr);
         RowIndex := RowLdrIndex (TheHeap, RowLdr);
         ColIndex := ColLdrIndex (TheHeap, ColLdr);
         if RowIndex < ColIndex then
            RowLdr := NextRowLeader (TheHeap, RowLdr);
         elsif RowIndex > ColIndex then
            ColLdr := NextColLeader (TheHeap, ColLdr);
         else
            P := FirstInRow (TheHeap, RowLdr);
            loop
               exit when P = NullPair;
               PColValue := ColumnValue (TheHeap, P);
               if PColValue /= RowIndex then
                  Q := FirstInCol (TheHeap, ColLdr);
                  loop
                     exit when Q = NullPair;
                     QRowValue := RowValue (TheHeap, Q);
                     if QRowValue /= ColIndex then
                        InsertPair (TheHeap, R, QRowValue, PColValue);
                     end if;
                     Q := DownSuccr (TheHeap, Q);
                  end loop;
               end if;
               P := RightSuccr (TheHeap, P);
            end loop;
            RowLdr := NextRowLeader (TheHeap, RowLdr);
            ColLdr := NextColLeader (TheHeap, ColLdr);
         end if;
      end loop;
   end CloseRelation;

   procedure CartesianProduct (TheHeap : in out Heap.HeapRecord;
                               A, B    : in     SeqAlgebra.Seq;
                               C       :    out Relation) is
      LocalC   : Relation;
      M, N     : SeqAlgebra.MemberOfSeq;
      ValueOfM : Natural;
      Cache    : Caches;
   begin
      CreateRelation (TheHeap, LocalC);
      InitialiseCache (TheHeap, LocalC, Cache);
      M := SeqAlgebra.FirstMember (TheHeap, A);
      loop
         exit when SeqAlgebra.IsNullMember (M);
         ValueOfM := SeqAlgebra.Value_Of_Member (The_Heap => TheHeap,
                                                 M        => M);
         N        := SeqAlgebra.FirstMember (TheHeap, B);
         loop
            exit when SeqAlgebra.IsNullMember (N);
            CachedInsertPair (TheHeap, LocalC, ValueOfM, SeqAlgebra.Value_Of_Member (The_Heap => TheHeap,
                                                                                     M        => N), Cache);
            N := SeqAlgebra.NextMember (TheHeap, N);
         end loop;
         M := SeqAlgebra.NextMember (TheHeap, M);
         ResetColumnCache (TheHeap, Cache);
      end loop;
      C := LocalC;
   end CartesianProduct;

end RelationAlgebra;
