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

-- Synopsis
-- This procedure checks the validity of a pragma elaborate_body for SPARK 95
--------------------------------------------------------------------------------
separate (Sem.Wf_Pragma)
procedure Wf_Elaborate_Body (Pragma_Node : in STree.SyntaxNode;
                             Pack_Sym    : in Dictionary.Symbol) is
   Id_Node  : STree.SyntaxNode;
   Exp_Node : STree.SyntaxNode;

   procedure Check_Represent_Same_Name (Exp_Node : in STree.SyntaxNode;
                                        Pack_Sym : in Dictionary.Symbol)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --#        in out STree.Table;
   --# derives ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Exp_Node,
   --#                                         LexTokenManager.State,
   --#                                         Pack_Sym,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table &
   --#         STree.Table                from *,
   --#                                         Dictionary.Dict,
   --#                                         Exp_Node,
   --#                                         LexTokenManager.State,
   --#                                         Pack_Sym;
   --# pre Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.ADA_expression;
   --# post STree.Table = STree.Table~;
   is
      Is_Chain           : Boolean;
      Id_Node, Next_Node : STree.SyntaxNode;
      Name               : LexTokenManager.Lex_String;
   begin
      Name    := Dictionary.GetSimpleName (Item => Pack_Sym);
      Id_Node := Exp_Node;
      loop
         --# assert STree.Table = STree.Table~ and
         --#   Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.ADA_expression;
         Is_Chain  := Next_Sibling (Current_Node => Id_Node) = STree.NullNode;
         Next_Node := Child_Node (Current_Node => Id_Node);
         exit when not Is_Chain or else Next_Node = STree.NullNode;
         Id_Node := Next_Node;
      end loop;

      if Is_Chain
        and then Syntax_Node_Type (Node => Id_Node) = SP_Symbols.identifier
        and then LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Node_Lex_String (Node => Id_Node),
         Lex_Str2 => Name) =
        LexTokenManager.Str_Eq then
         STree.Set_Node_Lex_String (Sym  => Pack_Sym,
                                    Node => Id_Node);
      else
         ErrorHandler.Semantic_Error
           (Err_Num   => 606,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Exp_Node),
            Id_Str    => Name);
      end if;
   end Check_Represent_Same_Name;

begin -- Wf_Elaborate_Body
   if Dictionary.IsPackage (Pack_Sym) and then Dictionary.GetScope (Pack_Sym) = Dictionary.GlobalScope then
      -- legal, library-level package
      Id_Node := Child_Node (Current_Node => Pragma_Node);
      -- ASSUME Id_Node = identifier OR assert_pragma
      if Syntax_Node_Type (Node => Id_Node) = SP_Symbols.identifier then
         -- ASSUME Id_Node = identifier
         Dictionary.SetPackageElaborateBodyFound (Pack_Sym);
         Exp_Node := Next_Sibling (Current_Node => Id_Node);
         -- ASSUME Exp_Node = argument_association_rep OR NULL
         if Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.argument_association_rep then
            -- ASSUME Exp_Node = argument_association_rep
            Exp_Node := Child_Node (Current_Node => Exp_Node);
            -- ASSUME Exp_Node = argument_association_rep OR argument_association
            if Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.argument_association then
               -- ASSUME Exp_Node = argument_association
               Exp_Node := Child_Node (Current_Node => Exp_Node);
               -- ASSUME Exp_Node = identifier OR ADA_expression
               if Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.identifier then
                  -- ASSUME Exp_Node = identifier
                  -- wrong number of arguments
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 605,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Id_Node),
                     Id_Str    => LexTokenManager.Null_String);
               elsif Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.ADA_expression then
                  -- ASSUME Exp_Node = ADA_expression
                  Check_Represent_Same_Name (Exp_Node => Exp_Node,
                                             Pack_Sym => Pack_Sym);
               else
                  SystemErrors.Fatal_Error
                    (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                     Msg     => "Expect Exp_Node = identifier OR ADA_expression in Wf_Elaborate_Body");
               end if;
            elsif Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.argument_association_rep then
               -- ASSUME Exp_Node = argument_association_rep
               -- wrong number of arguments
               ErrorHandler.Semantic_Error
                 (Err_Num   => 605,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Id_Node),
                  Id_Str    => LexTokenManager.Null_String);
            else
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect Exp_Node = argument_association_rep OR argument_association in Wf_Elaborate_Body");
            end if;
         elsif Exp_Node = STree.NullNode then
            -- ASSUME Exp_Node = NULL
            -- wrong number of arguments
            ErrorHandler.Semantic_Error
              (Err_Num   => 605,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Id_Node),
               Id_Str    => LexTokenManager.Null_String);
         else
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Exp_Node = argument_association_rep OR NULL in Wf_Elaborate_Body");
         end if;
      elsif Syntax_Node_Type (Node => Id_Node) = SP_Symbols.assert_pragma then
         -- ASSUME Id_Node = assert_pragma
         -- wrong number of arguments
         ErrorHandler.Semantic_Error
           (Err_Num   => 605,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Id_Node),
            Id_Str    => LexTokenManager.Null_String);
      else
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Id_Node = identifier OR assert_pragma in Wf_Elaborate_Body");
      end if;
   else -- not a library level package
      ErrorHandler.Semantic_Error
        (Err_Num   => 72,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Pragma_Node),
         Id_Str    => LexTokenManager.Elaborate_Body_Token);
   end if;
end Wf_Elaborate_Body;
