-------------------------------------------------------------------------------
-- (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)
procedure Check_Named_Association
  (The_Formals               : in Dictionary.Symbol;
   Scope                     : in Dictionary.Scopes;
   Named_Argument_Assoc_Node : in STree.SyntaxNode)
is

   type Iterator is record
      Base_It   : STree.Iterator;
      Search_It : STree.Iterator;
      Dict_It   : Dictionary.Iterator;
   end record;

   Null_Iterator : constant Iterator :=
     Iterator'(Base_It   => STree.NullIterator,
               Search_It => STree.NullIterator,
               Dict_It   => Dictionary.NullIterator);

   It : Iterator;

   function Is_Null (It : Iterator) return Boolean
   --# return It = Null_Iterator;
   is
   begin
      return It = Null_Iterator;
   end Is_Null;

   ---------------------------------------------------------------
   -- Gets the first formal parameter for this dictionary entity
   ---------------------------------------------------------------

   function First_Formal (Sym : Dictionary.Symbol) return Dictionary.Iterator
   --# global in Dictionary.Dict;
   is
      Result : Dictionary.Iterator;
   begin
      if Dictionary.Is_Generic_Subprogram (The_Symbol => Sym) then
         -- It's a generic unit.
         Result := Dictionary.FirstGenericFormalParameter (Sym);
      elsif Dictionary.Is_Subprogram (Sym) then
         -- It's a subprogram.
         Result := Dictionary.FirstSubprogramParameter (Sym);
      else
         -- It's a task or protected type.
         Result := Dictionary.FirstKnownDiscriminant (Sym);
      end if;
      return Result;
   end First_Formal;

   ---------------------------------------------------------------
   -- Find duplicate formal parameters
   ---------------------------------------------------------------

   function Next_Duplicate_Formal (It : Iterator) return Iterator
   --# global in LexTokenManager.State;
   --#        in STree.Table;
   --# pre Syntax_Node_Type (Get_Node (It.Base_It), STree.Table) = SP_Symbols.identifier and
   --#   (Syntax_Node_Type (Get_Node (It.Search_It), STree.Table) = SP_Symbols.identifier or
   --#      It.Search_It = STree.NullIterator);
   --# return Return_It => ((Syntax_Node_Type (Get_Node (Return_It.Base_It), STree.Table) = SP_Symbols.identifier and
   --#                         Syntax_Node_Type (Get_Node (Return_It.Search_It), STree.Table) = SP_Symbols.identifier) or
   --#                        Return_It = Null_Iterator);
   is
      My_Base_It     : STree.Iterator;
      My_Search_It   : STree.Iterator;
      My_Base_Node   : STree.SyntaxNode;
      My_Search_Node : STree.SyntaxNode;
      Result         : Iterator;
   begin
      if STree.IsNull (It.Search_It) then
         -- We've not found a duplicate yet
         -- So our base is the first formal parameter
         My_Base_It := It.Base_It;
      else
         -- We've found one duplicate and are looking for another.
         -- So our base is the next formal parameter
         My_Base_It := STree.NextNode (It.Base_It);
      end if;

      My_Search_It := STree.NullIterator;

      while not STree.IsNull (My_Base_It) loop
         My_Base_Node := Get_Node (It => My_Base_It);
         --# assert Syntax_Node_Type (My_Base_Node, STree.Table) = SP_Symbols.identifier and
         --#   My_Base_Node = Get_Node (My_Base_It) and
         --#   (Syntax_Node_Type (Get_Node (My_Search_It), STree.Table) = SP_Symbols.identifier or
         --#      My_Search_It = STree.NullIterator);
         My_Search_It := STree.NextNode (My_Base_It);
         while not STree.IsNull (My_Search_It) loop
            My_Search_Node := Get_Node (It => My_Search_It);
            --# assert Syntax_Node_Type (My_Base_Node, STree.Table) = SP_Symbols.identifier and
            --#   My_Base_Node = Get_Node (My_Base_It) and
            --#   Syntax_Node_Type (My_Search_Node, STree.Table) = SP_Symbols.identifier and
            --#   My_Search_Node = Get_Node (My_Search_It);
            -- exit if the identifiers hanging off the base and dup nodes
            -- are the same. i.e. we've found a duplicate.
            exit when LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Node_Lex_String (Node => My_Base_Node),
               Lex_Str2 => Node_Lex_String (Node => My_Search_Node)) =
              LexTokenManager.Str_Eq;
            My_Search_It := STree.NextNode (My_Search_It);
         end loop;
         -- We found a duplicate
         exit when not STree.IsNull (My_Search_It);
         My_Base_It := STree.NextNode (My_Base_It);
      end loop;

      if STree.IsNull (My_Search_It) then
         -- We didn't find a duplicate
         Result := Null_Iterator;
      else
         Result := Iterator'(Base_It   => My_Base_It,
                             Search_It => My_Search_It,
                             Dict_It   => Dictionary.NullIterator);
      end if;
      return Result;
   end Next_Duplicate_Formal;

   function First_Duplicate_Formal (Node : STree.SyntaxNode) return Iterator
   --# global in LexTokenManager.State;
   --#        in STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.named_argument_association;
   --# return Return_It => ((Syntax_Node_Type (Get_Node (Return_It.Base_It), STree.Table) = SP_Symbols.identifier and
   --#                         Syntax_Node_Type (Get_Node (Return_It.Search_It), STree.Table) = SP_Symbols.identifier) or
   --#                        Return_It = Null_Iterator);
   is
      First_It : STree.Iterator;
   begin
      First_It := STree.Find_First_Formal_Parameter_Node (From_Root => Node);
      return Next_Duplicate_Formal
        (It => Iterator'(Base_It   => First_It,
                         Search_It => STree.NullIterator,
                         Dict_It   => Dictionary.NullIterator));
   end First_Duplicate_Formal;

   ---------------------------------------------------------------
   -- Find illegal formal parameters
   ---------------------------------------------------------------

   function Next_Illegal_Formal (It          : Iterator;
                                 The_Formals : Dictionary.Symbol) return Iterator
   --# global in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --#        in STree.Table;
   --# pre Syntax_Node_Type (Get_Node (It.Base_It), STree.Table) = SP_Symbols.identifier and
   --#   (Syntax_Node_Type (Get_Node (It.Search_It), STree.Table) = SP_Symbols.identifier or
   --#      It.Search_It = STree.NullIterator);
   --# return Return_It => ((Syntax_Node_Type (Get_Node (Return_It.Base_It), STree.Table) = SP_Symbols.identifier and
   --#                         Syntax_Node_Type (Get_Node (Return_It.Search_It), STree.Table) = SP_Symbols.identifier) or
   --#                        Return_It = Null_Iterator);
   is
      My_Base_It   : STree.Iterator;
      My_Base_Node : STree.SyntaxNode;
      My_Dict_It   : Dictionary.Iterator;
      Result       : Iterator;
   begin
      if STree.IsNull (It.Search_It) then
         -- We've not found an illegal name
         -- So our base is the first formal parameter
         My_Base_It := It.Base_It;
      else
         -- We've found one illegal and are looking for another.
         -- So our base is the next formal parameter.
         My_Base_It := STree.NextNode (It.Base_It);
      end if;

      while not STree.IsNull (My_Base_It) loop
         My_Base_Node := Get_Node (It => My_Base_It);
         --# assert Syntax_Node_Type (My_Base_Node, STree.Table) = SP_Symbols.identifier and
         --#   My_Base_Node = Get_Node (My_Base_It);
         My_Dict_It := First_Formal (Sym => The_Formals);
         -- Loop through all the formals declared in the type
         while not Dictionary.IsNullIterator (My_Dict_It) loop
            --# assert Syntax_Node_Type (My_Base_Node, STree.Table) = SP_Symbols.identifier and
            --#   My_Base_Node = Get_Node (My_Base_It);
            -- Looking for a formal to match the one in the tree
            exit when LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Dictionary.GetSimpleName (Dictionary.CurrentSymbol (My_Dict_It)),
               Lex_Str2 => Node_Lex_String (Node => My_Base_Node)) =
              LexTokenManager.Str_Eq;
            My_Dict_It := Dictionary.NextSymbol (My_Dict_It);
         end loop;
         -- My_Dict_It is null if we didn't find it.
         exit when Dictionary.IsNullIterator (My_Dict_It);
         My_Base_It := STree.NextNode (My_Base_It);
      end loop;

      if STree.IsNull (My_Base_It) then
         -- We didn't find any more illegal formals
         Result := Null_Iterator;
      else
         Result := Iterator'(Base_It   => My_Base_It,
                             Search_It => My_Base_It,
                             Dict_It   => Dictionary.NullIterator);
      end if;
      return Result;
   end Next_Illegal_Formal;

   function First_Illegal_Formal (Node        : STree.SyntaxNode;
                                  The_Formals : Dictionary.Symbol) return Iterator
   --# global in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --#        in STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.named_argument_association;
   --# return Return_It => ((Syntax_Node_Type (Get_Node (Return_It.Base_It), STree.Table) = SP_Symbols.identifier and
   --#                         Syntax_Node_Type (Get_Node (Return_It.Search_It), STree.Table) = SP_Symbols.identifier) or
   --#                        Return_It = Null_Iterator);
   is
      First_It : STree.Iterator;
   begin
      First_It := STree.Find_First_Formal_Parameter_Node (From_Root => Node);
      return Next_Illegal_Formal
        (It          => Iterator'(Base_It   => First_It,
                                  Search_It => STree.NullIterator,
                                  Dict_It   => Dictionary.NullIterator),
         The_Formals => The_Formals);
   end First_Illegal_Formal;

   ---------------------------------------------------------------
   -- Find missing formal parameters
   ---------------------------------------------------------------

   function Next_Missing_Formal
     (It                        : Iterator;
      The_Formals               : Dictionary.Symbol;
      Named_Argument_Assoc_Node : STree.SyntaxNode)
     return                      Iterator
   --# global in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --#        in STree.Table;
   --# pre Syntax_Node_Type (Named_Argument_Assoc_Node, STree.Table) = SP_Symbols.named_argument_association;
   is
      My_Base_It   : STree.Iterator;
      My_Base_Node : STree.SyntaxNode;
      My_Dict_It   : Dictionary.Iterator;
      Result       : Iterator;
   begin
      if Dictionary.IsNullIterator (It.Dict_It) then
         -- We've not found a missing formal yet
         -- So our base is the first formal
         My_Dict_It := First_Formal (Sym => The_Formals);
      else
         -- We've found one missing and are looking for another.
         -- So our base is the next formal parameter
         My_Dict_It := Dictionary.NextSymbol (It.Dict_It);
      end if;

      while not Dictionary.IsNullIterator (My_Dict_It) loop
         My_Base_It := STree.Find_First_Formal_Parameter_Node (From_Root => Named_Argument_Assoc_Node);
         -- Loop through all the formals
         while not STree.IsNull (My_Base_It) loop
            My_Base_Node := Get_Node (It => My_Base_It);
            --# assert Syntax_Node_Type (Get_Node (My_Base_It), STree.Table) = SP_Symbols.identifier and
            --#   My_Base_Node = Get_Node (My_Base_It);
            -- Looking for a formal to match the one in the tree
            exit when LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Dictionary.GetSimpleName (Dictionary.CurrentSymbol (My_Dict_It)),
               Lex_Str2 => Node_Lex_String (Node => My_Base_Node)) =
              LexTokenManager.Str_Eq;
            My_Base_It := STree.NextNode (My_Base_It);
         end loop;
         -- My_Base_It is null if we didn't find it.
         exit when STree.IsNull (My_Base_It);
         My_Dict_It := Dictionary.NextSymbol (My_Dict_It);
      end loop;

      if Dictionary.IsNullIterator (My_Dict_It) then
         Result := Null_Iterator;
      else
         Result := Iterator'(Base_It   => STree.NullIterator,
                             Search_It => STree.NullIterator,
                             Dict_It   => My_Dict_It);
      end if;
      return Result;
   end Next_Missing_Formal;

   function First_Missing_Formal (The_Formals               : Dictionary.Symbol;
                                  Named_Argument_Assoc_Node : STree.SyntaxNode) return Iterator
   --# global in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --#        in STree.Table;
   --# pre Syntax_Node_Type (Named_Argument_Assoc_Node, STree.Table) = SP_Symbols.named_argument_association;
   is
   begin
      return Next_Missing_Formal
        (It                        => Iterator'(Base_It => STree.NullIterator, Search_It => STree.NullIterator, Dict_It => Dictionary.NullIterator),
         The_Formals               => The_Formals,
         Named_Argument_Assoc_Node => Named_Argument_Assoc_Node);
   end First_Missing_Formal;

begin -- Check_Named_Association

   ------------------------------------------
   -- Report all duplicated formal parameters
   ------------------------------------------

   It := First_Duplicate_Formal (Node => Named_Argument_Assoc_Node);
   while not Is_Null (It => It) loop
      --# assert Syntax_Node_Type (Get_Node (It.Base_It), STree.Table) = SP_Symbols.identifier and
      --#   Syntax_Node_Type (Get_Node (It.Search_It), STree.Table) = SP_Symbols.identifier;
      ErrorHandler.Semantic_Error
        (Err_Num   => 4,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Get_Node (It => It.Search_It)),
         Id_Str    => Node_Lex_String (Node => Get_Node (It => It.Search_It)));
      It := Next_Duplicate_Formal (It => It);
   end loop;

   ------------------------------------------
   -- Report all illegal formal parameters
   ------------------------------------------

   It := First_Illegal_Formal (Node        => Named_Argument_Assoc_Node,
                               The_Formals => The_Formals);
   while not Is_Null (It => It) loop
      --# assert Syntax_Node_Type (Get_Node (It.Base_It), STree.Table) = SP_Symbols.identifier and
      --#   Syntax_Node_Type (Get_Node (It.Search_It), STree.Table) = SP_Symbols.identifier;
      ErrorHandler.Semantic_Error_Lex1_Sym1
        (Err_Num   => 2,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Get_Node (It => It.Search_It)),
         Id_Str    => Node_Lex_String (Node => Get_Node (It => It.Search_It)),
         Sym       => The_Formals,
         Scope     => Scope);
      It := Next_Illegal_Formal (It          => It,
                                 The_Formals => The_Formals);
   end loop;

   ------------------------------------------
   -- Report all missing formal parameters
   ------------------------------------------

   It := First_Missing_Formal (The_Formals               => The_Formals,
                               Named_Argument_Assoc_Node => Named_Argument_Assoc_Node);
   while not Is_Null (It => It) loop
      ErrorHandler.Semantic_Error
        (Err_Num   => 23,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => STree.FindLastActualParameterNode (Named_Argument_Assoc_Node)),
         Id_Str    => Dictionary.GetSimpleName (Dictionary.CurrentSymbol (It.Dict_It)));
      It := Next_Missing_Formal (It                        => It,
                                 The_Formals               => The_Formals,
                                 Named_Argument_Assoc_Node => Named_Argument_Assoc_Node);
   end loop;

end Check_Named_Association;
