-------------------------------------------------------------------------------
-- (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 Wf_Named_Argument_Association
  (Node       : in     STree.SyntaxNode;
   Scope      : in     Dictionary.Scopes;
   E_Stack    : in out Exp_Stack.Exp_Stack_Type;
   Heap_Param : in out Lists.List_Heap)
is
   Exp_Result, Fun_Info                    : Sem.Exp_Record;
   Fun_Sym, Param_Sym                      : Dictionary.Symbol;
   Ident_Node                              : STree.SyntaxNode;
   Ident_Str                               : LexTokenManager.Lex_String;
   Already_Present, Name_Is_Parameter_Name : Boolean;
   Error_Found                             : Boolean := False;

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

   function Find_Identifier (Node : STree.SyntaxNode) return STree.SyntaxNode
   --# global in STree.Table;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.named_argument_association or
   --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_named_argument_association;
   --# return Return_Node => STree.Syntax_Node_Type (Return_Node, STree.Table) = SP_Symbols.identifier;
   is
      Ident_Node : STree.SyntaxNode;
   begin
      Ident_Node := STree.Child_Node (Current_Node => Node);
      -- ASSUME Ident_Node = annotation_named_argument_association OR annotation_simple_name OR
      --                     named_argument_association OR simple_name
      if STree.Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.simple_name
        or else STree.Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.annotation_simple_name then
         -- ASSUME Ident_Node = annotation_simple_name OR simple_name
         Ident_Node := STree.Child_Node (Current_Node => Ident_Node);
      elsif STree.Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.named_argument_association
        or else STree.Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.annotation_named_argument_association then
         -- ASSUME Ident_Node = named_argument_association OR annotation_named_argument_association
         Ident_Node := STree.Child_Node (Current_Node => STree.Next_Sibling (Current_Node => Ident_Node));
      else
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Ident_Node = annotation_named_argument_association OR annotation_simple_name OR " &
              "named_argument_association OR simple_name in Find_Identifier");
      end if;
      -- ASSUME Ident_Node = identifier
      SystemErrors.RT_Assert
        (C       => STree.Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.identifier,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Ident_Node = identifier in Find_Identifier");
      return Ident_Node;
   end Find_Identifier;

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

   function Expression_Location (Node : STree.SyntaxNode) return LexTokenManager.Token_Position
   --# global in STree.Table;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.named_argument_association or
   --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_named_argument_association;
   is
      Result : STree.SyntaxNode;
   begin
      Result := STree.Child_Node (Current_Node => Node);
      -- ASSUME Result = annotation_named_argument_association OR annotation_simple_name
      --                 named_argument_association OR simple_name
      if STree.Syntax_Node_Type (Node => Result) = SP_Symbols.simple_name
        or else STree.Syntax_Node_Type (Node => Result) = SP_Symbols.annotation_simple_name then
         -- ASSUME Result = annotation_simple_name OR simple_name
         Result := STree.Next_Sibling (Current_Node => Result);
      elsif STree.Syntax_Node_Type (Node => Result) = SP_Symbols.named_argument_association
        or else STree.Syntax_Node_Type (Node => Result) = SP_Symbols.annotation_named_argument_association then
         -- ASSUME Result = named_argument_association OR annotation_named_argument_association
         Result := STree.Next_Sibling (Current_Node => STree.Next_Sibling (Current_Node => Result));
      else
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Result = annotation_named_argument_association OR annotation_simple_name OR " &
              "named_argument_association OR simple_name in Expression_Location");
      end if;
      -- ASSUME Result = annotation_expression OR expression
      SystemErrors.RT_Assert
        (C       => STree.Syntax_Node_Type (Node => Result) = SP_Symbols.annotation_expression
           or else STree.Syntax_Node_Type (Node => Result) = SP_Symbols.expression,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Result = annotation_expression OR expression in Expression_Location");
      return STree.Node_Position (Node => Result);
   end Expression_Location;

begin -- Wf_Named_Argument_Association
   Exp_Stack.Pop (Item  => Exp_Result,
                  Stack => E_Stack);
   Exp_Stack.Pop (Item  => Fun_Info,
                  Stack => E_Stack);
   Fun_Sym := Fun_Info.Other_Symbol;

   Find_Named_Argument_Association_Parameter
     (Node                   => Node,
      Subprog_Sym            => Fun_Sym,
      Name_Is_Parameter_Name => Name_Is_Parameter_Name,
      Param_Sym              => Param_Sym);

   Ident_Node := Find_Identifier (Node => Node);
   Ident_Str  := STree.Node_Lex_String (Node => Ident_Node);

   if Name_Is_Parameter_Name then
      -- Seed syntax tree with expected type for run-time check;
      -- but, don't do this for instantiation of unchecked_conversion
      -- because we don't want any RTCs for association of those parameters
      -- (provided the function parameter subtype and actual subtype match)
      if not (Dictionary.IsAnUncheckedConversion (Fun_Sym)
                and then Dictionary.Types_Are_Equal
                (Left_Symbol        => Exp_Result.Type_Symbol,
                 Right_Symbol       => Dictionary.GetType (Param_Sym),
                 Full_Range_Subtype => False)) then
         STree.Add_Node_Symbol (Node => Node,
                                Sym  => Dictionary.GetType (Param_Sym));
      end if;

      -- There is a special case involving functions an stream variables.  We allow a stream
      -- variable to be a parameter to an Unchecked_Conversion but need to ensure that
      -- the function inherits the restrictions associated with referencing a stream
      -- (e.g. cannot be used in gernal expression).  We can do this here by checking
      -- the StreamSymbol of the parameter expression (there will only be one if we are
      -- talking about an unchecked conversion) and if it is non-null then setting the
      -- stream symbol of the function result record (now an object) to the function symbol.
      -- Note that this clause will only be executed for an unchecked conversion because
      -- a parameter which is a stream would hav ebeen rejected at wf_primary in all other
      -- cases
      if not Dictionary.Is_Null_Symbol (Exp_Result.Stream_Symbol) then
         Fun_Info.Stream_Symbol := Fun_Sym;
      end if;

      Add_Name (Name       => Ident_Str,
                List       => Fun_Info.Param_List,
                Heap_Param => Heap_Param,
                Present    => Already_Present);
      if Already_Present then
         Error_Found := True;
         ErrorHandler.Semantic_Error
           (Err_Num   => 4,
            Reference => ErrorHandler.No_Reference,
            Position  => STree.Node_Position (Node => Ident_Node),
            Id_Str    => Ident_Str);
      else -- not already present so do further checks
         Sem.Wf_Argument_Association
           (Node        => Node,
            Scope       => Scope,
            Param_Type  => Dictionary.GetType (Param_Sym),
            Position    => Expression_Location (Node => Node),
            Exp_Result  => Exp_Result,
            Fun_Info    => Fun_Info,
            Error_Found => Error_Found);
      end if;
   else
      Error_Found := True;
      ErrorHandler.Semantic_Error_Lex1_Sym1
        (Err_Num   => 2,
         Reference => ErrorHandler.No_Reference,
         Position  => STree.Node_Position (Node => Ident_Node),
         Id_Str    => Ident_Str,
         Sym       => Fun_Sym,
         Scope     => Scope);
   end if;
   Fun_Info.Errors_In_Expression := Error_Found or else Fun_Info.Errors_In_Expression or else Exp_Result.Errors_In_Expression;
   Exp_Stack.Push (X     => Fun_Info,
                   Stack => E_Stack);
end Wf_Named_Argument_Association;
