-------------------------------------------------------------------------------
-- (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_Record_Component_Selector_Name
  (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_Info : Sem.Exp_Record;
   Field_Ident          : LexTokenManager.Lex_String;
   Field_Symbol         : Dictionary.Symbol;
   Already_Present      : Boolean;
   Ident_Node           : STree.SyntaxNode;

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

   procedure Check_Valid_Field
     (Aggregate_Type : in     Dictionary.Symbol;
      Ancestor_Type  : in     Dictionary.Symbol;
      Ident_Node     : in     STree.SyntaxNode;
      Scope          : in     Dictionary.Scopes;
      Field_Symbol   :    out Dictionary.Symbol)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --#        in out STree.Table;
   --# derives ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from Aggregate_Type,
   --#                                         Ancestor_Type,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Ident_Node,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table &
   --#         Field_Symbol               from Aggregate_Type,
   --#                                         Ancestor_Type,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         Ident_Node,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         STree.Table &
   --#         STree.Table                from *,
   --#                                         Aggregate_Type,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         Ident_Node,
   --#                                         LexTokenManager.State,
   --#                                         Scope;
   --# pre STree.Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;
   --# post STree.Table = STree.Table~;
   is
      Aggregate_Field_Sym, Ancestor_Field_Sym : Dictionary.Symbol;
      Field_Str                               : LexTokenManager.Lex_String;
   begin
      Field_Str           := STree.Node_Lex_String (Node => Ident_Node);
      Aggregate_Field_Sym :=
        Dictionary.LookupSelectedItem
        (Prefix   => Aggregate_Type,
         Selector => Field_Str,
         Scope    => Scope,
         Context  => Dictionary.ProgramContext);
      if Dictionary.Is_Null_Symbol (Aggregate_Field_Sym) then -- no such field
         ErrorHandler.Semantic_Error
           (Err_Num   => 8,
            Reference => ErrorHandler.No_Reference,
            Position  => STree.Node_Position (Node => Ident_Node),
            Id_Str    => Field_Str);
         Field_Symbol := Dictionary.NullSymbol;
      else
         STree.Set_Node_Lex_String (Sym  => Aggregate_Field_Sym,
                                    Node => Ident_Node);
         -- field found, but we need to check that it is not in the ancestor part
         Ancestor_Field_Sym :=
           Dictionary.LookupSelectedItem
           (Prefix   => Ancestor_Type,
            Selector => Field_Str,
            Scope    => Scope,
            Context  => Dictionary.ProgramContext);
         if Dictionary.Is_Null_Symbol (Ancestor_Field_Sym) then
            -- not in ancestor part
            Field_Symbol := Aggregate_Field_Sym;
         else
            -- it is in the ancestor part
            ErrorHandler.Semantic_Error
              (Err_Num   => 865,
               Reference => ErrorHandler.No_Reference,
               Position  => STree.Node_Position (Node => Ident_Node),
               Id_Str    => Field_Str);
            Field_Symbol := Dictionary.NullSymbol;
         end if;
      end if;
   end Check_Valid_Field;

begin -- Wf_Record_Component_Selector_Name
   Exp_Stack.Pop (Item  => Name_Exp,
                  Stack => E_Stack);
   Ident_Node := STree.Child_Node (Current_Node => Node);
   -- 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 Node = identifier in Wf_Record_Component_Selector_Name");
   Field_Ident := STree.Node_Lex_String (Node => Ident_Node);

   Check_Valid_Field
     (Aggregate_Type => Name_Exp.Type_Symbol,
      Ancestor_Type  => Name_Exp.Other_Symbol,
      Ident_Node     => Ident_Node,
      Scope          => Scope,
      Field_Symbol   => Field_Symbol);
   if Dictionary.Is_Null_Symbol (Field_Symbol) then
      -- look up failed so push a null record as a placeholder
      Exp_Stack.Push (X     => Name_Exp,
                      Stack => E_Stack);
      Exp_Stack.Push (X     => Null_Parameter_Record,
                      Stack => E_Stack);
   else
      -- valid field name
      Add_Name (Name       => Field_Ident,
                List       => Name_Exp.Param_List,
                Heap_Param => Heap_Param,
                Present    => Already_Present);
      if Already_Present then
         Exp_Stack.Push (X     => Name_Exp,
                         Stack => E_Stack);
         Exp_Stack.Push (X     => Null_Parameter_Record,
                         Stack => E_Stack);
         ErrorHandler.Semantic_Error
           (Err_Num   => 103,
            Reference => ErrorHandler.No_Reference,
            Position  => STree.Node_Position (Node => Ident_Node),
            Id_Str    => Field_Ident);
      else -- no value thus far assigned
         Field_Info              := Null_Parameter_Record;
         Field_Info.Other_Symbol := Field_Symbol;
         Exp_Stack.Push (X     => Name_Exp,
                         Stack => E_Stack);
         Exp_Stack.Push (X     => Field_Info,
                         Stack => E_Stack);
      end if;
   end if;
end Wf_Record_Component_Selector_Name;
