-------------------------------------------------------------------------------
-- (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_Primary
  (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)
is
   Type_Info     : Sem.Exp_Record;
   Sym           : Dictionary.Symbol;
   Child_Primary : STree.SyntaxNode;

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

   procedure Check_Readability (Sym      : in Dictionary.Symbol;
                                Node_Pos : in LexTokenManager.Token_Position)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        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,
   --#                                         LexTokenManager.State,
   --#                                         Node_Pos,
   --#                                         SPARK_IO.File_Sys,
   --#                                         Sym;
   is
      Enclosing_Sym : Dictionary.Symbol;
   begin
      Enclosing_Sym := Dictionary.GetMostEnclosingObject (Sym);
      if CommandLineData.Content.Language_Profile = CommandLineData.SPARK83
        and then Dictionary.IsSubprogramParameter (Enclosing_Sym)
        and then Dictionary.GetSubprogramParameterMode (Enclosing_Sym) = Dictionary.OutMode then
         ErrorHandler.Semantic_Error
           (Err_Num   => 171,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Pos,
            Id_Str    => Dictionary.GetSimpleName (Enclosing_Sym));
      end if;
   end Check_Readability;

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

   procedure Check_Invalid_Stream_Use
     (Primary_Node : in STree.SyntaxNode;
      Sym          : in Dictionary.Symbol;
      Scope        : in Dictionary.Scopes;
      E_Stack      : in Exp_Stack.Exp_Stack_Type)
   --# 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 CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         E_Stack,
   --#                                         LexTokenManager.State,
   --#                                         Primary_Node,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         Sym &
   --#         STree.Table                from *,
   --#                                         Dictionary.Dict,
   --#                                         E_Stack,
   --#                                         Primary_Node,
   --#                                         Scope,
   --#                                         Sym;
   --# pre (STree.Syntax_Node_Type (Primary_Node, STree.Table) = SP_Symbols.primary) and
   --#   (Dictionary.Is_Null_Symbol (Sym) or
   --#      Dictionary.IsFunction (Sym, Dictionary.Dict) or
   --#      Dictionary.IsOwnVariableOrConstituentWithMode (Sym, Dictionary.Dict));
   --# post STree.Table = STree.Table~;
   is
      Current_Node                                                                                : STree.SyntaxNode;
      Assignment_Or_Return, Parameter_To_Unchecked_Conversion, Constant_Declaration, Has_Branches : Boolean;
      Error_Number                                                                                : Natural := 0;
   begin
      if not Dictionary.Is_Null_Symbol (Sym) then -- a stream has been referenced

         -- now start search for illegal uses
         -- track up syntax tree until expression or simple_expression
         -- below arange is found
         Current_Node := Primary_Node;
         -- ASSUME Current_Node = primary
         loop
            --# assert STree.Table = STree.Table~;
            exit when (STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.expression)
              or else (STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.simple_expression
                         and then STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Current_Node)) =
                         SP_Symbols.arange);
            Current_Node := STree.Parent_Node (Current_Node => Current_Node);
         end loop;
         -- ASSUME Current_Node = expression OR simple_expression

         -- to be valid the expression node just found must be below an assignment or return
         Assignment_Or_Return := STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.expression
           and then (STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Current_Node)) =
                       SP_Symbols.return_statement
                       or else STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Current_Node)) =
                       SP_Symbols.assignment_statement);

         -- or, the single actual parameter to an instance of unchecked conversion.
         -- If the expression is below a name_argument_list then we see if there is a record representing the
         -- not-yet-complete invocation of an unchecked_conversion, thus:
         Parameter_To_Unchecked_Conversion :=
           STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.expression
           and then STree.Syntax_Node_Type
           (Node => STree.Parent_Node (Current_Node => STree.Parent_Node (Current_Node => Current_Node))) =
           SP_Symbols.name_argument_list
           and then not Exp_Stack.Is_Empty (Stack => E_Stack)
           and then Dictionary.IsAnUncheckedConversion (Exp_Stack.Top (Stack => E_Stack).Other_Symbol);

         Constant_Declaration := STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.expression
           and then STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Current_Node)) =
           SP_Symbols.constant_declaration;

         -- track back down tree to primary node checking for right branches which show
         -- some kind of expression which is not allowed in this context
         Has_Branches := False;
         loop
            --# assert STree.Table = STree.Table~;
            if STree.Next_Sibling (Current_Node => Current_Node) /= STree.NullNode then
               Has_Branches := True;
               exit;
            end if;
            exit when Current_Node = Primary_Node;
            Current_Node := STree.Child_Node (Current_Node => Current_Node);
         end loop;

         if Dictionary.IsPredefinedRealTimeClockOperation (Sym) then
            -- Special case for Ada.Real_Time.Clock.
            -- This function MUST be used
            -- 1. directly
            if Has_Branches
              -- 2. in a library level constant declaration.
              or else (Dictionary.IsLibraryLevel (Scope) and then not Constant_Declaration)
              -- 3. in an assignment or return statement..
              or else (not Dictionary.IsLibraryLevel (Scope) and then not Assignment_Or_Return) then
               Error_Number := 960;
            end if;
         elsif Has_Branches or else not (Assignment_Or_Return or else Parameter_To_Unchecked_Conversion) then
            -- illegal use of stream variable or function
            if Dictionary.IsFunction (Sym) then
               Error_Number := 715;
            else -- variable
               Error_Number := 716;
            end if;
         end if;
         if Error_Number = 0 then
            --  put symbol of stream into primary node of syntax tree for
            --  use by vcg-producevcs-buildgraph-modelassignmentstatement
            STree.Add_Node_Symbol (Node => Primary_Node,
                                   Sym  => Sym);
         else
            ErrorHandler.Semantic_Error_Sym
              (Err_Num   => Error_Number,
               Reference => ErrorHandler.No_Reference,
               Position  => STree.Node_Position (Node => Primary_Node),
               Sym       => Sym,
               Scope     => Scope);
         end if;
      end if;
   end Check_Invalid_Stream_Use;

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

   procedure Check_Invalid_Protected_Function_Use
     (Primary_Node : in STree.SyntaxNode;
      Sym          : in Dictionary.Symbol;
      Scope        : in Dictionary.Scopes)
   --# 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,
   --#                                         LexTokenManager.State,
   --#                                         Primary_Node,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         Sym;
   --# pre STree.Syntax_Node_Type (Primary_Node, STree.Table) = SP_Symbols.primary;
   is
      Current_Node                       : STree.SyntaxNode;
      Assignment_Or_Return, Has_Branches : Boolean;
   begin
      if not Dictionary.Is_Null_Symbol (Sym) then -- a protected state has been referenced

         -- track up syntax tree until expression found
         Current_Node := Primary_Node;
         -- ASSUME Current_Node = primary
         while STree.Syntax_Node_Type (Node => Current_Node) /= SP_Symbols.expression loop
            --# assert STree.Syntax_Node_Type (Current_Node, STree.Table) /= SP_Symbols.expression;
            Current_Node := STree.Parent_Node (Current_Node => Current_Node);
         end loop;
         -- ASSUME Current_Node = expression
         -- to be valid the expression node just found must be below an assignment or return
         Assignment_Or_Return :=
           STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Current_Node)) = SP_Symbols.return_statement
           or else STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Current_Node)) =
           SP_Symbols.assignment_statement;

         -- track back down tree to primary node checking for right branches which show
         -- some kind of expression which is not allowed in this context
         Has_Branches := False;
         loop
            if STree.Next_Sibling (Current_Node => Current_Node) /= STree.NullNode then
               Has_Branches := True;
               exit;
            end if;
            exit when Current_Node = Primary_Node;
            Current_Node := STree.Child_Node (Current_Node => Current_Node);
         end loop;

         if Has_Branches or else not Assignment_Or_Return then
            ErrorHandler.Semantic_Error_Sym
              (Err_Num   => 725,
               Reference => ErrorHandler.No_Reference,
               Position  => STree.Node_Position (Node => Primary_Node),
               Sym       => Sym,
               Scope     => Scope);
         end if;
      end if;
   end Check_Invalid_Protected_Function_Use;

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

   function Root_Wise_Conversion_Required
     (Node       : STree.SyntaxNode;
      Actual_Sym : Dictionary.Symbol;
      E_Stack    : Exp_Stack.Exp_Stack_Type)
     return       Boolean
   --# global in Dictionary.Dict;
   --#        in STree.Table;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.primary;
   is
      Result                : Boolean := False;
      Possible_Function_Sym : Dictionary.Symbol;
      Controlling_Type      : Dictionary.Symbol;

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

      function Is_Direct_Function_Parameter (Node : STree.SyntaxNode) return Boolean
      --# global in STree.Table;
      --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.primary;
      is
         Local_Node : STree.SyntaxNode;
         Result     : Boolean := False;

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

         function Valid_Positional_Argument (Node : STree.SyntaxNode) return Boolean
         --# global in STree.Table;
         --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.expression;
         is
         begin
            return STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Node)) =
              SP_Symbols.positional_argument_association;
         end Valid_Positional_Argument;

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

         function Valid_Named_Argument (Node : STree.SyntaxNode) return Boolean
         --# global in STree.Table;
         --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.expression;
         is
         begin
            return STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Node)) =
              SP_Symbols.named_argument_association;
         end Valid_Named_Argument;

      begin -- Is_Direct_Function_Parameter
         Local_Node := Node;
         loop
            -- Success case is when we find an expression which has an argument
            -- association above it.  In any case we don't continue looking once
            -- an expression has been found
            if STree.Syntax_Node_Type (Node => Local_Node) = SP_Symbols.expression then
               -- ASSUME Local_Node = expression
               Result := Valid_Positional_Argument (Node => Local_Node) or else Valid_Named_Argument (Node => Local_Node);
               exit;
            end if;

            -- failure condition: right branches exist showing that primary
            -- is part of an expresssion
            exit when STree.Next_Sibling (Current_Node => Local_Node) /= STree.NullNode;

            -- failure condition: we are part of a right branch showing that primary
            -- is part of an expresssion
            exit when STree.Next_Sibling
              (Current_Node => STree.Child_Node (Current_Node => STree.Parent_Node (Current_Node => Local_Node))) /=
              STree.NullNode;

            Local_Node := STree.Parent_Node (Current_Node => Local_Node);
         end loop;
         return Result;
      end Is_Direct_Function_Parameter;

   begin -- Root_Wise_Conversion_Required

      -- conversion is required iff
      -- (1) Actual_Sym is an object or subcomponent of an object
      -- (2) If it is a direct function parameter (i.e. not an expression)
      -- (3) This primary is being processed in the context of function parameter list
      -- (4) The function has a controlling type
      -- (5) The type of Actual_Sym is an extension of the controlling type
      if Dictionary.IsVariableOrSubcomponent (Actual_Sym)
        and then Is_Direct_Function_Parameter (Node => Node)
        and then not Exp_Stack.Is_Empty (Stack => E_Stack) then -- there may function info available
         Possible_Function_Sym := Exp_Stack.Top (Stack => E_Stack).Other_Symbol;
         if Dictionary.IsFunction (Possible_Function_Sym) then
            Controlling_Type := Dictionary.GetSubprogramControllingType (Possible_Function_Sym);
            Result           := not Dictionary.Is_Null_Symbol (Controlling_Type)
              and then Dictionary.IsAnExtensionOf (Controlling_Type, Dictionary.GetType (Actual_Sym));
         end if;
      end if;
      return Result;
   end Root_Wise_Conversion_Required;

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

   -- this function checks if the symbol passed is a protected variable or
   -- a function which globally accesses a protected variable.  If it is and
   -- the protected variable is not owned by the region we are calling from
   -- it returns the symbol otherwise it returns NullSymbol

   function Protected_References_By (Sym   : Dictionary.Symbol;
                                     Scope : Dictionary.Scopes) return Dictionary.Symbol
   --# global in Dictionary.Dict;
      is separate;

begin -- Wf_Primary
   Exp_Stack.Pop (Item  => Type_Info,
                  Stack => E_Stack);
   Sym := Type_Info.Other_Symbol;
   case Type_Info.Sort is
      when Sem.Is_Unknown =>
         Type_Info := Sem.Unknown_Type_Record;
      when Sem.Type_Result =>
         null;
      when Sem.Is_Package =>
         Type_Info := Sem.Unknown_Type_Record;
         ErrorHandler.Semantic_Error
           (Err_Num   => 5,
            Reference => ErrorHandler.No_Reference,
            Position  => STree.Node_Position (Node => STree.Last_Child_Of (Start_Node => Node)),
            Id_Str    => Dictionary.GetSimpleName (Sym));
      when Sem.Is_Function =>
         ErrorHandler.Semantic_Error
           (Err_Num   => 3,
            Reference => ErrorHandler.No_Reference,
            Position  => STree.Node_Position (Node => STree.Last_Child_Of (Start_Node => Node)),
            Id_Str    => Dictionary.GetSimpleName (Sym));
         Type_Info.Is_Static            := False;
         Type_Info.Is_Constant          := False;
         Type_Info.Is_ARange            := False;
         Type_Info.Errors_In_Expression := True;
      when Sem.Is_Object =>
         Type_Info.Is_ARange := False;
         if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.primary then
            -- ASSUME Node = primary
            Check_Readability (Sym      => Sym,
                               Node_Pos => STree.Node_Position (Node => Node));

            if Root_Wise_Conversion_Required (Node       => Node,
                                              Actual_Sym => Sym,
                                              E_Stack    => E_Stack) then
               -- Actual parameter is a variable so we can select the subset of subcomponents
               -- applicable to the root view required.
               -- We can't convert actual to the appropriate subcomponent unless we add them first
               Sem.Add_Record_Sub_Components
                 (Record_Var_Sym  => Sym,
                  Record_Type_Sym => Dictionary.GetType (Sym),
                  Component_Data  => Component_Data,
                  The_Heap        => The_Heap);
               Sym :=
                 Sem.Convert_Tagged_Actual
                 (Actual               => Sym,
                  Tagged_Parameter_Sym => Dictionary.GetSubprogramControllingType (Exp_Stack.Top (Stack => E_Stack).Other_Symbol));
               SystemErrors.RT_Assert
                 (C       => Dictionary.Is_Null_Symbol (Type_Info.Stream_Symbol)
                    or else Dictionary.IsFunction (Type_Info.Stream_Symbol)
                    or else Dictionary.IsOwnVariableOrConstituentWithMode (Type_Info.Stream_Symbol),
                  Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Unexpected Type_Info.Stream_Symbol in Wf_Primary");
            end if;
            if Dictionary.IsVariableOrSubcomponent (Sym) then
               SeqAlgebra.AddMember (The_Heap, Ref_Var, Natural (Dictionary.SymbolRef (Sym)));
            end if;
         elsif STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_primary then
            -- ASSUME Node = annotation_primary
            Type_Info.Is_Static   := Dictionary.IsStatic (Sym, Scope);
            Type_Info.Is_Constant := Dictionary.Is_Constant (Sym);
         end if;
      when Sem.Is_Type_Mark =>
         if Dictionary.IsScalarTypeMark (Sym, Scope) then
            Type_Info.Is_Static   := Dictionary.IsStatic (Sym, Scope);
            Type_Info.Is_Constant := True;
            Type_Info.Is_ARange   := True;
            Type_Info.Value       :=
              Maths.ValueRep
              (Dictionary.GetScalarAttributeValue (False, -- don't want base type
                                                   LexTokenManager.First_Token, Sym));
            Type_Info.Range_RHS   :=
              Maths.ValueRep
              (Dictionary.GetScalarAttributeValue (False, -- don't want base type
                                                   LexTokenManager.Last_Token, Sym));
         else
            Type_Info := Sem.Unknown_Type_Record;
            ErrorHandler.Semantic_Error
              (Err_Num   => 5,
               Reference => ErrorHandler.No_Reference,
               Position  => STree.Node_Position (Node => Node),
               Id_Str    => Dictionary.GetSimpleName (Sym));
         end if;
      when Sem.Is_Parameter_Name =>
         null; -- should never occur
   end case;

   -- if a primary references an external stream variable we need to check that it
   -- has done so in a simple assignment statement only (no branches in syntax tree)
   if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.primary then
      -- ASSUME Node = primary
      Check_Invalid_Stream_Use (Primary_Node => Node,
                                Sym          => Type_Info.Stream_Symbol,
                                Scope        => Scope,
                                E_Stack      => E_Stack);
      -- similarly check that protected function is only used directly in assignment statement
      Check_Invalid_Protected_Function_Use
        (Primary_Node => Node,
         Sym          => Protected_References_By (Sym   => Type_Info.Other_Symbol,
                                                  Scope => Scope),
         Scope        => Scope);
   end if;

   Type_Info.Sort        := Sem.Type_Result;
   Type_Info.Param_Count := 0;
   Type_Info.Param_List  := Lists.Null_List;

   -- Normally we set OtherSymbol to null at this point because we have finished with it;
   -- however, if the OtherSymbol represents an in instantiation of unchecked conversion then
   -- we leave it alone.  This allows wf_assign to know that the assigned expression is
   -- an unchecked conversion and for it to seed the syntax tree so that the VCG knows as well.
   -- We need to do this in order to suppress RTCs associated with assignment of unchecked
   -- conversions to an object of the same subtype.  The process is identical to that used
   -- for the assignment of external in variables.
   --
   -- Similarly, we need to keep the component information when processing
   -- the assignment of an in stream variable, in case it is marked 'Always_Valid
   if (STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_primary
         or else not Dictionary.IsAnUncheckedConversion (Type_Info.Other_Symbol))
     and then not (Type_Info.Is_AVariable
                     and then Dictionary.GetOwnVariableOrConstituentMode (Type_Info.Variable_Symbol) = Dictionary.InMode) then
      Type_Info.Other_Symbol := Dictionary.NullSymbol;
   end if;

   if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.primary then
      -- ASSUME Node = primary
      Type_Info.Arg_List_Found := False;
      Child_Primary            := STree.Child_Node (Current_Node => Node);
      -- ASSUME Child_Primary = numeric_literal OR character_literal OR string_literal OR name OR
      --                        qualified_expression OR expression OR attribute
      if STree.Syntax_Node_Type (Node => Child_Primary) = SP_Symbols.numeric_literal
        or else STree.Syntax_Node_Type (Node => Child_Primary) = SP_Symbols.character_literal
        or else STree.Syntax_Node_Type (Node => Child_Primary) = SP_Symbols.string_literal
        or else STree.Syntax_Node_Type (Node => Child_Primary) = SP_Symbols.qualified_expression
        or else STree.Syntax_Node_Type (Node => Child_Primary) = SP_Symbols.expression
        or else STree.Syntax_Node_Type (Node => Child_Primary) = SP_Symbols.attribute then
         -- ASSUME Child_Primary = numeric_literal OR character_literal OR string_literal OR qualified_expression OR
         --                        expression OR attribute
         Type_Info.Is_AVariable          := False;
         Type_Info.Is_An_Entire_Variable := False;
      elsif STree.Syntax_Node_Type (Node => Child_Primary) /= SP_Symbols.name then
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Child_Primary = numeric_literal OR character_literal OR string_literal OR name OR " &
              "qualified_expression OR expression OR attribute in Wf_Primary");
      end if;
   end if;

   Exp_Stack.Push (X     => Type_Info,
                   Stack => E_Stack);

   --# accept F, 601, ErrorHandler.Error_Context, The_Heap, "False coupling through SPARK_IO" &
   --#        F, 601, E_Stack, The_Heap, "False coupling through SPARK_IO" &
   --#        F, 601, E_Stack, Component_Data, "False coupling through SPARK_IO";
end Wf_Primary;
