-------------------------------------------------------------------------------
-- (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 interface (Ada83) or pragma
--import (Ada95).  The checks made are:
-- 1.  Internal consistency of associations used, number of parameters etc.
-- 2.  The Entity/Subprogram name is that expected
--------------------------------------------------------------------------------

separate (Sem)
procedure Wf_External_Interface
  (Pragma_Node : in     STree.SyntaxNode;
   Entity_Sym  : in     Dictionary.Symbol;
   Error_Found :    out Boolean)
is

   procedure Check_Represent_Same_Name
     (Exp_Node    : in     STree.SyntaxNode;
      Entity_Sym  : in     Dictionary.Symbol;
      Error_Found : in out Boolean)
   --# 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,
   --#                                         Entity_Sym,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Exp_Node,
   --#                                         LexTokenManager.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table &
   --#         Error_Found,
   --#         STree.Table                from *,
   --#                                         Dictionary.Dict,
   --#                                         Entity_Sym,
   --#                                         Exp_Node,
   --#                                         LexTokenManager.State,
   --#                                         STree.Table;
   --# 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 => Entity_Sym);
      Id_Node := Exp_Node;
      loop
         --# assert STree.Table = STree.Table~;
         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
         -- ASSUME Id_Node = identifier
         STree.Set_Node_Lex_String (Sym  => Entity_Sym,
                                    Node => Id_Node);
      else
         Error_Found := True;
         ErrorHandler.Semantic_Error
           (Err_Num   => 71,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Exp_Node),
            Id_Str    => Name);
      end if;
   end Check_Represent_Same_Name;

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

   procedure Wf_Pragma_Interface
     (Pragma_Node : in     STree.SyntaxNode;
      Entity_Sym  : in     Dictionary.Symbol;
      Error_Found : in out Boolean)
   --# 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,
   --#                                         Entity_Sym,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Pragma_Node,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table &
   --#         Error_Found,
   --#         STree.Table                from *,
   --#                                         Dictionary.Dict,
   --#                                         Entity_Sym,
   --#                                         LexTokenManager.State,
   --#                                         Pragma_Node,
   --#                                         STree.Table;
   --# pre Syntax_Node_Type (Pragma_Node, STree.Table) = SP_Symbols.apragma;
   --# post STree.Table = STree.Table~;
   is
      Arg_Assoc_Rep_Node : STree.SyntaxNode;
      Subprog_Name_Node  : STree.SyntaxNode;
   begin
      Arg_Assoc_Rep_Node := Child_Node (Current_Node => Pragma_Node);
      -- ASSUME Arg_Assoc_Rep_Node = identifier
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Arg_Assoc_Rep_Node) = SP_Symbols.identifier,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Arg_Assoc_Rep_Node = identifier in Wf_Pragma_Interface");
      Arg_Assoc_Rep_Node := Next_Sibling (Current_Node => Arg_Assoc_Rep_Node);
      -- ASSUME Arg_Assoc_Rep_Node = argument_association_rep OR NULL
      if Syntax_Node_Type (Node => Arg_Assoc_Rep_Node) = SP_Symbols.argument_association_rep then
         -- ASSUME Arg_Assoc_Rep_Node = argument_association_rep
         Arg_Assoc_Rep_Node := Child_Node (Current_Node => Arg_Assoc_Rep_Node);
         -- ASSUME Arg_Assoc_Rep_Node = argument_association_rep OR argument_association
         if Syntax_Node_Type (Node => Arg_Assoc_Rep_Node) = SP_Symbols.argument_association_rep then
            -- ASSUME Arg_Assoc_Rep_Node = argument_association_rep
            if Syntax_Node_Type (Node => Child_Node (Current_Node => Arg_Assoc_Rep_Node)) =
              SP_Symbols.argument_association then
               -- ASSUME Child_Node (Current_Node => Arg_Assoc_Rep_Node) = argument_association
               -- pragma has 2 arguments
               Subprog_Name_Node := Child_Node (Current_Node => Next_Sibling (Current_Node => Arg_Assoc_Rep_Node));
               -- ASSUME Subprog_Name_Node = identifier OR ADA_expression
               if Syntax_Node_Type (Node => Subprog_Name_Node) = SP_Symbols.identifier then
                  -- ASSUME Subprog_Name_Node = identifier
                  -- form of expression wrong
                  Error_Found := True;
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 71,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Subprog_Name_Node),
                     Id_Str    => Dictionary.GetSimpleName (Item => Entity_Sym));
               elsif Syntax_Node_Type (Node => Subprog_Name_Node) = SP_Symbols.ADA_expression then
                  -- ASSUME Subprog_Name_Node = ADA_expression
                  -- form of expression ok so check name actually matches
                  Check_Represent_Same_Name (Exp_Node    => Subprog_Name_Node,
                                             Entity_Sym  => Entity_Sym,
                                             Error_Found => Error_Found);
               else
                  SystemErrors.Fatal_Error
                    (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                     Msg     => "Expect Subprog_Name_Node = identifier OR ADA_expression in Wf_Pragma_Interface");
               end if;
            elsif Syntax_Node_Type (Node => Child_Node (Current_Node => Arg_Assoc_Rep_Node)) =
              SP_Symbols.argument_association_rep then
               -- ASSUME Child_Node (Current_Node => Arg_Assoc_Rep_Node) = argument_association_rep
               -- pragma does have more than 2 arguments
               Error_Found := True;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 69,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Pragma_Node),
                  Id_Str    => LexTokenManager.Interface_Token);
            else
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect Child_Node (Current_Node => Arg_Assoc_Rep_Node = argument_association_rep OR " &
                    "argument_association in Wf_Pragma_Interface");
            end if;
         elsif Syntax_Node_Type (Node => Arg_Assoc_Rep_Node) = SP_Symbols.argument_association then
            -- ASSUME Arg_Assoc_Rep_Node = argument_association
            -- pragma does have 1 argument
            Error_Found := True;
            ErrorHandler.Semantic_Error
              (Err_Num   => 69,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Pragma_Node),
               Id_Str    => LexTokenManager.Interface_Token);
         else
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Arg_Assoc_Rep_Node = argument_association_rep OR argument_association in Wf_Pragma_Interface");
         end if;
      elsif Arg_Assoc_Rep_Node = STree.NullNode then
         -- ASSUME Arg_Assoc_Rep_Node = NULL
         -- pragma does have 0 argument
         Error_Found := True;
         ErrorHandler.Semantic_Error
           (Err_Num   => 69,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Pragma_Node),
            Id_Str    => LexTokenManager.Interface_Token);
      else
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Arg_Assoc_Rep_Node = argument_association_rep OR NULL in Wf_Pragma_Interface");
      end if;
   end Wf_Pragma_Interface;

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

   procedure Wf_Pragma_Import
     (Pragma_Node : in     STree.SyntaxNode;
      Entity_Sym  : in     Dictionary.Symbol;
      Error_Found : in out Boolean)
   --# 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,
   --#                                         Entity_Sym,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Pragma_Node,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table &
   --#         Error_Found,
   --#         STree.Table                from *,
   --#                                         Dictionary.Dict,
   --#                                         Entity_Sym,
   --#                                         LexTokenManager.State,
   --#                                         Pragma_Node,
   --#                                         STree.Table;
   --# pre Syntax_Node_Type (Pragma_Node, STree.Table) = SP_Symbols.apragma;
   --# post STree.Table = STree.Table~;
   is
      Max_Args : constant Natural := 4;

      type Args is (Illegal, Convention, Entity, External_Name, Link_Name);
      subtype Legal_Args is Args range Convention .. Link_Name;
      type Founds is array (Legal_Args) of Boolean;
      subtype Arg_Count_T is Natural range 0 .. Max_Args;

      Found                   : Founds      := Founds'(Legal_Args => False);
      Using_Named_Association : Boolean     := False;
      Arg_Ass_Node            : STree.SyntaxNode;
      Arg_Count               : Arg_Count_T := 0;

      procedure Check_Argument
        (Node                    : in     STree.SyntaxNode;
         Entity_Sym              : in     Dictionary.Symbol;
         Arg_Count               : in     Arg_Count_T;
         Using_Named_Association : in out Boolean;
         Found                   : in out Founds;
         Error_Found             : in out Boolean)
      --# 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 Arg_Count,
      --#                                         CommandLineData.Content,
      --#                                         Dictionary.Dict,
      --#                                         Entity_Sym,
      --#                                         ErrorHandler.Error_Context,
      --#                                         Found,
      --#                                         LexTokenManager.State,
      --#                                         Node,
      --#                                         SPARK_IO.File_Sys,
      --#                                         STree.Table,
      --#                                         Using_Named_Association &
      --#         Error_Found,
      --#         STree.Table                from *,
      --#                                         Arg_Count,
      --#                                         Dictionary.Dict,
      --#                                         Entity_Sym,
      --#                                         Found,
      --#                                         LexTokenManager.State,
      --#                                         Node,
      --#                                         STree.Table,
      --#                                         Using_Named_Association &
      --#         Found                      from *,
      --#                                         Arg_Count,
      --#                                         LexTokenManager.State,
      --#                                         Node,
      --#                                         STree.Table,
      --#                                         Using_Named_Association &
      --#         Using_Named_Association    from *,
      --#                                         Node,
      --#                                         STree.Table;
      --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.argument_association and
      --#   Arg_Count >= 1;
      --# post STree.Table = STree.Table~;
      is
         Exp_Node : STree.SyntaxNode;
         Arg      : Args;

         function Get_Arg (Arg_String : LexTokenManager.Lex_String) return Args
         --# global in LexTokenManager.State;
         is
            Result : Args;
         begin
            if LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Arg_String,
               Lex_Str2 => LexTokenManager.Convention_Token) =
              LexTokenManager.Str_Eq then
               Result := Convention;
            elsif LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Arg_String,
               Lex_Str2 => LexTokenManager.Entity_Token) =
              LexTokenManager.Str_Eq then
               Result := Entity;
            elsif LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Arg_String,
               Lex_Str2 => LexTokenManager.External_Name_Token) =
              LexTokenManager.Str_Eq then
               Result := External_Name;
            elsif LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Arg_String,
               Lex_Str2 => LexTokenManager.Link_Name_Token) =
              LexTokenManager.Str_Eq then
               Result := Link_Name;
            else
               Result := Illegal;
            end if;
            return Result;
         end Get_Arg;

      begin -- Check_Argument
         Exp_Node := Child_Node (Current_Node => Node);
         -- ASSUME Exp_Node = identifier OR ADA_expression
         if Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.identifier then
            -- ASSUME Exp_Node = identifier
            -- named association
            Using_Named_Association := True;
            Arg                     := Get_Arg (Arg_String => Node_Lex_String (Node => Exp_Node));
            if Arg = Illegal then
               Error_Found := True;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 601,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Exp_Node),
                  Id_Str    => LexTokenManager.Null_String);
            elsif Found (Arg) then
               Error_Found := True;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 602,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Exp_Node),
                  Id_Str    => Node_Lex_String (Node => Exp_Node));
            else
               Found (Arg) := True;
               if Arg = Entity then
                  Exp_Node := Next_Sibling (Current_Node => Exp_Node);
                  -- ASSUME Exp_Node = ADA_expression
                  SystemErrors.RT_Assert
                    (C       => Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.ADA_expression,
                     Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                     Msg     => "Expect Exp_Node = ADA_expression in Check_Argument");
                  Check_Represent_Same_Name (Exp_Node    => Exp_Node,
                                             Entity_Sym  => Entity_Sym,
                                             Error_Found => Error_Found);
               end if;
            end if;
         elsif Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.ADA_expression then
            -- ASSUME Exp_Node = ADA_expression
            -- positional association
            if Using_Named_Association then
               -- illegal switch form named to positional assoc
               Error_Found := True;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 601,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Exp_Node),
                  Id_Str    => LexTokenManager.Null_String);
            else
               Arg := Args'Val (Arg_Count);
               if Arg /= Illegal then
                  Found (Arg) := True;
                  if Arg = Entity then
                     Check_Represent_Same_Name (Exp_Node    => Exp_Node,
                                                Entity_Sym  => Entity_Sym,
                                                Error_Found => Error_Found);
                  end if;
               end if;
            end if;
         else
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Exp_Node = identifier OR ADA_expression in Check_Argument");
         end if;
      end Check_Argument;

   begin -- Wf_Pragma_Import
      Arg_Ass_Node := Child_Node (Current_Node => Pragma_Node);
      -- ASSUME Arg_Ass_Node = identifier
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Arg_Ass_Node) = SP_Symbols.identifier,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Arg_Ass_Node = identifier in Wf_Pragma_Import");
      Arg_Ass_Node := Next_Sibling (Current_Node => Arg_Ass_Node);
      -- ASSUME Arg_Ass_Node = argument_association_rep OR NULL
      if Syntax_Node_Type (Node => Arg_Ass_Node) = SP_Symbols.argument_association_rep then
         -- ASSUME Arg_Ass_Node = argument_association_rep
         while Syntax_Node_Type (Node => Arg_Ass_Node) = SP_Symbols.argument_association_rep loop
            --# assert STree.Table = STree.Table~ and
            --#   Syntax_Node_Type (Arg_Ass_Node, STree.Table) = SP_Symbols.argument_association_rep;
            Arg_Ass_Node := Child_Node (Current_Node => Arg_Ass_Node);
            -- ASSUME Arg_Ass_Node = argument_association_rep OR argument_association
            SystemErrors.RT_Assert
              (C       => Syntax_Node_Type (Node => Arg_Ass_Node) = SP_Symbols.argument_association_rep
                 or else Syntax_Node_Type (Node => Arg_Ass_Node) = SP_Symbols.argument_association,
               Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Arg_Ass_Node = argument_association_rep OR argument_association in Wf_Pragma_Import");
         end loop;
         --# check Syntax_Node_Type (Arg_Ass_Node, STree.Table) = SP_Symbols.argument_association;
         -- now pointing at leftmost argument association
         while Syntax_Node_Type (Node => Arg_Ass_Node) = SP_Symbols.argument_association loop
            --# assert STree.Table = STree.Table~ and
            --#   Syntax_Node_Type (Arg_Ass_Node, STree.Table) = SP_Symbols.argument_association;
            if Arg_Count = Max_Args then
               Error_Found := True;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 600,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Arg_Ass_Node),
                  Id_Str    => LexTokenManager.Null_String);
               exit;
            end if;
            Arg_Count := Arg_Count + 1;
            Check_Argument
              (Node                    => Arg_Ass_Node,
               Entity_Sym              => Entity_Sym,
               Arg_Count               => Arg_Count,
               Using_Named_Association => Using_Named_Association,
               Found                   => Found,
               Error_Found             => Error_Found);
            Arg_Ass_Node := Next_Sibling (Current_Node => Parent_Node (Current_Node => Arg_Ass_Node));
            -- ASSUME Arg_Ass_Node = argument_association OR NULL
            SystemErrors.RT_Assert
              (C       => Syntax_Node_Type (Node => Arg_Ass_Node) = SP_Symbols.argument_association
                 or else Arg_Ass_Node = STree.NullNode,
               Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Arg_Ass_Node = argument_association OR NULL in Wf_Pragma_Import");
         end loop;
         if Arg_Count < 2 then
            Error_Found := True;
            ErrorHandler.Semantic_Error
              (Err_Num   => 600,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Pragma_Node),
               Id_Str    => LexTokenManager.Convention_Token);

         else
            if not Found (Convention) then
               Error_Found := True;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 603,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Pragma_Node),
                  Id_Str    => LexTokenManager.Convention_Token);
            end if;
            if not Found (Entity) then
               Error_Found := True;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 603,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Pragma_Node),
                  Id_Str    => LexTokenManager.Entity_Token);
            end if;
         end if;
      elsif Arg_Ass_Node = STree.NullNode then
         -- ASSUME Arg_Ass_Node = NULL
         -- there are no arguments
         Error_Found := True;
         ErrorHandler.Semantic_Error
           (Err_Num   => 600,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Pragma_Node),
            Id_Str    => LexTokenManager.Null_String);
      else
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Arg_Ass_Node = argument_association_rep OR NULL in Wf_Pragma_Import");
      end if;
   end Wf_Pragma_Import;

begin -- Wf_External_Interface
   Error_Found := False;
   case CommandLineData.Content.Language_Profile is
      when CommandLineData.SPARK83 =>
         Wf_Pragma_Interface (Pragma_Node => Pragma_Node,
                              Entity_Sym  => Entity_Sym,
                              Error_Found => Error_Found);
      when CommandLineData.SPARK95_Onwards =>
         Wf_Pragma_Import (Pragma_Node => Pragma_Node,
                           Entity_Sym  => Entity_Sym,
                           Error_Found => Error_Found);
   end case;
end Wf_External_Interface;
