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

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

   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_record_component_association or
   --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_named_record_component_association;
   is
      Local_Node : STree.SyntaxNode;
   begin
      Local_Node := STree.Child_Node (Current_Node => Node);
      -- ASSUME Local_Node = named_record_component_association OR record_component_selector_name OR
      --                     annotation_named_record_component_association
      if STree.Syntax_Node_Type (Node => Local_Node) = SP_Symbols.named_record_component_association
        or else STree.Syntax_Node_Type (Node => Local_Node) = SP_Symbols.annotation_named_record_component_association then
         -- ASSUME Local_Node = named_record_component_association OR annotation_named_record_component_association
         Local_Node := STree.Next_Sibling (Current_Node => Local_Node);
      elsif STree.Syntax_Node_Type (Node => Local_Node) /= SP_Symbols.record_component_selector_name then
         Local_Node := STree.NullNode;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Local_Node = named_record_component_association OR record_component_selector_name OR " &
              "annotation_named_record_component_association in Expression_Location");
      end if;
      -- ASSUME Local_Node = record_component_selector_name
      SystemErrors.RT_Assert
        (C       => STree.Syntax_Node_Type (Node => Local_Node) = SP_Symbols.record_component_selector_name,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Local_Node = record_component_selector_name in Expression_Location");
      Local_Node := STree.Next_Sibling (Current_Node => Local_Node);
      -- ASSUME Local_Node = expression OR annotation_expression
      SystemErrors.RT_Assert
        (C       => STree.Syntax_Node_Type (Node => Local_Node) = SP_Symbols.expression
           or else STree.Syntax_Node_Type (Node => Local_Node) = SP_Symbols.annotation_expression,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Local_Node = expression OR annotation_expression in Expression_Location");
      return STree.Node_Position (Node => Local_Node);
   end Expression_Location;

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

   procedure Check_Record_Completeness
     (Node        : in     STree.SyntaxNode;
      Name_Exp    : in out Sem.Exp_Record;
      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_record_component_association or
   --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_named_record_component_association;
   is
      Field_Str                 : LexTokenManager.Lex_String;
      Error_Pos                 : LexTokenManager.Token_Position;
      Ptr                       : Lists.List;
      Other_Symbol, Type_Symbol : Natural;
   begin
      Error_Pos    := Expression_Location (Node => Node);
      Other_Symbol := Dictionary.GetNumberOfComponents (Name_Exp.Other_Symbol);
      Type_Symbol  := Dictionary.GetNumberOfComponents (Name_Exp.Type_Symbol);
      if Other_Symbol < Natural'Last and then Type_Symbol > Natural'First then
         for I in Positive range
           Other_Symbol + 1 .. -- ancestor field count
           Type_Symbol loop -- total field count
            Field_Str := Dictionary.GetSimpleName (Dictionary.GetRecordComponent (Name_Exp.Type_Symbol, I));
            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;
         end loop;
      end if;
      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_Record_Component_Association

   -- TOS is the result of walking an expression to be associated with a record field name
   -- 2nd TOS is the field name in a parameter record
   -- 3rd TOS is the aggregate type with the ancestor type in its OtherSymbol field

   Exp_Stack.Pop (Item  => Exp_Result,
                  Stack => E_Stack);
   Exp_Stack.Pop (Item  => Field_Name,
                  Stack => E_Stack);
   Exp_Stack.Pop (Item  => Name_Exp,
                  Stack => E_Stack);

   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    => 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;
      Next_Node            := STree.Next_Sibling (Current_Node => Node);
      -- ASSUME Next_Node = record_component_selector_name OR NULL
      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 (Node        => Node,
                                    Name_Exp    => Name_Exp,
                                    Heap_Param  => Heap_Param,
                                    Error_Found => Error_Found);
      elsif STree.Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.record_component_selector_name then
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Next_Node = record_component_selector_name OR NULL in Wf_Named_Record_Component_Association");
      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 Wf_Named_Record_Component_Association;
