-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

with SLI;

separate (Sem.Walk_Expression_P)
procedure Wf_Selected_Component
  (Node           : in     STree.SyntaxNode;
   Scope          : in     Dictionary.Scopes;
   Ref_Var        : in     SeqAlgebra.Seq;
   E_Stack        : in out Exp_Stack.Exp_Stack_Type;
   Component_Data : in out ComponentManager.ComponentData;
   The_Heap       : in out Heap.HeapRecord;
   Context        : in     Sem.Tilde_Context)
is
   Sym                  : Dictionary.Symbol;
   Sym2                 : Dictionary.Symbol;
   Selector_Node        : STree.SyntaxNode;
   Selector             : LexTokenManager.Lex_String;
   Node_Pos, Select_Pos : LexTokenManager.Token_Position;
   Type_Info            : Sem.Exp_Record;
   Prefix_OK            : Boolean;
   Ident_Context        : Dictionary.Contexts;
begin
   Node_Pos := STree.Node_Position (Node => Node);
   if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_selected_component then
      -- in annotation
      Ident_Context := Dictionary.ProofContext;
   else
      Ident_Context := Dictionary.ProgramContext;
   end if;
   Selector_Node :=
     STree.Last_Child_Of (Start_Node => STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node)));
   -- ASSUME Selector_Node = identifier
   SystemErrors.RT_Assert
     (C       => STree.Syntax_Node_Type (Node => Selector_Node) = SP_Symbols.identifier,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Selector_Node = identifier in Wf_Selected_Component");
   Selector   := STree.Node_Lex_String (Node => Selector_Node);
   Select_Pos := STree.Node_Position (Node => Selector_Node);

   Exp_Stack.Pop (Item  => Type_Info,
                  Stack => E_Stack);
   case Type_Info.Sort is
      when Sem.Is_Unknown =>
         Type_Info.Errors_In_Expression := True;
         Exp_Stack.Push (X     => Type_Info,
                         Stack => E_Stack);
      when Sem.Is_Package =>
         Sem.Check_Package_Prefix (Node_Pos => Node_Pos,
                                   Pack_Sym => Type_Info.Other_Symbol,
                                   Scope    => Scope,
                                   OK       => Prefix_OK);
         if Prefix_OK then
            Sym :=
              Dictionary.LookupSelectedItem
              (Prefix   => Type_Info.Other_Symbol,
               Selector => Selector,
               Scope    => Scope,
               Context  => Ident_Context);

            -- Here, we do a special check to spot a common error in order to give a more
            -- informative error message.
            --
            -- If the user user has referred to an entity "P.F" which has already been
            -- renamed, then they should just refer to "F" and "P.F" is illegal.
            --
            -- To spot this, if P.F is not visible, we try again to look up "F" alone,
            -- and if it's visible AND is renamed, then we issue semantic error 419,
            -- which is much more helpful than the previously-issued semantic error 1.
            if Dictionary.Is_Null_Symbol (Sym) then
               Sym2 :=
                 Dictionary.LookupItem (Name              => Selector,
                                        Scope             => Scope,
                                        Context           => Ident_Context,
                                        Full_Package_Name => False);
               if not Dictionary.Is_Null_Symbol (Sym2)
                 and then Dictionary.Is_Subprogram (Sym2)
                 and then not Dictionary.IsImplicitProofFunction (Sym2)
                 and then Dictionary.Is_Renamed (Subprogram => Sym2,
                                                 Scope      => Scope) then
                  ErrorHandler.Semantic_Error2
                    (Err_Num   => 419,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Pos,
                     Id_Str1   => Selector,
                     Id_Str2   => Dictionary.GetSimpleName (Type_Info.Other_Symbol));
                  -- Define Sym as Sym2 here to prevent a second knock-on error in StackIdentifier below
                  Sym := Sym2;
               end if;
            end if;
            if Sym = Type_Info.Other_Symbol then
               -- found P in P such as P.P.P.X when P.X is intended
               Sym := Dictionary.NullSymbol;
            end if;
            if not Dictionary.Is_Null_Symbol (Sym) then
               STree.Set_Node_Lex_String (Sym  => Sym,
                                          Node => Selector_Node);
               if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_selected_component
                 and then ErrorHandler.Generate_SLI then
                  -- in annotation
                  SLI.Generate_Xref_Symbol
                    (Comp_Unit      => ContextManager.Ops.Current_Unit,
                     Parse_Tree     => Selector_Node,
                     Symbol         => Sym,
                     Is_Declaration => False);
               end if;
            end if;
            Stack_Identifier
              (Sym           => Sym,
               Id_Str        => Selector,
               Node          => Node,
               Prefix        => Type_Info.Other_Symbol,
               Scope         => Scope,
               E_Stack       => E_Stack,
               The_Heap      => The_Heap,
               Ref_Var       => Ref_Var,
               Dotted        => True,
               Context       => Context,
               Is_Annotation => STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_selected_component);
         else
            Exp_Stack.Push (X     => Unknown_Symbol_Record,
                            Stack => E_Stack);
         end if;
      when Sem.Is_Object =>
         if Dictionary.IsRecordTypeMark (Type_Info.Type_Symbol, Scope) then
            -- Type_Info.TypeSymbol here might denote a record subtype,
            -- so find the root type before looking for the selector.
            Type_Info.Type_Symbol := Dictionary.GetRootType (Type_Info.Type_Symbol);

            if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_selected_component then
               -- in annotation
               Sym :=
                 Dictionary.LookupSelectedItem
                 (Prefix   => Type_Info.Type_Symbol,
                  Selector => Selector,
                  Scope    => Scope,
                  Context  => Dictionary.ProofContext);
            else -- not in annotation
               if Type_Info.Arg_List_Found
                 or else Dictionary.Is_Constant (Type_Info.Other_Symbol)
                 or else Dictionary.IsFunction (Type_Info.Other_Symbol) then
                  -- do not collect any component entities
                  Sym :=
                    Dictionary.LookupSelectedItem
                    (Prefix   => Type_Info.Type_Symbol,
                     Selector => Selector,
                     Scope    => Scope,
                     Context  => Dictionary.ProgramContext);
               else
                  -- do collect component entities
                  if not ComponentManager.HasChildren
                    (Component_Data,
                     ComponentManager.GetComponentNode (Component_Data, Type_Info.Other_Symbol)) then
                     -- add allchildren of the prefix to the component mananger
                     -- and declare subcomponents for each in the dictionary
                     Sem.Add_Record_Sub_Components
                       (Record_Var_Sym  => Type_Info.Other_Symbol,
                        Record_Type_Sym => Type_Info.Type_Symbol,
                        Component_Data  => Component_Data,
                        The_Heap        => The_Heap);
                  end if;
                  -- subcomponent symbol must be in Dictionary here
                  Sym                    :=
                    Dictionary.LookupSelectedItem
                    (Prefix   => Type_Info.Other_Symbol,
                     Selector => Selector,
                     Scope    => Scope,
                     Context  => Dictionary.ProgramContext);
                  Type_Info.Other_Symbol := Sym;
               end if;
            end if;

            -- If Sym is found, but it's NOT a record component (e.g. it
            -- denotes the name of a type or something), then something
            -- is very wrong.
            if not Dictionary.Is_Null_Symbol (Sym) and then Dictionary.IsRecordComponent (Sym) then
               STree.Set_Node_Lex_String (Sym  => Sym,
                                          Node => Selector_Node);
               Type_Info.Type_Symbol := Dictionary.GetType (Sym);
               if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.selected_component then
                  -- not in annotation
                  Type_Info.Is_An_Entire_Variable := False;
               elsif ErrorHandler.Generate_SLI then
                  SLI.Generate_Xref_Symbol
                    (Comp_Unit      => ContextManager.Ops.Current_Unit,
                     Parse_Tree     => Selector_Node,
                     Symbol         => Sym,
                     Is_Declaration => False);
               end if;
               Type_Info.Is_Constant := False;
               Exp_Stack.Push (X     => Type_Info,
                               Stack => E_Stack);
            else
               Exp_Stack.Push (X     => Unknown_Symbol_Record,
                               Stack => E_Stack);
               ErrorHandler.Semantic_Error
                 (Err_Num   => 8,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Select_Pos,
                  Id_Str    => Selector);
            end if;
         elsif Dictionary.IsProtectedType (Dictionary.GetRootType (Type_Info.Type_Symbol)) then
            -- handle protected function call
            Sym :=
              Dictionary.LookupSelectedItem
              (Prefix   => Type_Info.Other_Symbol,
               Selector => Selector,
               Scope    => Scope,
               Context  => Ident_Context);
            if not Dictionary.Is_Null_Symbol (Sym) then
               STree.Set_Node_Lex_String (Sym  => Sym,
                                          Node => Selector_Node);
               if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_selected_component
                 and then ErrorHandler.Generate_SLI then
                  -- in annotation
                  SLI.Generate_Xref_Symbol
                    (Comp_Unit      => ContextManager.Ops.Current_Unit,
                     Parse_Tree     => Selector_Node,
                     Symbol         => Sym,
                     Is_Declaration => False);
               end if;
            end if;
            Stack_Identifier
              (Sym           => Sym,
               Id_Str        => Selector,
               Node          => Node,
               Prefix        => Type_Info.Other_Symbol,
               Scope         => Scope,
               E_Stack       => E_Stack,
               The_Heap      => The_Heap,
               Ref_Var       => Ref_Var,
               Dotted        => False,
               Context       => Context,
               Is_Annotation => STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_selected_component);
         else
            Exp_Stack.Push (X     => Unknown_Symbol_Record,
                            Stack => E_Stack);

            if Dictionary.IsPrivateType (Type_Info.Type_Symbol, Scope) then
               ErrorHandler.Semantic_Error_Sym2
                 (Err_Num   => 316,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Pos,
                  Sym       => Type_Info.Other_Symbol,
                  Sym2      => Type_Info.Type_Symbol,
                  Scope     => Scope);
            else
               ErrorHandler.Semantic_Error
                 (Err_Num   => 9,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Pos,
                  Id_Str    => Dictionary.GetSimpleName (Type_Info.Other_Symbol));
            end if;
         end if;
      when Sem.Is_Function =>
         Exp_Stack.Push (X     => Unknown_Symbol_Record,
                         Stack => E_Stack);
         ErrorHandler.Semantic_Error
           (Err_Num   => 3,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Pos,
            Id_Str    => Dictionary.GetSimpleName (Type_Info.Other_Symbol));
      when others =>
         Exp_Stack.Push (X     => Unknown_Symbol_Record,
                         Stack => E_Stack);
         ErrorHandler.Semantic_Error
           (Err_Num   => 5,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Pos,
            Id_Str    => Dictionary.GetSimpleName (Type_Info.Other_Symbol));
   end case;

   if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_selected_component then
      -- in annotation
      Selector_Node := STree.Next_Sibling (Current_Node => Selector_Node);
      -- ASSUME Selector_Node = tilde OR percent OR NULL
      if Selector_Node /= STree.NullNode then
         -- ASSUME Selector_Node = tilde OR percent
         -- handle ~ or % operator
         case STree.Syntax_Node_Type (Node => Selector_Node) is
            when SP_Symbols.tilde =>
               -- ASSUME Selector_Node = tilde
               Wf_Tilde
                 (Node_Pos => STree.Node_Position (Node => Selector_Node),
                  Scope    => Scope,
                  E_Stack  => E_Stack,
                  Context  => Context);
            when SP_Symbols.percent =>
               -- ASSUME Selector_Node = percent
               Wf_Percent (Node_Pos => STree.Node_Position (Node => Selector_Node),
                           Scope    => Scope,
                           E_Stack  => E_Stack);
            when others =>
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect Selector_Node = tilde OR percent OR NULL in Wf_Selected_Component");
         end case;
      end if;
   end if;
end Wf_Selected_Component;
