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

   function Branches_Found (Start_Node, End_Node : STree.SyntaxNode) return Boolean
   --# global in STree.Table;
   --# pre STree.Syntax_Node_Type (Start_Node, STree.Table) = SP_Symbols.identifier and
   --#   STree.Syntax_Node_Type (End_Node, STree.Table) = SP_Symbols.store_list;
   is
      Next_Node : STree.SyntaxNode;
      Result    : Boolean;
   begin
      Result    := False;
      Next_Node := STree.Parent_Node (Current_Node => Start_Node);
      while Next_Node /= End_Node loop
         if STree.Next_Sibling (Current_Node => Next_Node) /= STree.NullNode then
            Result := True;
            exit;
         end if;
         Next_Node := STree.Parent_Node (Current_Node => Next_Node);
      end loop;
      return Result;
   end Branches_Found;

begin -- Up_Wf_Store
   Exp_Stack.Pop (Item  => Exp_Result,
                  Stack => E_Stack);
   Exp_Stack.Pop (Item  => Type_Info,
                  Stack => E_Stack);
   Sym             := Type_Info.Other_Symbol;
   Store_List_Node := STree.Child_Node (Current_Node => Node);
   -- ASSUME Store_List_Node = store_list
   SystemErrors.RT_Assert
     (C       => STree.Syntax_Node_Type (Node => Store_List_Node) = SP_Symbols.store_list,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Store_List_Node = store_list in Up_Wf_Store");

   if Dictionary.IsArrayTypeMark (Type_Info.Type_Symbol, Scope) then
      if Type_Info.Param_Count = Dictionary.GetNumberOfDimensions (Type_Info.Type_Symbol) then
         -- right number of index expressions so just check type check needed
         if not Dictionary.CompatibleTypes
           (Scope,
            Dictionary.GetArrayComponent (Type_Info.Type_Symbol),
            Exp_Result.Type_Symbol) then
            Error_Found := True;
            ErrorHandler.Semantic_Error
              (Err_Num   => 38,
               Reference => ErrorHandler.No_Reference,
               Position  => STree.Node_Position (Node => STree.Next_Sibling (Current_Node => Store_List_Node)),
               Id_Str    => LexTokenManager.Null_String);
         end if;
      else
         -- insufficient index expressions
         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));
      end if;
   else
      --  must be record multiple field name check
      if STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => Store_List_Node)) = SP_Symbols.store_list then
         Error_Found := True;
         ErrorHandler.Semantic_Error
           (Err_Num   => 324,
            Reference => ErrorHandler.No_Reference,
            Position  => STree.Node_Position (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      else
         Field_Ident_Node := STree.Last_Child_Of (Start_Node => Node);
         if STree.Syntax_Node_Type (Node => Field_Ident_Node) = SP_Symbols.identifier then
            -- ASSUME Field_Ident_Node = identifier
            if Branches_Found (Start_Node => Field_Ident_Node,
                               End_Node   => Store_List_Node) then
               Error_Found := True;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 102,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Field_Ident_Node),
                  Id_Str    => Dictionary.GetSimpleName (Type_Info.Other_Symbol));
            else
               Field_Ident  := STree.Node_Lex_String (Node => Field_Ident_Node);
               Field_Symbol :=
                 Dictionary.LookupSelectedItem
                 (Prefix   => Type_Info.Type_Symbol,
                  Selector => Field_Ident,
                  Scope    => Scope,
                  Context  => Dictionary.ProofContext);
               if Dictionary.Is_Null_Symbol (Field_Symbol) or else not Dictionary.IsRecordComponent (Field_Symbol) then
                  -- no such field
                  Error_Found := True;
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 8,
                     Reference => ErrorHandler.No_Reference,
                     Position  => STree.Node_Position (Node => Field_Ident_Node),
                     Id_Str    => Field_Ident);
               else -- field name exists so type check of result assigned to it required
                  if Dictionary.CompatibleTypes (Scope, Dictionary.GetType (Field_Symbol), Exp_Result.Type_Symbol) then
                     STree.Set_Node_Lex_String (Sym  => Field_Symbol,
                                                Node => Field_Ident_Node);
                  else
                     Error_Found := True;
                     ErrorHandler.Semantic_Error
                       (Err_Num   => 38,
                        Reference => ErrorHandler.No_Reference,
                        Position  => STree.Node_Position (Node => STree.Next_Sibling (Current_Node => Store_List_Node)),
                        Id_Str    => LexTokenManager.Null_String);
                  end if;
               end if;
            end if;
         else -- identifier not found
            Error_Found := True;
            ErrorHandler.Semantic_Error
              (Err_Num   => 102,
               Reference => ErrorHandler.No_Reference,
               Position  => STree.Node_Position (Node => Field_Ident_Node),
               Id_Str    => Dictionary.GetSimpleName (Type_Info.Other_Symbol));
         end if;
      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;
