-------------------------------------------------------------------------------
-- (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_Association_Rep
  (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
   Name_Exp, Field_Name, Exp_Result : Sem.Exp_Record;
   Doing_Record                     : Boolean;
   Expected_Type                    : Dictionary.Symbol;
   Error_Found                      : Boolean := False;
   Next_Node                        : STree.SyntaxNode;

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

   function Expression_Location (Node : STree.SyntaxNode) return STree.SyntaxNode
   --# global in STree.Table;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.named_association_rep or
   --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_named_association_rep;
   --# return Exp_Node => (STree.Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.aggregate or
   --#                       STree.Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.expression or
   --#                       STree.Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.annotation_aggregate or
   --#                       STree.Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.annotation_expression);
   is
      Exp_Node : STree.SyntaxNode;
   begin
      Exp_Node := STree.Child_Node (Current_Node => Node);
      -- ASSUME Exp_Node = named_association_rep            OR aggregate_choice_rep OR
      --                   annotation_named_association_rep OR annotation_aggregate_choice_rep
      if STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.named_association_rep
        or else STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.annotation_named_association_rep then
         -- ASSUME Exp_Node = named_association_rep OR annotation_named_association_rep
         Exp_Node := STree.Next_Sibling (Current_Node => Exp_Node);
      elsif STree.Syntax_Node_Type (Node => Exp_Node) /= SP_Symbols.aggregate_choice_rep
        and then STree.Syntax_Node_Type (Node => Exp_Node) /= SP_Symbols.annotation_aggregate_choice_rep then
         Exp_Node := STree.NullNode;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Exp_Node = named_association_rep OR aggregate_choice_rep OR " &
              "annotation_named_association_rep OR annotation_aggregate_choice_rep in Doing_Embedded_Aggregate");
      end if;
      -- ASSUME Exp_Node = aggregate_choice_rep OR annotation_aggregate_choice_rep
      SystemErrors.RT_Assert
        (C       => STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.aggregate_choice_rep
           or else STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.annotation_aggregate_choice_rep,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Exp_Node = aggregate_choice_rep OR annotation_aggregate_choice_rep in Doing_Embedded_Aggregate");
      Exp_Node := STree.Next_Sibling (Current_Node => Exp_Node);
      -- ASSUME Exp_Node = aggregate_or_expression OR annotation_aggregate_or_expression
      SystemErrors.RT_Assert
        (C       => STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.aggregate_or_expression
           or else STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.annotation_aggregate_or_expression,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Exp_Node = aggregate_or_expression OR annotation_aggregate_or_expression in Doing_Embedded_Aggregate");
      Exp_Node := STree.Child_Node (Current_Node => Exp_Node);
      -- ASSUME Exp_Node = aggregate            OR expression OR
      --                   annotation_aggregate OR annotation_expression
      SystemErrors.RT_Assert
        (C       => STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.aggregate
           or else STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.expression
           or else STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.annotation_aggregate
           or else STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.annotation_expression,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Exp_Node = aggregate OR expression OR " &
           "annotation_aggregate OR annotation_expression in Doing_Embedded_Aggregate");
      return Exp_Node;
   end Expression_Location;

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

   function Doing_Embedded_Aggregate (Node : STree.SyntaxNode) return Boolean
   --# global in STree.Table;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.named_association_rep or
   --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_named_association_rep;
   is
      Exp_Node : STree.SyntaxNode;
   begin
      Exp_Node := Expression_Location (Node => Node);
      --# check STree.Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.aggregate or
      --#   STree.Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.expression or
      --#   STree.Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.annotation_aggregate or
      --#   STree.Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.annotation_expression;
      return STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.aggregate
        or else STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.annotation_aggregate;
   end Doing_Embedded_Aggregate;

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

   procedure Check_Record_Completeness
     (Name_Exp    : in out Sem.Exp_Record;
      Node        : in     STree.SyntaxNode;
      Heap_Param  : in out Lists.List_Heap;
      Error_Found : in out Boolean)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     STree.Table;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --# derives ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Heap_Param,
   --#                                         LexTokenManager.State,
   --#                                         Name_Exp,
   --#                                         Node,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table &
   --#         Error_Found                from *,
   --#                                         Dictionary.Dict,
   --#                                         Heap_Param,
   --#                                         LexTokenManager.State,
   --#                                         Name_Exp &
   --#         Heap_Param                 from *,
   --#                                         LexTokenManager.State,
   --#                                         Name_Exp &
   --#         Name_Exp                   from *;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.named_association_rep or
   --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_named_association_rep;
   is
      It        : Dictionary.Iterator;
      Field_Str : LexTokenManager.Lex_String;
      Error_Pos : LexTokenManager.Token_Position;
      Ptr       : Lists.List;
   begin
      Error_Pos := STree.Node_Position (Node => Expression_Location (Node => Node));

      if Dictionary.TypeIsExtendedTagged (Name_Exp.Type_Symbol) then
         It := Dictionary.FirstExtendedRecordComponent (Name_Exp.Type_Symbol);
      else
         It := Dictionary.FirstRecordComponent (Name_Exp.Type_Symbol);
      end if;

      while not Dictionary.IsNullIterator (It) loop
         Field_Str := Dictionary.GetSimpleName (Dictionary.CurrentSymbol (It));
         if not Lists.Is_Member (Heap     => Heap_Param,
                                 The_List => Name_Exp.Param_List,
                                 Str      => Field_Str) then
            Error_Found := True;
            ErrorHandler.Semantic_Error
              (Err_Num   => 104,
               Reference => ErrorHandler.No_Reference,
               Position  => Error_Pos,
               Id_Str    => Field_Str);
         end if;
         It := Dictionary.NextSymbol (It);
      end loop;
      Ptr := Name_Exp.Param_List;
      Dispose_Of_Name_List (List       => Ptr,
                            Heap_Param => Heap_Param);
      Name_Exp.Param_List := Ptr;
   end Check_Record_Completeness;

begin -- Wf_Named_Association_Rep
   if not Doing_Embedded_Aggregate (Node => Node) then
      Exp_Stack.Pop (Item  => Exp_Result,
                     Stack => E_Stack);
      Exp_Stack.Pop (Item  => Name_Exp,
                     Stack => E_Stack);
      if Name_Exp.Sort = Sem.Is_Parameter_Name then
         Doing_Record := True;
         Field_Name   := Name_Exp;
         Exp_Stack.Pop (Item  => Name_Exp,
                        Stack => E_Stack);
      else
         Doing_Record := False;
         Field_Name   := Sem.Unknown_Type_Record; -- actually ineffective but removes spurious errs
      end if;

      if Dictionary.IsUnknownTypeMark (Name_Exp.Type_Symbol) then
         -- all we have been doing in this case is checking internal
         -- consistency of expression.  We can't actually do anything
         -- with the result because the aggregate type is unknown.
         null;
      else -- we are dealing with an array or record
         if Doing_Record then
            if not Dictionary.Is_Null_Symbol (Field_Name.Other_Symbol) then
               Expected_Type := Dictionary.GetType (Field_Name.Other_Symbol);
               STree.Add_Node_Symbol (Node => Node,
                                      Sym  => Expected_Type);
               Sem.Assignment_Check
                 (Position    => STree.Node_Position (Node => Expression_Location (Node => Node)),
                  Scope       => Scope,
                  Target_Type => Expected_Type,
                  Exp_Result  => Exp_Result);
               Name_Exp.Is_Constant := Name_Exp.Is_Constant and then Exp_Result.Is_Constant;
            end if;
            Next_Node := STree.Next_Sibling (Current_Node => Node);
            -- ASSUME Next_Node = aggregate_or_expression            OR aggregate_choice_rep OR NULL OR
            --                    annotation_aggregate_or_expression OR annotation_aggregate_choice_rep
            if Next_Node = STree.NullNode then
               -- ASSUME Next_Node = NULL
               -- this is the last named association so we need to check that
               -- all fields have been given a value
               Check_Record_Completeness
                 (Name_Exp    => Name_Exp,
                  Node        => Node,
                  Heap_Param  => Heap_Param,
                  Error_Found => Error_Found);
            elsif STree.Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.aggregate_or_expression
              and then STree.Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.aggregate_choice_rep
              and then STree.Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.annotation_aggregate_or_expression
              and then STree.Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.annotation_aggregate_choice_rep then
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect Next_Node = aggregate_or_expression OR aggregate_choice_rep OR NULL OR " &
                    "annotation_aggregate_or_expression OR annotation_aggregate_choice_rep " &
                    "in Wf_Named_Association_Rep");
            end if;
         else -- must be array
            Expected_Type := Dictionary.GetArrayComponent (Name_Exp.Type_Symbol);
            STree.Add_Node_Symbol (Node => Node,
                                   Sym  => Expected_Type);
            Sem.Assignment_Check
              (Position    => STree.Node_Position (Node => Expression_Location (Node => Node)),
               Scope       => Scope,
               Target_Type => Expected_Type,
               Exp_Result  => Exp_Result);
            Name_Exp.Is_Constant := Name_Exp.Is_Constant and then Exp_Result.Is_Constant;
         end if;
      end if;
      Name_Exp.Errors_In_Expression := Error_Found or else Name_Exp.Errors_In_Expression or else Exp_Result.Errors_In_Expression;
      Exp_Stack.Push (X     => Name_Exp,
                      Stack => E_Stack);
   end if;
end Wf_Named_Association_Rep;
