-------------------------------------------------------------------------------
-- (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 Debug;
with ExaminerConstants;

package body Pile is
   ------------------------------------------------------------------------
   -- A "Pile" is basically a list of Cells, each of which has
   -- a Parent, and a Symbol and (possibly) a DAG associated with it.
   -- The Cell fields are used as follows:
   --
   -- A_Ptr - Sibling Node - next Node in this Pile
   -- B_Ptr - Parent Node
   -- C_Ptr - DAG Node, or Null for nodes for which no DAG is associated.
   -- Val   - The Symbol associated with a Node
   ------------------------------------------------------------------------

   procedure Obtain (Heap : in out Cells.Heap_Record;
                     Node :    out Cells.Cell) is
   begin
      Cells.Create_Cell (Heap, Node);
   end Obtain;

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

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

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

   procedure Free (Heap : in out Cells.Heap_Record;
                   Node : in     Cells.Cell) is
   begin
      if not IsNull (Node) then
         Cells.Dispose_Of_Cell (Heap, Node);
      end if;
   end Free;

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

   procedure SetParent (Heap       : in out Cells.Heap_Record;
                        Node       : in     Cells.Cell;
                        ParentNode : in     Cells.Cell) is
   begin
      if not IsNull (Node) then
         Cells.Set_B_Ptr (Heap, Node, ParentNode);
      end if;
   end SetParent;

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

   procedure SetSibling (Heap        : in out Cells.Heap_Record;
                         Node        : in     Cells.Cell;
                         SiblingNode : in     Cells.Cell) is
   begin
      if not IsNull (Node) then
         Cells.Set_A_Ptr (Heap, Node, SiblingNode);
      end if;
   end SetSibling;

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

   procedure SetDAG (Heap    : in out Cells.Heap_Record;
                     Node    : in     Cells.Cell;
                     DAGNode : in     Cells.Cell) is
   begin
      if not IsNull (Node) then
         Cells.Set_C_Ptr (Heap, Node, DAGNode);
      end if;
   end SetDAG;

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

   procedure SetNodeSymbol (Heap   : in out Cells.Heap_Record;
                            Node   : in     Cells.Cell;
                            Symbol : in     Dictionary.Symbol) is
   begin
      if not IsNull (Node) then
         Cells.Set_Symbol_Value (Heap, Node, Symbol);
      end if;
   end SetNodeSymbol;

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

   function Parent (Heap : Cells.Heap_Record;
                    Node : Cells.Cell) return Cells.Cell is
      ParentNode : Cells.Cell;
   begin
      if IsNull (Node) then
         ParentNode := Cells.Null_Cell;
      else
         ParentNode := Cells.Get_B_Ptr (Heap, Node);
      end if;
      return ParentNode;
   end Parent;

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

   function Sibling (Heap : Cells.Heap_Record;
                     Node : Cells.Cell) return Cells.Cell is
      SiblingNode : Cells.Cell;
   begin
      if IsNull (Node) then
         SiblingNode := Cells.Null_Cell;
      else
         SiblingNode := Cells.Get_A_Ptr (Heap, Node);
      end if;
      return SiblingNode;
   end Sibling;

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

   function DAG (Heap : Cells.Heap_Record;
                 Node : Cells.Cell) return Cells.Cell is
      DAGNode : Cells.Cell;
   begin
      if IsNull (Node) then
         DAGNode := Cells.Null_Cell;
      else
         DAGNode := Cells.Get_C_Ptr (Heap, Node);
      end if;
      return DAGNode;
   end DAG;

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

   function NodeSymbol (Heap : Cells.Heap_Record;
                        Node : Cells.Cell) return Dictionary.Symbol is
      Symbol : Dictionary.Symbol;
   begin
      if IsNull (Node) then
         Symbol := Dictionary.NullSymbol;
      else
         Symbol := Cells.Get_Symbol_Value (Heap, Node);
      end if;
      return Symbol;
   end NodeSymbol;

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

   procedure Insert
     (Heap   : in out Cells.Heap_Record;
      Symbol : in     Dictionary.Symbol;
      DAG    : in     Cells.Cell;
      Node   : in out Cells.Cell)
   is
      LastNode, NextNode, NewNode : Cells.Cell;
   begin
      if IsNull (Node) then
         --  Pile~ is empty, so obtain, fill and return a single new node.
         Obtain (Heap, NewNode);
         SetNodeSymbol (Heap, NewNode, Symbol);
         SetDAG (Heap, NewNode, DAG);
         Node := NewNode;
      elsif Dictionary.Declared_Before (Symbol, NodeSymbol (Heap, Node)) then
         --  Pile~ is not empty, and Symbol should be inserted _before_ the
         --  first entry and is not a duplicate, so we need to modify and return Node
         Obtain (Heap, NewNode);
         SetNodeSymbol (Heap, NewNode, Symbol);
         SetDAG (Heap, NewNode, DAG);
         SetSibling (Heap, NewNode, Node);
         Node := NewNode;
      else
         --  Pile~ is not empty, so search for duplicate (in which
         --  case terminate), or correct place to Insert, respecting
         --  Dictionary.Declared_Before order
         NextNode := Node;
         loop
            --  If we find that the Pile already contains Symbol,
            --  then no further action is required.
            exit when Symbol = NodeSymbol (Heap, NextNode);

            LastNode := NextNode;
            NextNode := Sibling (Heap, LastNode);

            --  If the NextNode is Null, then we've reached the end of the Pile
            if IsNull (NextNode) then
               Obtain (Heap, NewNode);
               SetNodeSymbol (Heap, NewNode, Symbol);
               SetDAG (Heap, NewNode, DAG);
               SetSibling (Heap, LastNode, NewNode);
               exit;
            end if;

            --  If Symbol is "between" the Symbols at LastNode and NextNode
            --  then we insert it there, otherwise keep searching
            if Dictionary.Declared_Before (NodeSymbol (Heap, LastNode), Symbol) and
              Dictionary.Declared_Before (Symbol, NodeSymbol (Heap, NextNode)) then

               Obtain (Heap, NewNode);
               SetNodeSymbol (Heap, NewNode, Symbol);
               SetDAG (Heap, NewNode, DAG);
               SetSibling (Heap, LastNode, NewNode);
               SetSibling (Heap, NewNode, NextNode);

               exit;
            end if;

         end loop;
      end if;
   end Insert;

   function Contains
     (Heap   : in Cells.Heap_Record;
      Symbol : in Dictionary.Symbol;
      Node   : in Cells.Cell)
     return   Boolean
   is
      LastNode, NextNode : Cells.Cell;
      Result             : Boolean;
   begin
      Result := True;

      if IsNull (Node) then
         --  Pile~ is empty
         Result := False;
      elsif Dictionary.Declared_Before (Symbol, NodeSymbol (Heap, Node)) then
         --  Pile~ is not empty, and Symbol would be inserted _before_ the
         --  first entry if it was present.
         Result := False;
      else
         --  Pile~ is not empty, so search for duplicate (in which case
         --  terminate).
         NextNode := Node;
         loop
            --  If we find that the Pile already contains Symbol, then no
            --  further action is required.
            exit when Symbol = NodeSymbol (Heap, NextNode);

            LastNode := NextNode;
            NextNode := Sibling (Heap, LastNode);

            --  If the NextNode is Null, then we've reached the end of the Pile
            if IsNull (NextNode) then
               Result := False;
               exit;
            end if;

            --  If Symbol is "between" the Symbols at LastNode and NextNode
            --  then is is not present, otherwise keep searching.
            if Dictionary.Declared_Before (NodeSymbol (Heap, LastNode), Symbol) and
              Dictionary.Declared_Before (Symbol, NodeSymbol (Heap, NextNode)) then
               Result := False;
               exit;
            end if;
         end loop;
      end if;

      return Result;
   end Contains;

   procedure PrintPile (Heap : Cells.Heap_Record;
                        Node : Cells.Cell) is
      --# hide PrintPile;
      CurrentNode : Cells.Cell;
      NextNode    : Cells.Cell;

      procedure PrintCell (Node : Cells.Cell) is
      begin
         if IsNull (Node) then
            Debug.PrintMsg ("<Null Cell>", True);
         else
            Debug.PrintMsg
              ("Node" &
                 Cells.Cell'Image (Node) &
                 ",Sib" &
                 Cells.Cell'Image (Sibling (Heap, Node)) &
                 ",Parent" &
                 Cells.Cell'Image (Parent (Heap, Node)) &
                 ",DAG" &
                 Cells.Cell'Image (DAG (Heap, Node)) &
                 ",Rank" &
                 Cells.Cell_Rank'Image (Cells.Get_Rank (Heap, Node)) &
                 ",Sym" &
                 ExaminerConstants.RefType'Image (Dictionary.SymbolRef (NodeSymbol (Heap, Node))),
               False);
            Debug.Print_Sym (Msg => " ",
                             Sym => NodeSymbol (Heap, Node));
         end if;
      end PrintCell;

   begin
      Debug.PrintMsg ("Printout of Pile beginning at Cell " & Cells.Cell'Image (Node), True);
      CurrentNode := Node;
      if IsNull (CurrentNode) then
         PrintCell (CurrentNode);
      else
         loop
            NextNode := Sibling (Heap, CurrentNode);
            PrintCell (CurrentNode);
            exit when IsNull (NextNode);
            CurrentNode := NextNode;
            NextNode    := Sibling (Heap, CurrentNode);
         end loop;
      end if;
   end PrintPile;

   function OrderOK (Heap : Cells.Heap_Record;
                     Node : Cells.Cell) return Boolean is
      Result      : Boolean;
      CurrentNode : Cells.Cell;
      NextNode    : Cells.Cell;
   begin
      if IsNull (Node) then
         --  A completely empty Pile is alway OK
         Result := True;
      else
         CurrentNode := Node;
         NextNode    := Sibling (Heap, CurrentNode);
         if IsNull (NextNode) then
            --  Pile with exactly ONE node must be OK
            Result := True;
         else
            loop
               Result := Dictionary.Declared_Before (NodeSymbol (Heap, CurrentNode), NodeSymbol (Heap, NextNode));
               exit when not Result;

               CurrentNode := NextNode;
               NextNode    := Sibling (Heap, CurrentNode);
               exit when IsNull (NextNode);
            end loop;
         end if;
      end if;

      return Result;
   end OrderOK;

end Pile;
