-------------------------------------------------------------------------------
-- (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.Wf_Formal_Part)
procedure Wf_Param
  (Node             : in     STree.SyntaxNode;
   Current_Scope    : in     Dictionary.Scopes;
   Subprog_Sym      : in     Dictionary.Symbol;
   First_Occurrence : in     Boolean;
   Context          : in     Dictionary.Contexts;
   Param_Count      : in out Natural;
   Errors_Found     : in out Boolean)
is
   Ident_List_Node, Next_Node, Type_Node : STree.SyntaxNode;
   It                                    : STree.Iterator;
   Node_Type                             : SP_Symbols.SP_Symbol;
   Mode                                  : Dictionary.Modes;
   Sym, Type_Sym                         : Dictionary.Symbol;
   Ident_Str                             : LexTokenManager.Lex_String;
   Exit_Loop                             : Boolean := False;

   function Modes_Equivalent (Mode1, Mode2 : Dictionary.Modes) return Boolean
   --# global in CommandLineData.Content;
   is
      Result : Boolean;
   begin
      case CommandLineData.Content.Language_Profile is
         when CommandLineData.SPARK83 =>
            Result := Mode1 = Mode2;
         when CommandLineData.SPARK95_Onwards =>
            Result := (Mode1 = Mode2)
              or else (Mode1 = Dictionary.InMode and then Mode2 = Dictionary.DefaultMode)
              or else (Mode1 = Dictionary.DefaultMode and then Mode2 = Dictionary.InMode);
      end case;
      return Result;
   end Modes_Equivalent;

begin -- Wf_Param
   Next_Node := Next_Sibling (Current_Node => Child_Node (Current_Node => Node));
   -- ASSUME Next_Node = mode
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Next_Node) = SP_Symbols.mode,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Next_Node = mode in Wf_Param");
   Node_Type := Syntax_Node_Type (Node => Child_Node (Current_Node => Next_Node));
   -- ASSUME Node_Type = in_mode OR inout_mode OR out_mode OR NULL
   case Node_Type is
      when SP_Symbols.in_mode =>
         Mode := Dictionary.InMode;
      when SP_Symbols.out_mode =>
         Mode := Dictionary.OutMode;
      when SP_Symbols.inout_mode =>
         Mode := Dictionary.InOutMode;
      when SP_Symbols.SPEND =>
         Mode := Dictionary.DefaultMode;
      when others =>
         Mode := Dictionary.InvalidMode;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Node_Type = in_mode OR inout_mode OR out_mode OR NULL in Wf_Param");
   end case;

   Type_Node := Next_Sibling (Current_Node => Next_Node);
   -- ASSUME Type_Node = type_mark
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Type_Node) = SP_Symbols.type_mark,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Type_Node = type_mark in Wf_Param");
   Wf_Type_Mark (Node          => Type_Node,
                 Current_Scope => Current_Scope,
                 Context       => Context,
                 Type_Sym      => Type_Sym);
   -- if the type is wrong then an error will be reported by wf_type_mark and Type_Sym will
   -- be set to the UnknownType
   Errors_Found := Errors_Found or else Dictionary.IsUnknownTypeMark (Type_Sym);

   if Dictionary.IsPredefinedSuspensionObjectType (Type_Sym) or else Dictionary.IsProtectedTypeMark (Type_Sym) then
      Errors_Found := True;
      ErrorHandler.Semantic_Error
        (Err_Num   => 904,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Type_Node),
         Id_Str    => LexTokenManager.Null_String);
   end if;

   Ident_List_Node := Child_Node (Current_Node => Node);
   -- ASSUME Ident_List_Node = identifier_list
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Ident_List_Node) = SP_Symbols.identifier_list,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Ident_List_Node = identifier_list in Wf_Param");
   It := Find_First_Node (Node_Kind    => SP_Symbols.identifier,
                          From_Root    => Ident_List_Node,
                          In_Direction => STree.Down);
   while not STree.IsNull (It) and then not Exit_Loop loop
      Next_Node := Get_Node (It => It);
      --# assert STree.Table = STree.Table~ and
      --#   Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.identifier and
      --#   Next_Node = Get_Node (It);
      if Param_Count < Natural'Last then
         Param_Count := Param_Count + 1;
         Ident_Str   := Node_Lex_String (Node => Next_Node);
         --# accept Flow, 41, "Expected stable expression";
         if First_Occurrence then
            --# end accept;
            if not Dictionary.IsDefined
              (Name              => Ident_Str,
               Scope             => Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                               The_Unit       => Subprog_Sym),
               Context           => Context,
               Full_Package_Name => False) then
               Dictionary.AddSubprogramParameter
                 (Name          => Ident_Str,
                  Subprogram    => Subprog_Sym,
                  TypeMark      => Type_Sym,
                  TypeReference => Dictionary.Location'(Start_Position => Node_Position (Node => Type_Node),
                                                        End_Position   => Node_Position (Node => Type_Node)),
                  Mode          => Mode,
                  Comp_Unit     => ContextManager.Ops.Current_Unit,
                  Specification => Dictionary.Location'(Start_Position => Node_Position (Node => Next_Node),
                                                        End_Position   => Node_Position (Node => Next_Node)));
               if Dictionary.IsFunction (Subprog_Sym)
                 and then not (Mode = Dictionary.InMode or else Mode = Dictionary.DefaultMode) then
                  Errors_Found := True;
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 64,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Next_Node),
                     Id_Str    => LexTokenManager.Null_String);
               end if;
            else
               Errors_Found := True;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 10,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Next_Node),
                  Id_Str    => Ident_Str);
            end if;
         else  -- subprogram previously declared so check params match
            if Param_Count <= Dictionary.GetNumberOfSubprogramParameters (Subprog_Sym) then
               Sym := Dictionary.GetSubprogramParameter (Subprog_Sym, Param_Count);
            else
               Sym := Dictionary.NullSymbol;
            end if;
            if Dictionary.Is_Null_Symbol (Sym)
              or else LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Dictionary.GetSimpleName (Sym),
               Lex_Str2 => Ident_Str) /=
              LexTokenManager.Str_Eq
              or else not Modes_Equivalent (Mode1 => Dictionary.GetSubprogramParameterMode (Sym),
                                            Mode2 => Mode)
              or else not Dictionary.Types_Are_Equal
              (Left_Symbol        => Dictionary.GetType (Sym),
               Right_Symbol       => Type_Sym,
               Full_Range_Subtype => False) then
               Errors_Found := True;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 153,
                  Reference => 11,
                  Position  => Node_Position (Node => Next_Node),
                  Id_Str    => Ident_Str);
            end if;
         end if;
      else
         Errors_Found := True;
         ErrorHandler.Semantic_Error
           (Err_Num   => 152,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Node),
            Id_Str    => Dictionary.GetSimpleName (Subprog_Sym));
         Exit_Loop := True;
      end if;
      It := STree.NextNode (It);
   end loop;
end Wf_Param;
