-------------------------------------------------------------------------------
-- (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.Walk_Annotation_Expression)
procedure Up_Wf_Store_List
  (Node    : in out STree.SyntaxNode;
   Scope   : in     Dictionary.Scopes;
   E_Stack : in out Exp_Stack.Exp_Stack_Type)
is
   Exp_Result, Type_Info : Sem.Exp_Record;
   Sym                   : Dictionary.Symbol;
   Error_Found           : Boolean := False;

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

   procedure Chain_Up_To_Store (Node : in out STree.SyntaxNode)
   --# global in STree.Table;
   --# derives Node from *,
   --#                   STree.Table;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.store_list;
   --# post STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.store;
   is
   begin
      while STree.Syntax_Node_Type (Node => Node) = SP_Symbols.store_list loop
         Node := STree.Parent_Node (Current_Node => Node);
      end loop;
      -- ASSUME Node = store
      SystemErrors.RT_Assert
        (C       => STree.Syntax_Node_Type (Node => Node) = SP_Symbols.store,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Node = store in Chain_Up_To_Store");
   end Chain_Up_To_Store;

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

   function Expression_Location (Node : STree.SyntaxNode) return LexTokenManager.Token_Position
   --# global in STree.Table;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.store_list;
   is
      Exp_Loc : LexTokenManager.Token_Position;
   begin
      if STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => Node)) = SP_Symbols.annotation_expression then
         -- ASSUME STree.Child_Node (Current_Node => Node) = annotation_expression
         Exp_Loc := STree.Node_Position (Node => Node);
      elsif STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => Node)) = SP_Symbols.store_list then
         -- ASSUME STree.Child_Node (Current_Node => Node) = store_list
         Exp_Loc := STree.Node_Position (Node => STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node)));
      else
         Exp_Loc := LexTokenManager.Null_Token_Position;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect STree.Child_Node (Current_Node => Node) = store_list OR annotation_expression " &
              "in Expression_Location");
      end if;
      return Exp_Loc;
   end Expression_Location;

begin -- Up_Wf_Store_List
   Exp_Stack.Pop (Item  => Exp_Result,
                  Stack => E_Stack);
   Exp_Stack.Pop (Item  => Type_Info,
                  Stack => E_Stack);
   Sym := Type_Info.Other_Symbol;

   -- we must be dealing with an array update because Down_Wf_Store_List
   -- prunes at store_list node for records and so this procedure will
   -- never be called with a record (or any other illegal type)

   if Type_Info.Param_Count >= Dictionary.GetNumberOfDimensions (Type_Info.Type_Symbol) then
      -- too many index expressions found
      Type_Info := Unknown_Symbol_Record;
      ErrorHandler.Semantic_Error
        (Err_Num   => 93,
         Reference => ErrorHandler.No_Reference,
         Position  => STree.Node_Position (Node => Node),
         Id_Str    => Dictionary.GetSimpleName (Sym));
      Chain_Up_To_Store (Node => Node);
   else -- still counting index expressions
      Type_Info.Param_Count := Type_Info.Param_Count + 1;
      if not Dictionary.CompatibleTypes
        (Scope,
         Dictionary.GetArrayIndex (Type_Info.Type_Symbol, Type_Info.Param_Count),
         Exp_Result.Type_Symbol) then
         Error_Found := True;
         ErrorHandler.Semantic_Error
           (Err_Num   => 38,
            Reference => ErrorHandler.No_Reference,
            Position  => Expression_Location (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;
   end if;

   Type_Info.Errors_In_Expression := Error_Found or else Type_Info.Errors_In_Expression or else Exp_Result.Errors_In_Expression;

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