-------------------------------------------------------------------------------
-- (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 CommandLineData;
with ErrorHandler;
with ExaminerConstants;
with RelationAlgebra;
with SeqAlgebra;
with SP_Symbols;
with SystemErrors;

use type CommandLineData.Flow_Analysis_Options;
use type SP_Symbols.SP_Symbol;

package body FlowAnalyser is

   ------------------------------------------------------------------------
   -- IFA_Stack implements a Stack ADT holding the state of the
   -- information flow analyser as it traverses the syntax tree representing
   -- the body of a program unit (procedure, function or task body).
   --
   -- It is used in FlowAnalyser.FlowAnalyse where the tree-traveral
   -- algorithm is implemented.
   ------------------------------------------------------------------------

   --# inherit ExaminerConstants,
   --#         Heap,
   --#         RelationAlgebra,
   --#         SeqAlgebra,
   --#         Statistics,
   --#         SystemErrors;
   package IFA_Stack is

      type MemberType is (
                          Action, -- Null, Assignment, or Procedure Call statement
                          IfNode,
                          ElsifNode,
                          CaseNode,
                          LoopHead,
                          ExitNode,
                          ExitBranch,
                          DefaultExitNode);

      type StackMember is record
         MemberKind                                        : MemberType;
         DefinedVars, UnPreservedVars, AllVars, SeqOfExpns : SeqAlgebra.Seq;
         Lambda, Mu, Rho, Theta, ThetaTilde, RhoProd       : RelationAlgebra.Relation;
      end record;

      type Stack is private;

      -- constant used only in fatal error cases so that we can eliminate DF errors
      -- on paths that call SystemErrors.FatalError
      NullMember : constant StackMember :=
        StackMember'
        (Action,
         SeqAlgebra.Null_Seq,
         SeqAlgebra.Null_Seq,
         SeqAlgebra.Null_Seq,
         SeqAlgebra.Null_Seq,
         RelationAlgebra.Null_Relation,
         RelationAlgebra.Null_Relation,
         RelationAlgebra.Null_Relation,
         RelationAlgebra.Null_Relation,
         RelationAlgebra.Null_Relation,
         RelationAlgebra.Null_Relation);

      ----------------------------------------
      -- Basic accessor functions for a Stack
      ----------------------------------------

      function IsEmpty (S : Stack) return Boolean;

      function Top (S : Stack) return StackMember;

      ----------------------------------------
      -- Constructor, Push and Pop
      ----------------------------------------

      procedure ClearStack (S : out Stack);
      --# derives S from ;

      procedure Push (S : in out Stack;
                      M : in     StackMember);
      --# derives S from *,
      --#                M;

      procedure Pop (S : in out Stack;
                     M :    out StackMember);
      --# derives M,
      --#         S from S;

      ----------------------------------------
      -- Constructor for a single StackMember
      ----------------------------------------

      procedure EstablishMember (TheHeap : in out Heap.HeapRecord;
                                 Kind    : in     MemberType;
                                 M       :    out StackMember);
      --# global in out Statistics.TableUsage;
      --# derives M                     from Kind,
      --#                                    TheHeap &
      --#         Statistics.TableUsage,
      --#         TheHeap               from *,
      --#                                    TheHeap;
      --# post M.MemberKind = Kind;
      -- and other fields denote new, empty sequences and relations

      ---------------------------------------------
      -- DisposeOfMember does a "Dispose" operation
      -- on all sequences and relations in M,
      -- using the operations supplied by
      -- SeqAlgebra and RelationAlgebra
      ---------------------------------------------
      procedure DisposeOfMember (TheHeap : in out Heap.HeapRecord;
                                 M       : in     StackMember);
      --# derives TheHeap from *,
      --#                      M;

   private

      -- Implementation is bounded to
      -- ExaminerConstants.StackManagerStackSize elements on the stack

      subtype PointerRange is Integer range 0 .. ExaminerConstants.StackManagerStackSize;

      subtype IndexRange is PointerRange range 1 .. PointerRange'Last;

      type Vector is array (IndexRange) of StackMember;

      type Stack is record
         StackVector  : Vector;
         StackPointer : PointerRange;
      end record;

   end IFA_Stack;

   -- This function renaming cannot be replaced by a use type clause at present
   -- because it refers to the embedded package above and applies to the
   -- subprogram below so it has to appear between the two. SPARK does not
   -- currently permit a use type clause in this location.
   function "=" (Left, Right : in IFA_Stack.MemberType) return Boolean renames IFA_Stack."=";

   package body IFA_Stack is separate;

   procedure FlowAnalyse
     (SubprogSym         : in     Dictionary.Symbol;
      StartNode          : in     STree.SyntaxNode;
      EndPosition        : in     LexTokenManager.Token_Position;
      ComponentData      : in out ComponentManager.ComponentData;
      TheHeap            : in out Heap.HeapRecord;
      Table              : in     RefList.HashTable;
      DataFlowErrorFound :    out Boolean)
      is separate;

   procedure FlowAnalysePartition (Node    : in     STree.SyntaxNode;
                                   TheHeap : in out Heap.HeapRecord) is separate;

end FlowAnalyser;
