-------------------------------------------------------------------------------
-- (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.CompUnit.WalkStatements)
procedure Wf_Assign
  (Node           : in     STree.SyntaxNode;
   Scope          : in     Dictionary.Scopes;
   Table          : in out RefList.HashTable;
   Component_Data : in out ComponentManager.ComponentData)
is
   Name_Result, Exp_Result : Exp_Record;
   Expected_Type, Name_Sym : Dictionary.Symbol;
   Most_Enclosing_Name_Sym : Dictionary.Symbol;
   Name_Node, -- the name on the LHS
     Exp_Node              : STree.SyntaxNode; -- the expression on the RHS
   Ref_Var                 : SeqAlgebra.Seq;
   Others_Aggregate        : Boolean; -- is this an unconstrained_array_assignment

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

   procedure Check_Write_To_Structured_Var
     (Name_Sym, Expected_Type : in     Dictionary.Symbol;
      Ref_Var                 : in     SeqAlgebra.Seq;
      The_Heap                : in out Heap.HeapRecord)
   --# global in     Dictionary.Dict;
   --#        in out Statistics.TableUsage;
   --# derives Statistics.TableUsage,
   --#         The_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    Expected_Type,
   --#                                    Name_Sym,
   --#                                    Ref_Var,
   --#                                    The_Heap;
   is
   begin
      if not Dictionary.Types_Are_Equal
        (Left_Symbol        => Expected_Type,
         Right_Symbol       => Dictionary.GetType (Name_Sym),
         Full_Range_Subtype => False) then
         -- we must be writing to a component of a structured variable
         -- so must add structure variable to list of referenced variables
         SeqAlgebra.AddMember (The_Heap, Ref_Var, Natural (Dictionary.SymbolRef (Name_Sym)));
      end if;
   end Check_Write_To_Structured_Var;

begin -- Wf_Assign

   -- This procedure checks the following:
   -- (0) if the child node is an unconstrained_array_assignment (if it is then step down
   --     a level in the tree before continuing with the other checks),
   -- (1) the assigned identifier is declared and visible, and
   -- (2) it is a variable, and
   -- (3) it is not an unconstrained array (unless this is an unconstrained_array_assignment)
   -- (4) for unconstrained array assignments the array must be one-dimensional
   -- (5) this variable is not a loop parameter, and
   -- (6) it may be a package own var declared in a non-enclosing scope but
   --     a warning is given.
   -- (7) it is not a formal parameter of mode in, and
   -- additions for streams
   -- (8) check that the assigned variable is not of mode in
   -- (9) check that assigning expression is not a mode out variable

   -- (0) Check if the child node is an unconstrained_array_assignment (if it is then step down
   --     a level in the tree before continuing with the other checks).
   Others_Aggregate := Syntax_Node_Type (Node => Child_Node (Current_Node => Node)) = SP_Symbols.unconstrained_array_assignment;

   if Others_Aggregate then
      Name_Node := Child_Node (Current_Node => Child_Node (Current_Node => Node));
   else
      Name_Node := Child_Node (Current_Node => Node);
   end if;
   -- ASSUME Name_Node = name
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Name_Node) = SP_Symbols.name,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Name_Node = name in Wf_Assign");

   --# assert Syntax_Node_Type (Node, STree.Table) = SP_Symbols.assignment_statement and
   --#   Syntax_Node_Type (Name_Node, STree.Table) = SP_Symbols.name and
   --#   STree.Table = STree.Table~;

   Exp_Node := Next_Sibling (Current_Node => Name_Node);
   -- ASSUME Exp_Node = expression
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.expression,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Exp_Node = expression in Wf_Assign");
   SeqAlgebra.CreateSeq (TheHeap, Ref_Var);

   -- Call WalkExpression to check the LHS of the assignment statement
   --# accept Flow, 10, Aggregate_Stack.State, "Expected ineffective assignment";
   Walk_Expression_P.Walk_Expression
     (Exp_Node                => Name_Node,
      Scope                   => Scope,
      Type_Context            => Dictionary.GetUnknownTypeMark,
      Context_Requires_Static => False,
      Ref_Var                 => Ref_Var,
      Result                  => Name_Result,
      Component_Data          => Component_Data,
      The_Heap                => TheHeap);
   --# end accept;

   Name_Sym                := Name_Result.Other_Symbol;
   Most_Enclosing_Name_Sym := Dictionary.GetMostEnclosingObject (Name_Sym);

   -- Check that LHS is something that can be assigned to
   if not Name_Result.Is_AVariable and then not Dictionary.IsUnknownTypeMark (Name_Result.Type_Symbol) then
      Expected_Type := Dictionary.GetUnknownTypeMark;
      ErrorHandler.Semantic_Error
        (Err_Num   => 609,
         Reference => 14,
         Position  => Node_Position (Node => Name_Node),
         Id_Str    => LexTokenManager.Null_String);
   elsif Dictionary.Is_Null_Symbol (Name_Sym) then
      Expected_Type := Dictionary.GetUnknownTypeMark;
      -- Check for attempts to assign to tagged type conversions:
      if Name_Result.Sort = Type_Result and then Dictionary.TypeIsTagged (Name_Result.Type_Symbol) then
         if Dictionary.IsSubcomponent (Name_Result.Variable_Symbol) then
            -- Assignment to view conversion is not implemented yet.
            ErrorHandler.Semantic_Error
              (Err_Num   => 129,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Name_Node),
               Id_Str    => LexTokenManager.Null_String);
         else
            -- View conversion to own type is not permitted in target of
            -- assignment.
            ErrorHandler.Semantic_Error
              (Err_Num   => 116,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Name_Node),
               Id_Str    => LexTokenManager.Null_String);
         end if;
      end if;
   else
      Expected_Type := Name_Result.Type_Symbol;

      -- For an unconstrained_array_assignment the Expected_Type of the LHS will be the
      -- unconstrained array type, but the type of the RHS will be the type
      -- of the components of that array.
      if Others_Aggregate then
         Expected_Type := Dictionary.GetArrayComponent (Expected_Type);
      end if;

      -- Seed syntax tree with expected type for run-time check.
      STree.Add_Node_Symbol (Node => Node,
                             Sym  => Expected_Type);

      -- (2) Check that LHS is a variable
      if Dictionary.IsVariableOrSubcomponent (Name_Sym) then
         -- If this is an unconstrained_array_assignment then it is an aggregate assignment so
         -- there is never any self-reference.
         if not Others_Aggregate then
            -- Check for assignment to structured variables so that they generate
            -- a reference to the variable as well; A (I) = 3; is a reference of A
            -- as well as write to it.  Call moved here because if A is not a variable
            -- in the first place then the check is meaningless.
            Check_Write_To_Structured_Var
              (Name_Sym      => Name_Sym,
               Expected_Type => Expected_Type,
               Ref_Var       => Ref_Var,
               The_Heap      => TheHeap);
         end if;

         -- (3) Check that Expected_Type is not unconstrained array.
         -- (For unconstrained_array_assignments the LHS *must* be an unconstrained array
         -- but don't need to add guard here because if this is an unconstrained_array_assignment
         -- then Expected_Type will represent the component type, not the array type.)
         if Dictionary.Is_Unconstrained_Array_Type_Mark (Expected_Type, Scope) then
            ErrorHandler.Semantic_Error
              (Err_Num   => 39,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Name_Node),
               Id_Str    => LexTokenManager.Null_String);

            -- (4) If this is an unconstrained array assignment then the target type must be a
            --     one dimensional array. Although the grammar of unconstrained_array_assignment will
            --     not permit:
            --       X := (others => (others => 0));
            --     we still need to make sure that we trap the case where:
            --       X := (others => 0);
            --     when X is a multidimensional array.
         elsif Others_Aggregate
           and then Dictionary.IsArrayTypeMark (Name_Result.Type_Symbol, Scope)
           and then Dictionary.GetNumberOfDimensions (Name_Result.Type_Symbol) /= 1 then
            ErrorHandler.Semantic_Error
              (Err_Num   => 118,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Name_Node),
               Id_Str    => LexTokenManager.Null_String);

            -- (5) Check that LHS is not a loop parameter
         elsif Dictionary.IsLoopParameter (Name_Sym) then
            ErrorHandler.Semantic_Error
              (Err_Num   => 168,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Name_Node),
               Id_Str    => Dictionary.GetSimpleName (Name_Sym));

            -- (6) LHS may be a package own var declared in a non-enclosing scope but
            --     a warning is given.
         elsif not In_Package_Initialization (Scope => Scope)
           and then Dictionary.IsOwnVariable (Most_Enclosing_Name_Sym)
           and then not Is_Enclosing_Package (Outer_Pack => Dictionary.GetOwner (Most_Enclosing_Name_Sym),
                                              Scope      => Scope) then
            ErrorHandler.Semantic_Warning_Sym
              (Err_Num  => 169,
               Position => Node_Position (Node => Name_Node),
               Sym      => Name_Sym,
               Scope    => Scope);

            -- If we are initializing a package own variable, check that the initialization
            -- was announced in the package specification.
         elsif In_Package_Initialization (Scope => Scope)
           and then Unexpected_Initialization (Sym => Most_Enclosing_Name_Sym) then
            ErrorHandler.Semantic_Error
              (Err_Num   => 333,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Name_Node),
               Id_Str    => Dictionary.GetSimpleName (Most_Enclosing_Name_Sym));

            -- Protected state must be initialized at declaration
         elsif In_Package_Initialization (Scope => Scope)
           and then Dictionary.IsOwnVariable (Name_Sym)
           and then Dictionary.GetOwnVariableMode (Name_Sym) = Dictionary.DefaultMode
           and then (Dictionary.GetOwnVariableProtected (Name_Sym) or else Dictionary.IsVirtualElement (Name_Sym)) then
            ErrorHandler.Semantic_Error
              (Err_Num   => 874,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Name_Node),
               Id_Str    => Dictionary.GetSimpleName (Most_Enclosing_Name_Sym));

         elsif Others_Aggregate
           and then (not Dictionary.IsSubprogramParameter (Most_Enclosing_Name_Sym)
                       or else not Dictionary.Is_Unconstrained_Array_Type_Mark (Name_Result.Type_Symbol, Scope)) then
            -- If LHS is not a subprogram parameter then it can't be an aggregate assignment
            -- to an unconstrained array.
            -- If LHS is not unconstrained then this syntax is not permitted in SPARK.
            -- This error will be raised if there is an attempt to use the syntax for an
            -- unconstrained_array_assignment where the LHS is not an unconstrained array type at all. (Most
            -- likely the LHS is a normal array.) It should not be possible to get here if the
            -- LHS is an unconstrained array type that is not a parameter because SPARK does not
            -- permit objects of unconstrained array types to be declared.
            ErrorHandler.Semantic_Error
              (Err_Num   => 117,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Exp_Node),
               Id_Str    => LexTokenManager.Null_String);

            -- (7) Check LHS is not a formal parameter of mode in.
         elsif Dictionary.IsSubprogramParameter (Most_Enclosing_Name_Sym) then
            if Dictionary.GetSubprogramParameterMode (Most_Enclosing_Name_Sym) = Dictionary.InMode
              or else Dictionary.GetSubprogramParameterMode (Most_Enclosing_Name_Sym) = Dictionary.DefaultMode then
               ErrorHandler.Semantic_Error
                 (Err_Num   => 170,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Name_Node),
                  Id_Str    => Dictionary.GetSimpleName (Most_Enclosing_Name_Sym));
            end if;

            -- Check for direct update of global by function.
         elsif Dictionary.IsFunction (Dictionary.GetEnclosingCompilationUnit (Scope))
           and then Dictionary.Is_Global_Variable
           (Dictionary.GetAbstraction (Dictionary.GetEnclosingCompilationUnit (Scope), Scope),
            Dictionary.GetEnclosingCompilationUnit (Scope),
            Most_Enclosing_Name_Sym) then
            ErrorHandler.Semantic_Error
              (Err_Num   => 327,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Name_Node),
               Id_Str    => Dictionary.GetSimpleName (Most_Enclosing_Name_Sym));

            -- (8) Check LHS is not stream variable of mode in.
         elsif Dictionary.GetOwnVariableOrConstituentMode (Most_Enclosing_Name_Sym) = Dictionary.InMode then
            ErrorHandler.Semantic_Error
              (Err_Num   => 717,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Name_Node),
               Id_Str    => Dictionary.GetSimpleName (Most_Enclosing_Name_Sym));
         end if;
      else
         Expected_Type := Dictionary.GetUnknownTypeMark;
         ErrorHandler.Semantic_Error
           (Err_Num   => 6,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Name_Node),
            Id_Str    => Dictionary.GetSimpleName (Name_Sym));
      end if;
   end if;

   --# assert Syntax_Node_Type (Node, STree.Table) = SP_Symbols.assignment_statement and
   --#   Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.expression and
   --#   (Dictionary.Is_Null_Symbol (Expected_Type) or Dictionary.IsTypeMark (Expected_Type, Dictionary.Dict)) and
   --#   STree.Table = STree.Table~;

   -- Call WalkExpression to check the RHS of the assignment statement.
   Walk_Expression_P.Walk_Expression
     (Exp_Node                => Exp_Node,
      Scope                   => Scope,
      Type_Context            => Expected_Type,
      Context_Requires_Static => False,
      Ref_Var                 => Ref_Var,
      Result                  => Exp_Result,
      Component_Data          => Component_Data,
      The_Heap                => TheHeap);

   Assignment_Check
     (Position    => Node_Position (Node => Exp_Node),
      Scope       => Scope,
      Target_Type => Expected_Type,
      Exp_Result  => Exp_Result);

   -- (9) Check that we are not trying to read an out stream.
   if Exp_Result.Is_AVariable
     and then Dictionary.GetOwnVariableOrConstituentMode (Exp_Result.Variable_Symbol) = Dictionary.OutMode then
      ErrorHandler.Semantic_Error_Sym
        (Err_Num   => 718,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Exp_Node),
         Sym       => Exp_Result.Variable_Symbol,
         Scope     => Scope);
   end if;

   --# assert Syntax_Node_Type (Node, STree.Table) = SP_Symbols.assignment_statement and
   --#   Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.expression and
   --#   STree.Table = STree.Table~ and
   --#   (Dictionary.Is_Null_Symbol (Exp_Result.Type_Symbol) or Dictionary.IsTypeMark (Exp_Result.Type_Symbol, Dictionary.Dict));

   -- If expression represents an IN stream variable then put type of expression
   -- into syntax tree for the benefit of the RTC procedure ModelAssignmentStatement.
   if Exp_Result.Is_AVariable
     and then Dictionary.GetOwnVariableOrConstituentMode (Exp_Result.Variable_Symbol) = Dictionary.InMode then
      -- Mark the enclosing compilation unit as assigning an external variable
      -- This may be too coarse; may be we should just mark enclosing subprog?
      Dictionary.AddAssignsFromExternal (Dictionary.GetEnclosingCompilationUnit (Scope));
      SystemErrors.RT_Assert
        (C       => Dictionary.Is_Null_Symbol (Exp_Result.Type_Symbol) or else Dictionary.IsTypeMark (Exp_Result.Type_Symbol),
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Exp_Result.Type_Symbol to be a type in Wf_Assign");
      STree.Add_Node_Symbol (Node => Exp_Node,
                             Sym  => Exp_Result.Type_Symbol);
      -- Check to see if the variable has been marked as always valid.
      -- Note that the OtherSymbol is checked,not the variableSymbol,
      -- since this will be the Subcomponent symbol if we are referring to
      -- a record component.
      if Dictionary.VariableOrSubcomponentIsMarkedValid (Exp_Result.Other_Symbol) then
         -- MCA & TJJ: do we also need to add a use of 'Always_Valid to the summary?
         -- Debug.PrintSym ("Access is Always_Valid =", Exp_Result.OtherSymbol);
         null;
      else
         -- and issue warning about possible validity problems.
         -- The warning is stronger when the external variable is a type that doesn't
         -- generate run-time checks.
         if Dictionary.TypeIsScalar (Exp_Result.Type_Symbol) and then not Dictionary.TypeIsBoolean (Exp_Result.Type_Symbol) then
            -- weaker warning
            ErrorHandler.Semantic_Warning_Sym
              (Err_Num  => 392,
               Position => Node_Position (Node => Exp_Node),
               Sym      => Exp_Result.Other_Symbol,
               Scope    => Scope);
         else
            -- stronger warning
            ErrorHandler.Semantic_Warning_Sym
              (Err_Num  => 393,
               Position => Node_Position (Node => Exp_Node),
               Sym      => Exp_Result.Other_Symbol,
               Scope    => Scope);
         end if;
      end if;
   end if;

   --# assert Syntax_Node_Type (Node, STree.Table) = SP_Symbols.assignment_statement and
   --#   Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.expression and
   --#   STree.Table = STree.Table~;

   -- If the expression represents a use of unchecked conversion then plant the return
   -- type in the syntax tree for the benefit of the RTC procedure ModelAssignmentStatement
   -- TJJ: Note a more explicit way of designating and checking for this would
   -- be better so that it is easier to determine the extent of use of this idiom.
   if Dictionary.IsAnUncheckedConversion (Exp_Result.Other_Symbol) then
      STree.Add_Node_Symbol (Node => Exp_Node,
                             Sym  => Dictionary.GetType (Exp_Result.Other_Symbol));
   end if;

   if Dictionary.TypeIsLimited (Exp_Result.Type_Symbol, Scope) then
      ErrorHandler.Semantic_Error
        (Err_Num   => 308,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Exp_Node),
         Id_Str    => LexTokenManager.Null_String);
   end if;

   -- Patch flow relations to take into account stream volatility.
   Add_Stream_Effects (Table    => Table,
                       The_Heap => TheHeap,
                       Node     => Node,
                       Export   => Name_Sym,
                       Imports  => Ref_Var);

   -- Add export and list of imports to RefList hash table.
   RefList.AddRelation (Table, TheHeap, Node, Name_Sym, Ref_Var);
end Wf_Assign;
