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

--------------------------------------------------------------------
--  CheckForMutuallyExclusiveBranches
--
--  Implementation Notes:
--    The details of the algorithm used is described in S.P0468.53.49.
--    The set of ancestor conditional branches and the set of
--    the closest sequences of statements eminating from a conditional
--    branch node are constructed using SeqAlgebra.Seq objects.
--------------------------------------------------------------------

separate (Sem.CompUnit.WalkStatements)
procedure CheckForMutuallyExclusiveBranches
  (Given_Node, Preceding_Node : in     STree.SyntaxNode;
   The_Heap                   : in out Heap.HeapRecord;
   Are_Mutually_Exclusive     :    out Boolean)
is
   Ancestor_Cond_Branches   : SeqAlgebra.Seq;
   Set_Of_Seq_Of_Statements : SeqAlgebra.Seq;
   Branch_Node              : STree.SyntaxNode;
   Cond_Ancestor            : STree.SyntaxNode;
   Common_Ancestor          : STree.SyntaxNode;
   Given_Node_Seq_Stat      : STree.SyntaxNode;
   Preceding_Node_Seq_Stat  : STree.SyntaxNode;
   Iter                     : STree.Iterator;

   function Locate_Child_Of_Type (Node       : STree.SyntaxNode;
                                  Child_Type : SP_Symbols.SP_Symbol) return STree.SyntaxNode
   --# global in STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.if_statement or
   --#   Syntax_Node_Type (Node, STree.Table) = SP_Symbols.case_statement or
   --#   Syntax_Node_Type (Node, STree.Table) = SP_Symbols.else_part or
   --#   Syntax_Node_Type (Node, STree.Table) = SP_Symbols.others_part;
   --# return Return_Node => (Syntax_Node_Type (Return_Node, STree.Table) = Child_Type or
   --#                          Return_Node = STree.NullNode);
   is
      Child : STree.SyntaxNode;
   begin
      Child := Child_Node (Current_Node => Node);
      while Child /= STree.NullNode and then Syntax_Node_Type (Node => Child) /= Child_Type loop
         Child := Next_Sibling (Current_Node => Child);
      end loop;
      return Child;
   end Locate_Child_Of_Type;

   procedure Find_Recursive_Branches
     (Node       : in     STree.SyntaxNode;
      Find_Type  : in     SP_Symbols.SP_Symbol;
      Branch_Set : in     SeqAlgebra.Seq;
      The_Heap   : in out Heap.HeapRecord)
   --# global in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives Statistics.TableUsage,
   --#         The_Heap              from *,
   --#                                    Branch_Set,
   --#                                    Find_Type,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    The_Heap;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.elsif_part or
   --#   Syntax_Node_Type (Node, STree.Table) = SP_Symbols.alternatives;
   is
      Child         : STree.SyntaxNode;
      Next_Instance : STree.SyntaxNode;
      Recurse_Over  : SP_Symbols.SP_Symbol;
      Iter          : STree.Iterator;
   begin
      -- Determine the type of node we are recursing over.
      Recurse_Over := Syntax_Node_Type (Node => Node);

      -- Find all children from the given node and search for a node
      -- of the Find_Type only on children which are not recursive.
      -- For if and case statements a parent has at most 1 recursive
      -- child node.  Only traverse a recursive child node after all
      -- its siblings have been traversed.  The process is then
      -- repeated until a node without a recursive node is encountered.
      -- when all the children of the node have been processed the
      -- loop terminates.
      -- The traversal of the syntax tree is not pre-order but
      -- the order in which the nodes are placed into the Branch_Set
      -- is unimportant.
      Next_Instance := Node;
      while Next_Instance /= STree.NullNode loop
         Child         := Child_Node (Current_Node => Next_Instance);
         Next_Instance := STree.NullNode;
         while Child /= STree.NullNode loop
            if Syntax_Node_Type (Node => Child) = Recurse_Over then
               -- There is at most one instance of a recursive child node.
               Next_Instance := Child;
            else
               Iter := Find_First_Node (Node_Kind    => Find_Type,
                                        From_Root    => Child,
                                        In_Direction => STree.Down);
               if not STree.IsNull (Iter) then
                  -- Only add the set of branches if a
                  -- node of the Find_Type is present.
                  SeqAlgebra.AddMember (The_Heap, Branch_Set, Natural (STree.NodeToRef (Get_Node (It => Iter))));
               end if;
            end if;
            Child := Next_Sibling (Current_Node => Child);
         end loop;
      end loop;
   end Find_Recursive_Branches;

   procedure Find_If_Branches (If_Node    : in     STree.SyntaxNode;
                               Branch_Set : in     SeqAlgebra.Seq;
                               The_Heap   : in out Heap.HeapRecord)
   --# global in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives Statistics.TableUsage,
   --#         The_Heap              from *,
   --#                                    Branch_Set,
   --#                                    If_Node,
   --#                                    STree.Table,
   --#                                    The_Heap;
   --# pre Syntax_Node_Type (If_Node, STree.Table) = SP_Symbols.if_statement;
   is
      Current_Child : STree.SyntaxNode;
   begin
      -- Process "then" part.
      Current_Child := Locate_Child_Of_Type (Node       => If_Node,
                                             Child_Type => SP_Symbols.sequence_of_statements);
      -- ASSUME Current_Child = sequence_of_statements OR NULL
      if Syntax_Node_Type (Node => Current_Child) = SP_Symbols.sequence_of_statements then
         -- ASSUME Current_Child = sequence_of_statements
         -- there should always be a then part otherwise the
         -- syntax tree is invalid, but no error is raised here
         -- as it will be reported elsewhere by the Examiner.
         SeqAlgebra.AddMember (The_Heap, Branch_Set, Natural (STree.NodeToRef (Current_Child)));
      end if;

      -- Process the "else" part if one exists
      Current_Child := Locate_Child_Of_Type (Node       => If_Node,
                                             Child_Type => SP_Symbols.else_part);
      -- ASSUME Current_Child = else_part OR NULL
      if Syntax_Node_Type (Node => Current_Child) = SP_Symbols.else_part then
         -- ASSUME Current_Child = else_part
         Current_Child := Locate_Child_Of_Type (Node       => Current_Child,
                                                Child_Type => SP_Symbols.sequence_of_statements);
         -- ASSUME Current_Child = sequence_of_statements OR NULL
         if Syntax_Node_Type (Node => Current_Child) = SP_Symbols.sequence_of_statements then
            -- ASSUME Current_Child = sequence_of_statements
            -- Only add the branch if the else sequence of statements exist.
            SeqAlgebra.AddMember (The_Heap, Branch_Set, Natural (STree.NodeToRef (Current_Child)));
         end if;
      end if;

      -- Process the elsif part if one exists.
      Current_Child := Locate_Child_Of_Type (Node       => If_Node,
                                             Child_Type => SP_Symbols.elsif_part);
      -- ASSUME Current_Child = elsif_part OR NULL
      if Syntax_Node_Type (Node => Current_Child) = SP_Symbols.elsif_part then
         -- ASSUME Current_Child = elsif_part
         Find_Recursive_Branches
           (Node       => Current_Child,
            Find_Type  => SP_Symbols.sequence_of_statements,
            Branch_Set => Branch_Set,
            The_Heap   => The_Heap);
      end if;
   end Find_If_Branches;

   procedure Find_Case_Branches
     (Case_Node  : in     STree.SyntaxNode;
      Branch_Set : in     SeqAlgebra.Seq;
      The_Heap   : in out Heap.HeapRecord)
   --# global in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives Statistics.TableUsage,
   --#         The_Heap              from *,
   --#                                    Branch_Set,
   --#                                    Case_Node,
   --#                                    STree.Table,
   --#                                    The_Heap;
   --# pre Syntax_Node_Type (Case_Node, STree.Table) = SP_Symbols.case_statement;
   is
      Current_Child : STree.SyntaxNode;
   begin
      -- Process "others" part if it exists.
      Current_Child := Locate_Child_Of_Type (Node       => Case_Node,
                                             Child_Type => SP_Symbols.others_part);
      -- ASSUME Current_Child = others_part OR NULL
      if Syntax_Node_Type (Node => Current_Child) = SP_Symbols.others_part then
         -- ASSUME Current_Child = others_part
         Current_Child := Locate_Child_Of_Type (Node       => Current_Child,
                                                Child_Type => SP_Symbols.sequence_of_statements);
         -- ASSUME Current_Child = sequence_of_statements OR NULL
         if Syntax_Node_Type (Node => Current_Child) = SP_Symbols.sequence_of_statements then
            -- ASSUME Current_Child = sequence_of_statements
            SeqAlgebra.AddMember (The_Heap, Branch_Set, Natural (STree.NodeToRef (Current_Child)));
         end if;
      end if;

      -- Process the alternatives part if one exists.
      Current_Child := Locate_Child_Of_Type (Node       => Case_Node,
                                             Child_Type => SP_Symbols.alternatives);
      -- ASSUME Current_Child = alternatives OR NULL
      if Syntax_Node_Type (Node => Current_Child) = SP_Symbols.alternatives then
         -- ASSUME Current_Child = alternatives
         Find_Recursive_Branches
           (Node       => Current_Child,
            Find_Type  => SP_Symbols.sequence_of_statements,
            Branch_Set => Branch_Set,
            The_Heap   => The_Heap);
      end if;
   end Find_Case_Branches;

   function Find_Conntaining_Sequence_Of_Statements
     (Node                     : STree.SyntaxNode;
      Set_Of_Seq_Of_Statements : SeqAlgebra.Seq;
      The_Heap                 : Heap.HeapRecord)
     return                     STree.SyntaxNode
   --# global in STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.assignment_statement or
   --#   Syntax_Node_Type (Node, STree.Table) = SP_Symbols.procedure_call_statement;
   --# return Return_Node => (Syntax_Node_Type (Return_Node, STree.Table) = SP_Symbols.sequence_of_statements or
   --#                          Return_Node = STree.NullNode);
   is
      Iter                : STree.Iterator;
      Seq_Statements_Node : STree.SyntaxNode;
   begin
      Iter := Find_First_Node (Node_Kind    => SP_Symbols.sequence_of_statements,
                               From_Root    => Node,
                               In_Direction => STree.Up);
      if STree.IsNull (Iter) then
         Seq_Statements_Node := STree.NullNode;
      else
         Seq_Statements_Node := Get_Node (It => Iter);
      end if;
      while not (STree.IsNull (Iter)
                   or else SeqAlgebra.IsMember (The_Heap, Set_Of_Seq_Of_Statements, Natural (STree.NodeToRef (Seq_Statements_Node))))
      loop
         --# assert Syntax_Node_Type (Seq_Statements_Node, STree.Table) = SP_Symbols.sequence_of_statements and
         --#   Seq_Statements_Node = Get_Node (Iter);
         Iter := STree.NextNode (Iter);
         if STree.IsNull (Iter) then
            Seq_Statements_Node := STree.NullNode;
         else
            Seq_Statements_Node := Get_Node (It => Iter);
         end if;
      end loop;
      return Seq_Statements_Node;
   end Find_Conntaining_Sequence_Of_Statements;

begin
   SeqAlgebra.CreateSeq (The_Heap, Ancestor_Cond_Branches);
   SeqAlgebra.CreateSeq (The_Heap, Set_Of_Seq_Of_Statements);
   Iter := Find_First_Branch_Node (From_Root    => Preceding_Node,
                                   In_Direction => STree.Up);

   -- Determine the set of Ancestor If and Case branch nodes
   -- of the Preceding Node.
   while not STree.IsNull (Iter) loop
      Branch_Node := Get_Node (It => Iter);
      case Syntax_Node_Type (Node => Branch_Node) is
         -- Only if and case statement branches create
         -- mutually exclusive sequences of statements
         when SP_Symbols.if_statement | SP_Symbols.case_statement =>
            -- ASSUME Branch_Node = if_statement OR case_statement
            SeqAlgebra.AddMember (The_Heap, Ancestor_Cond_Branches, Natural (STree.NodeToRef (Branch_Node)));
         when others =>
            null;
      end case;
      Iter := STree.NextNode (Iter);
   end loop;

   if SeqAlgebra.IsEmptySeq (The_Heap, Ancestor_Cond_Branches) then
      -- The Preceding_Node has no if or case branches and therefore
      -- cannot be on a mutually exclusive branch to the Given_Node
      Are_Mutually_Exclusive := False;
   else
      -- Find the closest if or case branch common to the
      -- Preceding_Node and the Given_Node.
      -- As we traverse up the tree from the Given_Node this will
      -- ensure that the closest common conditional branch node
      -- is located.
      Iter            := Find_First_Branch_Node (From_Root    => Given_Node,
                                                 In_Direction => STree.Up);
      Common_Ancestor := STree.NullNode;

      while not STree.IsNull (Iter) and then Common_Ancestor = STree.NullNode loop
         -- The Ancestor_Cond_Branches set only contains conditional
         -- branch nodes. No need to check again here for type of branch.
         Cond_Ancestor := Get_Node (It => Iter);
         if SeqAlgebra.IsMember (The_Heap, Ancestor_Cond_Branches, Natural (STree.NodeToRef (Cond_Ancestor))) then
            Common_Ancestor := Cond_Ancestor;
         else
            Iter := STree.NextNode (Iter);
         end if;
      end loop;
      -- ASSUME Common_Ancestor = if_statement OR case_statement OR NULL
      if Common_Ancestor = STree.NullNode then
         -- ASSUME Common_Ancestor = NULL

         -- The Given_Node and the Preceding_Node have no conditional
         -- branches in common and therefore are not mutually exclusive.
         Are_Mutually_Exclusive := False;
      else
         -- ASSUME Common_Ancestor = if_statement OR case_statement

         -- Determine the set of mutually exclusive branches from the
         -- closest common if or case statement ancestor.
         -- Both the Given_Node and the Preceding_Node will be contained
         -- within a sequence of statements.  Only the branches which
         -- contain sequences of statements are considered and the
         -- nodes representing the sequence of statements form the set.

         if Syntax_Node_Type (Node => Common_Ancestor) = SP_Symbols.if_statement then
            -- ASSUME Common_Ancestor = if_statement
            Find_If_Branches (If_Node    => Common_Ancestor,
                              Branch_Set => Set_Of_Seq_Of_Statements,
                              The_Heap   => The_Heap);
         elsif Syntax_Node_Type (Node => Common_Ancestor) = SP_Symbols.case_statement then
            -- ASSUME Common_Ancestor = case_statement
            Find_Case_Branches (Case_Node  => Common_Ancestor,
                                Branch_Set => Set_Of_Seq_Of_Statements,
                                The_Heap   => The_Heap);
         else
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Common_Ancestor = if_statement OR case_statement OR " &
                 "NULL in CheckForMutuallyExclusiveBranches");
         end if;

         -- Find the sequence of statements which contains the Given_Node.
         -- Such a node must exist.
         Given_Node_Seq_Stat :=
           Find_Conntaining_Sequence_Of_Statements
           (Node                     => Given_Node,
            Set_Of_Seq_Of_Statements => Set_Of_Seq_Of_Statements,
            The_Heap                 => The_Heap);

         -- Find the sequence of statements which contains the Preceding_Node.
         -- Such a node must exist.
         Preceding_Node_Seq_Stat :=
           Find_Conntaining_Sequence_Of_Statements
           (Node                     => Preceding_Node,
            Set_Of_Seq_Of_Statements => Set_Of_Seq_Of_Statements,
            The_Heap                 => The_Heap);

         Are_Mutually_Exclusive := Given_Node_Seq_Stat /= Preceding_Node_Seq_Stat;
      end if;
   end if;

   SeqAlgebra.DisposeOfSeq (The_Heap, Ancestor_Cond_Branches);
   SeqAlgebra.DisposeOfSeq (The_Heap, Set_Of_Seq_Of_Statements);
end CheckForMutuallyExclusiveBranches;
