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

separate (Declarations.OutputDeclarations)
procedure GenerateDeclarations
  (Heap          : in out Cells.Heap_Record;
   UsedSymbols   : in     Cells.Cell;
   Scope         : in     Dictionary.Scopes;
   NeededSymbols :    out Cells.Cell)
is

   TheCurrentNode : Cells.Cell;
   TheNextNode    : Cells.Cell;
   ParentNode     : Cells.Cell;
   PrevNode       : Cells.Cell;
   SuccessorNodes : Cells.Cell;
   DeclareList    : Cells.Cell;

   procedure GenerateSuccessors
     (Heap          : in out Cells.Heap_Record;
      Symbol        : in     Dictionary.Symbol;
      Scope         : in     Dictionary.Scopes;
      SuccessorList :    out Cells.Cell)
   --# global in     AttributeList;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in out Statistics.TableUsage;
   --# derives Heap,
   --#         Statistics.TableUsage from *,
   --#                                    AttributeList,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    LexTokenManager.State,
   --#                                    Scope,
   --#                                    Symbol &
   --#         SuccessorList         from AttributeList,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    LexTokenManager.State,
   --#                                    Scope,
   --#                                    Symbol;
      is separate;

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

   function InList (Symbol      : Dictionary.Symbol;
                    DeclareList : Cells.Cell) return Boolean
   --# global in Heap;
   is
      ThisNode : Cells.Cell;
      Found    : Boolean;
   begin
      ThisNode := DeclareList;
      loop
         if Pile.IsNull (ThisNode) then
            Found := False;
            exit;
         end if;
         if Symbol = Pile.NodeSymbol (Heap, ThisNode) then
            Found := True;
            exit;
         end if;
         ThisNode := Pile.Sibling (Heap, ThisNode);
      end loop;
      return Found;
   end InList;

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

   procedure SelectNode (FromList    : in out Cells.Cell;
                         DeclareList : in     Cells.Cell)
   --# global in out Heap;
   --# derives FromList,
   --#         Heap     from DeclareList,
   --#                       FromList,
   --#                       Heap;
   is
      OldNode : Cells.Cell;
   begin
      loop
         exit when Pile.IsNull (FromList);
         exit when not InList (Pile.NodeSymbol (Heap, FromList), DeclareList);
         OldNode  := FromList;
         FromList := Pile.Sibling (Heap, OldNode);
         Pile.Free (Heap, OldNode);
      end loop;
   end SelectNode;

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

   procedure AddDeclarationInOrder (Sym         : in     Dictionary.Symbol;
                                    DAG         : in     Cells.Cell;
                                    DeclareList : in out Cells.Cell)
   --# global in out Heap;
   --#        in out Statistics.TableUsage;
   --# derives DeclareList,
   --#         Statistics.TableUsage from *,
   --#                                    DeclareList,
   --#                                    Heap,
   --#                                    Sym &
   --#         Heap                  from *,
   --#                                    DAG,
   --#                                    DeclareList,
   --#                                    Sym;
   is
   begin
      Pile.Insert (Heap, Sym, DAG, DeclareList);
   end AddDeclarationInOrder;

begin -- GenerateDeclarations;
   TheCurrentNode := UsedSymbols;
   DeclareList    := Cells.Null_Cell;
   loop
      exit when Pile.IsNull (TheCurrentNode);

      -- Generate the _immediate_ successors of the Symbol at TheCurrentNote
      GenerateSuccessors (Heap, Pile.NodeSymbol (Heap, TheCurrentNode), Scope, SuccessorNodes);

      AddDeclarationInOrder (Pile.NodeSymbol (Heap, TheCurrentNode), Pile.DAG (Heap, TheCurrentNode), DeclareList);

      if not Pile.OrderOK (Heap, DeclareList) then
         Debug.PrintMsg ("DeclareList order BROKEN", True);
         Debug.PrintMsg ("--------DeclareList after AddDeclarationInOrder--------", True);
         Pile.PrintPile (Heap, DeclareList);
         Debug.PrintMsg ("-------------------------------------------------------", True);
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Assertion_Failure,
            Msg     => "DeclareList not in order after AddDeclarationInOrder");
      end if;

      --  Now for the transitive closure of those first level successors,
      --  freeing duplicate nodes as we go along.
      SelectNode (SuccessorNodes, DeclareList);
      TheNextNode := SuccessorNodes;
      if Pile.IsNull (TheNextNode) then
         loop
            PrevNode       := TheCurrentNode;
            TheCurrentNode := Pile.Sibling (Heap, PrevNode);
            ParentNode     := Pile.Parent (Heap, PrevNode);
            Pile.Free (Heap, PrevNode);
            SelectNode (TheCurrentNode, DeclareList);
            if not Pile.IsNull (TheCurrentNode) then
               Pile.SetParent (Heap, TheCurrentNode, ParentNode);
               exit;
            end if;
            TheCurrentNode := ParentNode;
            exit when Pile.IsNull (TheCurrentNode);
         end loop;
      else
         Pile.SetParent (Heap, TheNextNode, TheCurrentNode);
         TheCurrentNode := TheNextNode;
      end if;
   end loop;

   NeededSymbols := DeclareList;
end GenerateDeclarations;
