-------------------------------------------------------------------------------
-- (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.Wf_Subprogram_Body)
procedure ProcessPartitionAnnotation (Main_Node : in STree.SyntaxNode;
                                      Scope     : in Dictionary.Scopes) is
   Global_Node, Derives_Node : STree.SyntaxNode;
   Anno_Error                : Boolean;

   function Find_Main_Program_Anno_Node (Node : STree.SyntaxNode) return STree.SyntaxNode
   --# global in STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.main_program_declaration;
   --# return Result_Node => Syntax_Node_Type (Result_Node, STree.Table) = SP_Symbols.main_program_annotation;
   is
      Result : STree.SyntaxNode;
   begin
      Result := Child_Node (Current_Node => Node);
      -- ASSUME Result = inherit_clause OR main_program_annotation
      if Syntax_Node_Type (Node => Result) = SP_Symbols.inherit_clause then
         -- ASSUME Result = inherit_clause
         Result := Next_Sibling (Current_Node => Result);
      elsif Syntax_Node_Type (Node => Result) /= SP_Symbols.main_program_annotation then
         Result := STree.NullNode;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Result = inherit_clause OR main_program_annotation in Find_Main_Program_Anno_Node");
      end if;
      -- ASSUME Result = main_program_annotation
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Result) = SP_Symbols.main_program_annotation,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Inherit_Node = main_program_annotation in Find_Main_Program_Anno_Node");
      return Result;
   end Find_Main_Program_Anno_Node;

   function Find_Global_Node (Node : STree.SyntaxNode) return STree.SyntaxNode
   --# global in STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.main_program_declaration;
   --# return Result_Node => (Syntax_Node_Type (Result_Node, STree.Table) = SP_Symbols.moded_global_definition or
   --#                          Result_Node = STree.NullNode);
   is
      Result : STree.SyntaxNode;
   begin
      Result := Next_Sibling (Current_Node => Find_Main_Program_Anno_Node (Node => Node));
      -- ASSUME Result = moded_global_definition OR not_overriding_subprogram_body
      if Syntax_Node_Type (Node => Result) = SP_Symbols.not_overriding_subprogram_body then
         -- ASSUME Result = not_overriding_subprogram_body
         Result := STree.NullNode;
      elsif Syntax_Node_Type (Node => Result) /= SP_Symbols.moded_global_definition then
         Result := STree.NullNode;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Result = moded_global_definition OR not_overriding_subprogram_body in Find_Global_Node");
      end if;
      -- ASSUME Result = moded_global_definition OR NULL
      SystemErrors.RT_Assert
        (C       => Result = STree.NullNode or else Syntax_Node_Type (Node => Result) = SP_Symbols.moded_global_definition,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Result = moded_global_definition OR NULL in Find_Global_Node");
      return Result;
   end Find_Global_Node;

   function Find_Derives_Node (Node : STree.SyntaxNode) return STree.SyntaxNode
   --# global in STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.main_program_declaration;
   --# return Result_Node => (Syntax_Node_Type (Result_Node, STree.Table) = SP_Symbols.dependency_relation or
   --#                          Result_Node = STree.NullNode);
   is
      Result : STree.SyntaxNode;
   begin
      Result := Find_Global_Node (Node => Node);
      -- ASSUME Result = moded_global_definition OR NULL
      if Syntax_Node_Type (Node => Result) = SP_Symbols.moded_global_definition then
         -- ASSUME Result = moded_global_definition
         Result := Next_Sibling (Current_Node => Result);
         -- ASSUME Result = dependency_relation OR not_overriding_subprogram_body
         if Syntax_Node_Type (Node => Result) = SP_Symbols.not_overriding_subprogram_body then
            -- ASSUME Result = not_overriding_subprogram_body
            Result := STree.NullNode;
         elsif Syntax_Node_Type (Node => Result) /= SP_Symbols.dependency_relation then
            Result := STree.NullNode;
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Result = dependency_relation OR not_overriding_subprogram_body in Find_Derives_Node");
         end if;
      elsif Result /= STree.NullNode then
         Result := STree.NullNode;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Result = moded_global_definition OR NULL in Find_Derives_Node");
      end if;
      -- ASSUME Result = dependency_relation OR NULL
      SystemErrors.RT_Assert
        (C       => Result = STree.NullNode or else Syntax_Node_Type (Node => Result) = SP_Symbols.dependency_relation,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Result = dependency_relation OR NULL in Find_Derives_Node");
      return Result;
   end Find_Derives_Node;

begin -- ProcessPartitionAnnotation
   Global_Node := Find_Global_Node (Node => Main_Node);

   -- A partition annotation exists if the Global_Node is not null.
   -- There must be a partition annotation in Ravenscar and there
   -- must not be one otherwise
   if not CommandLineData.Ravenscar_Selected then
      if Syntax_Node_Type (Node => Global_Node) = SP_Symbols.moded_global_definition then
         -- unexpected partition annotation
         ErrorHandler.Semantic_Error
           (Err_Num   => 949,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Global_Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;
   else -- Ravenscar IS selected
      if Global_Node = STree.NullNode then
         -- missing partition annotation
         Dictionary.SetSubprogramSignatureNotWellformed (Dictionary.IsAbstract, Dictionary.GetThePartition);
         ErrorHandler.Semantic_Error
           (Err_Num   => 950,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Find_Main_Program_Anno_Node (Node => Main_Node)),
            Id_Str    => LexTokenManager.Null_String);
      elsif Syntax_Node_Type (Node => Global_Node) = SP_Symbols.moded_global_definition then
         -- partition annotation both present and required, so process it
         -- first the globals
         Wf_Global_Definition
           (Node          => Global_Node,
            Scope         => Scope,
            Subprog_Sym   => Dictionary.GetThePartition,
            First_Seen    => True,
            Sem_Err_Found => Anno_Error);
         if Anno_Error then
            Dictionary.SetSubprogramSignatureNotWellformed (Dictionary.IsAbstract, Dictionary.GetThePartition);
         end if;

         Derives_Node := Find_Derives_Node (Node => Main_Node);
         -- ASSUME Derives_Node = dependency_relation OR NULL
         -- now check whether derives is there
         if Syntax_Node_Type (Node => Derives_Node) = SP_Symbols.dependency_relation then
            -- ASSUME Derives_Node = dependency_relation
            if CommandLineData.Content.Flow_Option /= CommandLineData.Data_Flow then
               -- derives present and required if flow=info (or allowed, if flow=auto)
               Dependency_Relation.Wf_Dependency_Relation
                 (Node         => Derives_Node,
                  Scope        => Scope,
                  Subprog_Sym  => Dictionary.GetThePartition,
                  First_Seen   => True,
                  Glob_Def_Err => Anno_Error,
                  The_Heap     => TheHeap);
            else
               -- in DFA mode, we ignore the derives and use the moded globals
               Dependency_Relation.Create_Full_Subprog_Dependency
                 (Node_Pos    => Node_Position (Node => Derives_Node),
                  Subprog_Sym => Dictionary.GetThePartition,
                  Abstraction => Dictionary.IsAbstract,
                  The_Heap    => TheHeap);
               ErrorHandler.Semantic_Note
                 (Err_Num  => 1,
                  Position => Node_Position (Node => Derives_Node),
                  Id_Str   => LexTokenManager.Null_String);
            end if;
         elsif Derives_Node = STree.NullNode then
            -- ASSUME Derives_Node = NULL
            -- Derives is NOT present
            if CommandLineData.Content.Flow_Option = CommandLineData.Info_Flow then
               -- but in IFA mode it should have been
               ErrorHandler.Semantic_Error
                 (Err_Num   => 501,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Global_Node),
                  Id_Str    => LexTokenManager.Null_String);
            else
               -- not there but ok because flow=data or flow=auto selected
               Dependency_Relation.Create_Full_Subprog_Dependency
                 (Node_Pos    => Node_Position (Node => Global_Node),
                  Subprog_Sym => Dictionary.GetThePartition,
                  Abstraction => Dictionary.IsAbstract,
                  The_Heap    => TheHeap);
            end if;
         end if;
      end if;
   end if;
end ProcessPartitionAnnotation;
