-------------------------------------------------------------------------------
-- (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_Qualified_Expression
  (Node    : in     STree.SyntaxNode;
   Scope   : in     Dictionary.Scopes;
   E_Stack : in out Exp_Stack.Exp_Stack_Type)
is
   Name_Exp, Exp_Result : Sem.Exp_Record;
   Exp_Value            : Maths.Value;
   Store_Rep            : LexTokenManager.Lex_String;
   Exp_Node             : STree.SyntaxNode;
begin
   Exp_Node := STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node));
   -- ASSUME Exp_Node = aggregate            OR extension_aggregate            OR expression OR
   --                   annotation_aggregate OR annotation_extension_aggregate OR annotation_expression
   if STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.expression
     or else STree.Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.annotation_expression then
      -- ASSUME Exp_Node = expression OR annotation_expression
      -- we are dealing with a simple qualified expression
      Exp_Stack.Pop (Item  => Exp_Result,
                     Stack => E_Stack);
      Exp_Stack.Pop (Item  => Name_Exp,
                     Stack => E_Stack);
      case Name_Exp.Sort is
         when Sem.Is_Type_Mark =>
            -- check that constraining type mark is not unconstrained
            if Dictionary.Is_Unconstrained_Array_Type_Mark (Name_Exp.Type_Symbol, Scope) then
               ErrorHandler.Semantic_Error
                 (Err_Num   => 39,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Node),
                  Id_Str    => LexTokenManager.Null_String);
               Exp_Stack.Push (X     => Sem.Unknown_Type_Record,
                               Stack => E_Stack);
            elsif Dictionary.CompatibleTypes (Scope, Name_Exp.Type_Symbol, Exp_Result.Type_Symbol) then
               Maths.StorageRep (Exp_Result.Range_RHS, Store_Rep);
               if Dictionary.IsPredefinedStringType (Exp_Result.Type_Symbol) then
                  if Exp_Result.Range_RHS = Maths.NoValue then -- must be a parameter
                     ErrorHandler.Semantic_Error
                       (Err_Num   => 39,
                        Reference => ErrorHandler.No_Reference,
                        Position  => STree.Node_Position (Node => Exp_Node),
                        Id_Str    => LexTokenManager.Null_String);
                  elsif LexTokenManager.Lex_String_Case_Insensitive_Compare
                    (Lex_Str1 => Dictionary.GetScalarAttributeValue
                       (False,
                        LexTokenManager.Last_Token,
                        Dictionary.CurrentSymbol (Dictionary.FirstArrayIndex (Name_Exp.Type_Symbol))),
                     Lex_Str2 => Store_Rep) /=
                    LexTokenManager.Str_Eq then
                     if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_qualified_expression then
                        -- in annotation
                        ErrorHandler.Semantic_Error
                          (Err_Num   => 399,
                           Reference => ErrorHandler.No_Reference,
                           Position  => STree.Node_Position (Node => Node),
                           Id_Str    => LexTokenManager.Null_String);
                     else
                        ErrorHandler.Semantic_Error
                          (Err_Num   => 402,
                           Reference => ErrorHandler.No_Reference,
                           Position  => STree.Node_Position (Node => Node),
                           Id_Str    => LexTokenManager.Null_String);
                     end if;
                  end if;
               elsif Sem.Illegal_Unconstrained (Left_Type  => Name_Exp.Type_Symbol,
                                                Right_Type => Exp_Result.Type_Symbol) then
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 418,
                     Reference => ErrorHandler.No_Reference,
                     Position  => STree.Node_Position (Node => Exp_Node),
                     Id_Str    => LexTokenManager.Null_String);
               end if;
               Sem.Constraint_Check
                 (Val           => Exp_Result.Value,
                  New_Val       => Exp_Value,
                  Is_Annotation => STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_qualified_expression,
                  Typ           => Name_Exp.Type_Symbol,
                  Position      => STree.Node_Position (Node => Exp_Node));

               Exp_Result.Value                 := Exp_Value;
               Exp_Result.Type_Symbol           := Name_Exp.Type_Symbol;
               Exp_Result.Is_AVariable          := False;
               Exp_Result.Is_An_Entire_Variable := False;
               Exp_Stack.Push (X     => Exp_Result,
                               Stack => E_Stack);
            else
               ErrorHandler.Semantic_Error
                 (Err_Num   => 38,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Exp_Node),
                  Id_Str    => LexTokenManager.Null_String);
               Exp_Stack.Push (X     => Sem.Unknown_Type_Record,
                               Stack => E_Stack);
            end if;
         when Sem.Is_Unknown =>
            -- any error from unknown prefix will already have been raised
            Exp_Stack.Push (X     => Sem.Unknown_Type_Record,
                            Stack => E_Stack);
         when others =>
            Exp_Stack.Push (X     => Sem.Unknown_Type_Record,
                            Stack => E_Stack);
            ErrorHandler.Semantic_Error
              (Err_Num   => 95,
               Reference => ErrorHandler.No_Reference,
               Position  => STree.Node_Position (Node => Node),
               Id_Str    => LexTokenManager.Null_String);
      end case;
   elsif STree.Syntax_Node_Type (Node => Exp_Node) /= SP_Symbols.aggregate
     and then STree.Syntax_Node_Type (Node => Exp_Node) /= SP_Symbols.annotation_aggregate
     and then STree.Syntax_Node_Type (Node => Exp_Node) /= SP_Symbols.extension_aggregate
     and then STree.Syntax_Node_Type (Node => Exp_Node) /= SP_Symbols.annotation_extension_aggregate then
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Exp_Node = aggregate OR extension_aggregate OR expression OR annotation_aggregate OR " &
           "annotation_extension_aggregate OR annotation_expression in Wf_Qualified_Expression");
   end if;
end Wf_Qualified_Expression;
