-------------------------------------------------------------------------------
-- (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 (Sem.CompUnit.WalkStatements)
procedure Up_Loop (Node  : in     STree.SyntaxNode;
                   Scope : in out Dictionary.Scopes) is
   First_Ident_Node, Second_Ident_Node : STree.SyntaxNode;
   Endless_Loop_Error                  : Boolean := False;

   function Position_To_Report_Error (Node : STree.SyntaxNode) return LexTokenManager.Token_Position
   --# global in STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.loop_statement;
   is
      Local_Node : STree.SyntaxNode;
   begin
      Local_Node := Child_Node (Current_Node => Node);
      -- ASSUME Local_Node = simple_name OR loop_statement_opt
      if Syntax_Node_Type (Node => Local_Node) = SP_Symbols.simple_name then
         -- ASSUME Local_Node = simple_name
         -- loop has a name
         Local_Node := Last_Sibling_Of (Start_Node => Local_Node);
         -- closing name location
         -- ASSUME Local_Node = simple_name
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Local_Node) = SP_Symbols.simple_name,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Local_Node = simple_name in Position_To_Report_Error");
      elsif Syntax_Node_Type (Node => Local_Node) = SP_Symbols.loop_statement_opt then
         -- ASSUME Local_Node = loop_statement_opt
         -- loop has no name, find last statement in sequence of statements
         Local_Node := Child_Node (Current_Node => Next_Sibling (Current_Node => Local_Node));
         -- ASSUME Local_Node = sequence_of_statements OR statement
         -- Local_Node is either a Statement (which is the only one in the sequence)
         -- or it's a sequence_of_statements in which case the last statement is to it's right
         if Syntax_Node_Type (Node => Local_Node) = SP_Symbols.sequence_of_statements then
            Local_Node := Next_Sibling (Current_Node => Local_Node);
         elsif Syntax_Node_Type (Node => Local_Node) /= SP_Symbols.statement then
            Local_Node := STree.NullNode;
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Local_Node = sequence_of_statements OR statement in Position_To_Report_Error");
         end if;
         -- ASSUME Local_Node = statement
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Local_Node) = SP_Symbols.statement,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Local_Node = statement in Position_To_Report_Error");
      else
         Local_Node := STree.NullNode;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Local_Node = simple_name OR loop_statement_opt in Position_To_Report_Error");
      end if;
      -- ASSUME Node = simple_name OR statement
      return Node_Position (Node => Local_Node);
   end Position_To_Report_Error;

begin -- Up_Loop
   First_Ident_Node := Child_Node (Current_Node => Node);
   -- ASSUME First_Ident_Node = simple_name OR loop_statement_opt
   if Syntax_Node_Type (Node => First_Ident_Node) = SP_Symbols.simple_name then
      -- ASSUME First_Ident_Node = simple_name
      Second_Ident_Node := Child_Node (Current_Node => Last_Sibling_Of (Start_Node => First_Ident_Node));
      -- ASSUME Second_Ident_Node = identifier
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Second_Ident_Node) = SP_Symbols.identifier,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Second_Ident_Node = identifier in Up_Loop");
      First_Ident_Node := Child_Node (Current_Node => First_Ident_Node);
      -- ASSUME First_Ident_Node = identifier
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => First_Ident_Node) = SP_Symbols.identifier,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect First_Ident_Node = identifier in Up_Loop");
      if LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Node_Lex_String (Node => First_Ident_Node),
         Lex_Str2 => Node_Lex_String (Node => Second_Ident_Node)) /=
        LexTokenManager.Str_Eq then
         ErrorHandler.Semantic_Error
           (Err_Num   => 58,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Second_Ident_Node),
            Id_Str    => Node_Lex_String (Node => First_Ident_Node));
      end if;
   elsif Syntax_Node_Type (Node => First_Ident_Node) /= SP_Symbols.loop_statement_opt then
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect First_Ident_Node = simple_name OR loop_statement_opt in Up_Loop");
   end if;

   -- Make checks that any loops without exits are the last statement of the main prgoram
   -- or task body.
   -- We may need to allow a proof statement or pragma to follow and infinite loop (and, perhaps
   -- a null statement) but for now we allow nothing to follow.

   if not Dictionary.GetLoopHasExits (Dictionary.GetRegion (Scope)) then
      -- Loop is infinite, checks are required
      -- First check that it is main program or in task type
      if not (Dictionary.IsMainProgram (Dictionary.GetRegion (Dictionary.GetEnclosingScope (Scope)))
                or else Dictionary.IsTaskType (Dictionary.GetRegion (Dictionary.GetEnclosingScope (Scope)))) then
         Endless_Loop_Error := True;
      else
         case Syntax_Node_Type (Node => Parent_Of_Sequence (Node => Node)) is
            when SP_Symbols.if_statement               |
              SP_Symbols.elsif_part                 |
              SP_Symbols.else_part                  |
              SP_Symbols.loop_statement             |
              SP_Symbols.case_statement_alternative |
              SP_Symbols.others_part                =>
               Endless_Loop_Error := True;
            when others =>
               if not Is_Last_In_Sequence (Node => Node) then
                  Endless_Loop_Error := True;
               end if;
         end case;
      end if;
      if Endless_Loop_Error then
         ErrorHandler.Semantic_Error
           (Err_Num   => 730,
            Reference => ErrorHandler.No_Reference,
            Position  => Position_To_Report_Error (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;
   end if;

   -- move out of loop scope
   Scope := Dictionary.GetEnclosingScope (Scope);
end Up_Loop;
