-------------------------------------------------------------------------------
-- (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 Clists, Structures;

package body Labels is

   function LabelHead (L : Label) return Cells.Cell is
   begin
      return Cells.Cell (L);
   end LabelHead;

   ---------------------------------------------------------------------

   function FirstPair (Heap : Cells.Heap_Record;
                       L    : Label) return Pairs.Pair is
   begin
      return Pairs.CellToPair (Clists.FirstCell (Heap, Cells.Cell (L)));
   end FirstPair;

   ---------------------------------------------------------------------

   function NextPair (Heap : Cells.Heap_Record;
                      P    : Pairs.Pair) return Pairs.Pair is
   begin
      return Pairs.CellToPair (Clists.NextCell (Heap, Pairs.PairHead (P)));
   end NextPair;

   ---------------------------------------------------------------------

   function LastPair (Heap : Cells.Heap_Record;
                      L    : Label) return Pairs.Pair is
   begin
      return Pairs.CellToPair (Clists.LastCell (Heap, Cells.Cell (L)));
   end LastPair;
   pragma Unreferenced (LastPair); -- Unused at present

   ---------------------------------------------------------------------

   function IsNull (L : Label) return Boolean is
   begin
      return Cells.Is_Null_Cell (Cells.Cell (L));
   end IsNull;

   ---------------------------------------------------------------------

   function CellToLabel (C : Cells.Cell) return Label is
   begin
      return Label (C);
   end CellToLabel;

   ---------------------------------------------------------------------

   procedure AppendPair (Heap      : in out Cells.Heap_Record;
                         NewPair   : in     Pairs.Pair;
                         LabelName : in     Label) is
   begin
      Clists.AppendCell (Heap, Pairs.PairHead (NewPair), Cells.Cell (LabelName));
   end AppendPair;

   ---------------------------------------------------------------------

   procedure CreateLabel (Heap     : in out Cells.Heap_Record;
                          NewLabel :    out Label) is
      CellName : Cells.Cell;
   begin
      Cells.Create_Cell (Heap, CellName);
      NewLabel := Label (CellName);
   end CreateLabel;

   ---------------------------------------------------------------------

   procedure CopyLabel (Heap     : in out Cells.Heap_Record;
                        Original : in     Label;
                        Copy     :    out Label) is
      CopyName : Cells.Cell;
   begin
      Structures.CopyStructure (Heap, Cells.Cell (Original), CopyName);
      Copy := Label (CopyName);
   end CopyLabel;

   ---------------------------------------------------------------------

   procedure AddLabels (Heap    : in out Cells.Heap_Record;
                        Label_1 : in     Label;
                        Label_2 : in     Label) is
   begin
      Clists.Concatenate (Heap, Cells.Cell (Label_1), Cells.Cell (Label_2));
   end AddLabels;

   ---------------------------------------------------------------------

   procedure MultiplyLabels
     (Heap    : in out Cells.Heap_Record;
      Label_1 : in     Label;
      Label_2 : in     Label;
      Product :    out Label)
   is
      NextPair_1, NextPair_2, PairProduct, Pair_1, Pair_2, Pair_2Copy : Pairs.Pair;
      Label_1Copy, NewLabel                                           : Label;
   begin
      CreateLabel (Heap, NewLabel);
      Pair_2 := FirstPair (Heap, Label_2);
      Cells.Dispose_Of_Cell (Heap, LabelHead (Label_2));
      loop
         exit when Pairs.IsNullPair (Pair_2);
         NextPair_2 := NextPair (Heap, Pair_2);
         if Pairs.IsNullPair (NextPair_2) then
            Label_1Copy := Label_1;
         else
            CopyLabel (Heap, Label_1, Label_1Copy);
         end if;
         Pair_1 := FirstPair (Heap, Label_1Copy);
         Cells.Dispose_Of_Cell (Heap, LabelHead (Label_1Copy));
         loop
            exit when Pairs.IsNullPair (Pair_1);
            NextPair_1 := NextPair (Heap, Pair_1);
            if Pairs.IsNullPair (NextPair_1) then
               Pair_2Copy := Pair_2;
            else
               Pairs.CopyPair (Heap, Pair_2, Pair_2Copy);
            end if;
            Pairs.MultiplyPairs (Heap, Pair_1, Pair_2Copy, PairProduct);
            AppendPair (Heap, PairProduct, NewLabel);
            Pair_1 := NextPair_1;
         end loop;
         Pair_2 := NextPair_2;
      end loop;
      Product := NewLabel;
   end MultiplyLabels;

end Labels;
