-------------------------------------------------------------------------------
-- (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 (FlowAnalyser.FlowAnalyse.AnalyseRelations)
procedure MergeAndHandleErrors is
   RootNode : ComponentManager.Component;

   procedure ProcessRoot (RootNode : in ComponentManager.Component)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     Scope;
   --#        in     TheErrorHeap;
   --#        in out ComponentData;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out TheHeap;
   --# derives ComponentData,
   --#         Statistics.TableUsage,
   --#         TheHeap                    from *,
   --#                                         ComponentData,
   --#                                         RootNode,
   --#                                         TheErrorHeap,
   --#                                         TheHeap &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         ComponentData,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         RootNode,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         TheErrorHeap,
   --#                                         TheHeap;
   is
      CurrentNode, LastNode      : ComponentManager.Component;
      ErrList                    : SeqAlgebra.Seq;
      CurrentMember              : SeqAlgebra.MemberOfSeq;
      ListOfErrorsToPassToParent : SeqAlgebra.Seq;
      MemberOfList               : SeqAlgebra.MemberOfSeq;

      type ErrorSelections is (AllEntries, Table1);

      procedure AddPreviousNodesToError (PrevError, CurrError : in ComponentErrors.ComponentError)
      --# global in     TheErrorHeap;
      --#        in out Statistics.TableUsage;
      --#        in out TheHeap;
      --# derives Statistics.TableUsage,
      --#         TheHeap               from *,
      --#                                    CurrError,
      --#                                    PrevError,
      --#                                    TheErrorHeap,
      --#                                    TheHeap;
      is
         PrevNodeSeq, CurrNodeSeq : SeqAlgebra.Seq;
      begin
         CurrNodeSeq := ComponentErrors.AssociatedComponentNodesOfError (TheErrorHeap, CurrError);
         PrevNodeSeq := ComponentErrors.AssociatedComponentNodesOfError (TheErrorHeap, PrevError);
         SeqAlgebra.AugmentSeq (TheHeap, CurrNodeSeq,
                                --with
                                PrevNodeSeq);
         while not SeqAlgebra.IsEmptySeq (TheHeap, PrevNodeSeq) loop
            SeqAlgebra.EliminateAfter (TheHeap, SeqAlgebra.BeforeFirstMember (PrevNodeSeq));
         end loop;
      end AddPreviousNodesToError;

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

      procedure ReplaceNodesOfError (Node  : in ComponentManager.Component;
                                     Error : in ComponentErrors.ComponentError)
      --# global in     TheErrorHeap;
      --#        in out Statistics.TableUsage;
      --#        in out TheHeap;
      --# derives Statistics.TableUsage,
      --#         TheHeap               from *,
      --#                                    Error,
      --#                                    Node,
      --#                                    TheErrorHeap,
      --#                                    TheHeap;
      is
         NodeSeq : SeqAlgebra.Seq;
      begin
         NodeSeq := ComponentErrors.AssociatedComponentNodesOfError (TheErrorHeap, Error);
         while not SeqAlgebra.IsEmptySeq (TheHeap, NodeSeq) loop
            SeqAlgebra.EliminateAfter (TheHeap, SeqAlgebra.BeforeFirstMember (NodeSeq));
         end loop;
         SeqAlgebra.AddMember (TheHeap, NodeSeq, ComponentManager.ComponentToRef (Node));
      end ReplaceNodesOfError;

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

      procedure PassToErrorHandler (Error : in ComponentErrors.ComponentError;
                                    Sel   : in ErrorSelections)
      --# global in     CommandLineData.Content;
      --#        in     ComponentData;
      --#        in     Dictionary.Dict;
      --#        in     LexTokenManager.State;
      --#        in     Scope;
      --#        in     TheErrorHeap;
      --#        in out ErrorHandler.Error_Context;
      --#        in out SPARK_IO.File_Sys;
      --#        in out TheHeap;
      --# derives ErrorHandler.Error_Context,
      --#         SPARK_IO.File_Sys          from CommandLineData.Content,
      --#                                         ComponentData,
      --#                                         Dictionary.Dict,
      --#                                         Error,
      --#                                         ErrorHandler.Error_Context,
      --#                                         LexTokenManager.State,
      --#                                         Scope,
      --#                                         Sel,
      --#                                         SPARK_IO.File_Sys,
      --#                                         TheErrorHeap,
      --#                                         TheHeap &
      --#         TheHeap                    from *,
      --#                                         Error,
      --#                                         TheErrorHeap;
      is
         ErrClass   : ComponentErrors.ErrorClass;
         ErrVal     : Natural;
         ErrPosn    : LexTokenManager.Token_Position;
         NameOfNode : Dictionary.Symbol;
         NodeSeq    : SeqAlgebra.Seq;

      begin --PassToErrorHandler
         ErrClass := ComponentErrors.ClassOfError (TheErrorHeap, Error);
         ErrVal   := ComponentErrors.ValueOfError (TheErrorHeap, Error);
         ErrPosn  := ComponentErrors.PositionOfError (TheErrorHeap, Error);
         NodeSeq  := ComponentErrors.AssociatedComponentNodesOfError (TheErrorHeap, Error);
         while not SeqAlgebra.IsEmptySeq (TheHeap, NodeSeq) loop
            NameOfNode :=
              ComponentManager.GetName
              (ComponentData,
               ComponentManager.RefToComponent
                 (SeqAlgebra.Value_Of_Member (The_Heap => TheHeap,
                                              M        => SeqAlgebra.FirstMember (TheHeap, NodeSeq))));
            SeqAlgebra.EliminateAfter (TheHeap, SeqAlgebra.BeforeFirstMember (NodeSeq));

            --# accept Flow, 41, "Expected stable expression";
            case ErrClass is
               when ComponentErrors.DataFlow =>
                  --# end accept;
                  ErrorHandler.Data_Flow_Error
                    (Err_Type => ErrorHandler.Data_Flow_Err_Type'Val (ErrVal),
                     Position => ErrPosn,
                     Var_Sym  => NameOfNode,
                     Scope    => Scope);

               when ComponentErrors.IneffectiveStmt =>
                  --# accept Flow, 41, "Expected stable expression";
                  if Sel = Table1 then
                     --# end accept;
                     null;
                  else
                     ErrorHandler.Ineffective_Stmt (Position => ErrPosn,
                                                    Var_Sym  => NameOfNode,
                                                    Scope    => Scope);
                  end if;

               when ComponentErrors.IneffectiveFieldAssignment =>
                  ErrorHandler.Ineffective_Stmt (Position => ErrPosn,
                                                 Var_Sym  => NameOfNode,
                                                 Scope    => Scope);

               when ComponentErrors.Dependency =>
                  --# accept Flow, 41, "Expected stable expression";
                  if Sel = Table1 and then (ErrVal = ErrorHandler.Dependency_Err_Type'Pos (ErrorHandler.Ineff_Local_Init)) then
                     --# end accept;
                     null;
                  else
                     ErrorHandler.Dependency_Error
                       (Err_Type       => ErrorHandler.Dependency_Err_Type'Val (ErrVal),
                        Position       => ErrPosn,
                        Import_Var_Sym => NameOfNode,
                        Export_Var_Sym => ComponentErrors.SymOfError (TheErrorHeap, Error),
                        Scope          => Scope);
                  end if;

               when ComponentErrors.Usage =>
                  --# accept Flow, 41, "Expected stable expression";
                  if Sel = Table1
                    and then (ErrVal = ErrorHandler.Usage_Err_Type'Pos (ErrorHandler.Unused_Import) or
                                ErrVal = ErrorHandler.Usage_Err_Type'Pos (ErrorHandler.Unreferenced_Var) or
                                ErrVal = ErrorHandler.Usage_Err_Type'Pos (ErrorHandler.Ineffective_Import)) then
                     --# end accept;
                     null;
                  else
                     ErrorHandler.Usage_Error
                       (Err_Type => ErrorHandler.Usage_Err_Type'Val (ErrVal),
                        Position => ErrPosn,
                        Var_Sym  => NameOfNode,
                        Scope    => Scope);
                  end if;

               when ComponentErrors.SemanticWarning =>
                  --# accept Flow, 41, "Expected stable expression";
                  if Sel = AllEntries then
                     --# end accept;
                     ErrorHandler.Semantic_Warning
                       (Err_Num  => ErrVal,
                        Position => ErrPosn,
                        Id_Str   => Dictionary.GetSimpleName (NameOfNode));
                  end if;
            end case;
         end loop;
      end PassToErrorHandler;

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

      procedure CompoundErrors (CurrentNode, PreviousNode : in ComponentManager.Component)
      --# global in     CommandLineData.Content;
      --#        in     ComponentData;
      --#        in     Dictionary.Dict;
      --#        in     LexTokenManager.State;
      --#        in     Scope;
      --#        in     TheErrorHeap;
      --#        in out ErrorHandler.Error_Context;
      --#        in out SPARK_IO.File_Sys;
      --#        in out Statistics.TableUsage;
      --#        in out TheHeap;
      --# derives ErrorHandler.Error_Context,
      --#         SPARK_IO.File_Sys          from CommandLineData.Content,
      --#                                         ComponentData,
      --#                                         CurrentNode,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         LexTokenManager.State,
      --#                                         PreviousNode,
      --#                                         Scope,
      --#                                         SPARK_IO.File_Sys,
      --#                                         TheErrorHeap,
      --#                                         TheHeap &
      --#         Statistics.TableUsage,
      --#         TheHeap                    from *,
      --#                                         ComponentData,
      --#                                         CurrentNode,
      --#                                         PreviousNode,
      --#                                         TheErrorHeap,
      --#                                         TheHeap;
      is
         CurrErrList, PrevErrList                         : SeqAlgebra.Seq;
         CurrIndex, LagCurrIndex, PrevIndex, LagPrevIndex : SeqAlgebra.MemberOfSeq;
         CurrErr, PrevErr                                 : Natural;
         IsACommonError                                   : Boolean;
      begin -- CompoundErrors
         CurrErrList := ComponentManager.GetListOfErrors (ComponentData, CurrentNode);
         PrevErrList := ComponentManager.GetListOfErrors (ComponentData, PreviousNode);

         LagCurrIndex := SeqAlgebra.BeforeFirstMember (CurrErrList);
         CurrIndex    := SeqAlgebra.FirstMember (TheHeap, CurrErrList);
         loop
            exit when SeqAlgebra.IsNullMember (CurrIndex);

            CurrErr        := SeqAlgebra.Value_Of_Member (The_Heap => TheHeap,
                                                          M        => CurrIndex);
            LagPrevIndex   := SeqAlgebra.BeforeFirstMember (PrevErrList);
            PrevIndex      := SeqAlgebra.FirstMember (TheHeap, PrevErrList);
            IsACommonError := False; --addition to aak algorithm
            loop
               exit when SeqAlgebra.IsNullMember (PrevIndex);

               PrevErr        := SeqAlgebra.Value_Of_Member (The_Heap => TheHeap,
                                                             M        => PrevIndex);
               IsACommonError := ComponentErrors.IsSameError (TheErrorHeap, CurrErr, PrevErr);
               if IsACommonError then
                  AddPreviousNodesToError (PrevErr, CurrErr); -- maintain set of affected nodes
                  SeqAlgebra.EliminateAfter (TheHeap, LagPrevIndex);
                  exit;
               end if;

               LagPrevIndex := PrevIndex;
               PrevIndex    := SeqAlgebra.NextMember (TheHeap, PrevIndex);
            end loop; --inner

            if IsACommonError then
               LagCurrIndex := CurrIndex;
               CurrIndex    := SeqAlgebra.NextMember (TheHeap, CurrIndex);
            else
               PassToErrorHandler (CurrErr, Table1);
               CurrIndex := SeqAlgebra.NextMember (TheHeap, CurrIndex);
               SeqAlgebra.EliminateAfter (TheHeap, LagCurrIndex);
            end if;
         end loop; --outer

         loop
            exit when SeqAlgebra.IsEmptySeq (TheHeap, PrevErrList);

            PrevErr := SeqAlgebra.Value_Of_Member (The_Heap => TheHeap,
                                                   M        => SeqAlgebra.FirstMember (TheHeap, PrevErrList));
            PassToErrorHandler (PrevErr, Table1);
            SeqAlgebra.EliminateAfter (TheHeap, SeqAlgebra.BeforeFirstMember (PrevErrList));
         end loop;
      end CompoundErrors;

   begin -- ProcessRoot
      CurrentNode := RootNode;
      loop --down
         LastNode := CurrentNode;
         if ComponentManager.IsALeaf (ComponentData, CurrentNode)
           and then not ComponentManager.IsNullComponent (ComponentManager.GetPreviousSibling (ComponentData, CurrentNode)) then
            CompoundErrors (CurrentNode, ComponentManager.GetPreviousSibling (ComponentData, CurrentNode));
         end if;

         CurrentNode := ComponentManager.GetFirstChild (ComponentData, CurrentNode);
         if ComponentManager.IsNullComponent (CurrentNode) then
            loop --up
               CurrentNode := ComponentManager.GetNextSibling (ComponentData, LastNode);
               exit when not ComponentManager.IsNullComponent (CurrentNode);

               CurrentNode := ComponentManager.GetParent (ComponentData, LastNode);
               exit when ComponentManager.IsNullComponent (CurrentNode);

               -- before we pass list of errors to parent node we need to set affected nodes
               --     of each error to the parent node (replacing any set of affected nodes
               --     accumulated during sibling merging of errors

               ListOfErrorsToPassToParent := ComponentManager.GetListOfErrors (ComponentData, LastNode);

               MemberOfList := SeqAlgebra.FirstMember (TheHeap, ListOfErrorsToPassToParent);
               while not SeqAlgebra.IsNullMember (MemberOfList) loop
                  ReplaceNodesOfError (CurrentNode, SeqAlgebra.Value_Of_Member (The_Heap => TheHeap,
                                                                                M        => MemberOfList));
                  MemberOfList := SeqAlgebra.NextMember (TheHeap, MemberOfList);
               end loop;
               ComponentManager.AddNewListOfErrors
                 (TheHeap,
                  ComponentData,
                  CurrentNode,
                  ComponentManager.GetListOfErrors (ComponentData, LastNode));
               ComponentManager.EmptyListOfErrors (TheHeap, ComponentData, LastNode);
               if not ComponentManager.IsNullComponent (ComponentManager.GetPreviousSibling (ComponentData, CurrentNode)) then
                  CompoundErrors (CurrentNode, ComponentManager.GetPreviousSibling (ComponentData, CurrentNode));
               end if;
               LastNode := CurrentNode;
            end loop; --up
         end if;
         exit when ComponentManager.IsNullComponent (CurrentNode);
      end loop; --down

      ErrList       := ComponentManager.GetListOfErrors (ComponentData, LastNode);
      CurrentMember := SeqAlgebra.FirstMember (TheHeap, ErrList);
      while not SeqAlgebra.IsNullMember (CurrentMember) loop
         PassToErrorHandler (SeqAlgebra.Value_Of_Member (The_Heap => TheHeap,
                                                         M        => CurrentMember), AllEntries);
         CurrentMember := SeqAlgebra.NextMember (TheHeap, CurrentMember);
      end loop;
   end ProcessRoot;

begin -- MergeAndHandleErrors
   RootNode := ComponentManager.GetFirstRoot (ComponentData);
   while not ComponentManager.IsNullComponent (RootNode) loop
      ProcessRoot (RootNode);
      RootNode := ComponentManager.GetNextRoot (ComponentData, RootNode);
   end loop;
end MergeAndHandleErrors;
