-------------------------------------------------------------------------------
-- (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.Walk_Expression_P)
procedure Up_Wf_Name_Argument_List
  (Node       : in     STree.SyntaxNode;
   E_Stack    : in out Exp_Stack.Exp_Stack_Type;
   Heap_Param : in out Lists.List_Heap)
is
   Type_Info    : Sem.Exp_Record;
   Sym          : Dictionary.Symbol;
   All_Found    : Boolean;
   Ptr          : Lists.List;
   Unused_Value : Maths.Value;
   Next_Node    : STree.SyntaxNode;

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

   procedure Check_Names_Are_All_There
     (Node_Pos   : in     LexTokenManager.Token_Position;
      Fun_Sym    : in     Dictionary.Symbol;
      List       : in     Lists.List;
      Heap_Param : in     Lists.List_Heap;
      All_There  :    out Boolean)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --# derives All_There                  from Dictionary.Dict,
   --#                                         Fun_Sym,
   --#                                         Heap_Param,
   --#                                         LexTokenManager.State,
   --#                                         List &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Fun_Sym,
   --#                                         Heap_Param,
   --#                                         LexTokenManager.State,
   --#                                         List,
   --#                                         Node_Pos,
   --#                                         SPARK_IO.File_Sys;
   is
      It        : Dictionary.Iterator;
      Param_Str : LexTokenManager.Lex_String;
   begin
      All_There := True;
      It        := Dictionary.FirstSubprogramParameter (Fun_Sym);
      while not Dictionary.IsNullIterator (It) loop
         Param_Str := Dictionary.GetSimpleName (Dictionary.CurrentSymbol (It));
         if not Lists.Is_Member (Heap     => Heap_Param,
                                 The_List => List,
                                 Str      => Param_Str) then
            All_There := False;
            ErrorHandler.Semantic_Error
              (Err_Num   => 23,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Pos,
               Id_Str    => Param_Str);
         end if;
         It := Dictionary.NextSymbol (It);
      end loop;
   end Check_Names_Are_All_There;

begin -- Up_Wf_Name_Argument_List
   Exp_Stack.Pop (Item  => Type_Info,
                  Stack => E_Stack);
   Sym := Type_Info.Other_Symbol;
   case Type_Info.Sort is
      when Sem.Is_Function =>
         Next_Node := STree.Child_Node (Current_Node => Node);
         -- ASSUME Next_Node = named_argument_association            OR positional_argument_association OR
         --                    annotation_named_argument_association OR annotation_positional_argument_association
         if STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.positional_argument_association
           or else STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.annotation_positional_argument_association then
            -- ASSUME Next_Node = positional_argument_association OR annotation_positional_argument_association
            if Type_Info.Param_Count = Dictionary.GetNumberOfSubprogramParameters (Sym) then
               Type_Info.Sort := Sem.Is_Object;
            else
               Type_Info := Unknown_Symbol_Record;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 3,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Node),
                  Id_Str    => Dictionary.GetSimpleName (Sym));
            end if;
         elsif STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.named_argument_association
           or else STree.Syntax_Node_Type (Node => Next_Node) = SP_Symbols.annotation_named_argument_association then
            -- ASSUME Next_Node = named_argument_association OR annotation_named_argument_association
            Check_Names_Are_All_There
              (Node_Pos   => STree.Node_Position (Node => Node),
               Fun_Sym    => Sym,
               List       => Type_Info.Param_List,
               Heap_Param => Heap_Param,
               All_There  => All_Found);
            Ptr := Type_Info.Param_List;
            Dispose_Of_Name_List (List       => Ptr,
                                  Heap_Param => Heap_Param);
            Type_Info.Param_List := Ptr;
            if All_Found then
               Type_Info.Sort := Sem.Is_Object;
            else
               Type_Info := Unknown_Symbol_Record;
            end if;
         else
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Next_Node = named_argument_association OR positional_argument_association OR " &
                 "annotation_named_argument_association OR annotation_positional_argument_association in " &
                 "Up_Wf_Name_Argument_List");
         end if;
      when Sem.Is_Object =>
         if Type_Info.Param_Count = Dictionary.GetNumberOfDimensions (Type_Info.Type_Symbol) then
            Type_Info.Type_Symbol := Dictionary.GetArrayComponent (Type_Info.Type_Symbol);
            if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.name_argument_list then
               Type_Info.Is_An_Entire_Variable := False;
            end if;
            Type_Info.Is_Constant := False;
         else
            Type_Info := Unknown_Symbol_Record;
            ErrorHandler.Semantic_Error
              (Err_Num   => 93,
               Reference => ErrorHandler.No_Reference,
               Position  => STree.Node_Position (Node => Node),
               Id_Str    => Dictionary.GetSimpleName (Sym));
         end if;
      when Sem.Type_Result =>
         -- Must be a type conversion expression.

         -- If the type is scalar, and the argument is static, then
         -- we can do a ConstraintCheck here in SPARK95 or 2005 modes.
         -- Type conversions are never considered static in SPARK83,
         -- so we've no business checking them here in SPARK83 mode.
         if CommandLineData.Content.Language_Profile /= CommandLineData.SPARK83
           and then Type_Info.Is_Static
           and then Dictionary.TypeIsScalar (Type_Info.Type_Symbol) then
            --# accept F, 10, Unused_Value, "Unused_Value not needed here.";
            Sem.Constraint_Check
              (Val           => Type_Info.Value,
               New_Val       => Unused_Value,
               Is_Annotation => STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_name_argument_list,
               Typ           => Type_Info.Type_Symbol,
               Position      => STree.Node_Position (Node => Node));
            --# end accept;
         end if;
      when others =>
         null;
   end case;
   Exp_Stack.Push (X     => Type_Info,
                   Stack => E_Stack);
   --# accept F, 33, Unused_Value, "Unused_Value not needed here.";
end Up_Wf_Name_Argument_List;
