-------------------------------------------------------------------------------
-- (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)
function Range_Constraint_Type_From_Context
  (Exp_Node : STree.SyntaxNode;
   E_Stack  : Exp_Stack.Exp_Stack_Type;
   T_Stack  : Type_Context_Stack.T_Stack_Type)
  return     Dictionary.Symbol
is
   New_Context_Type : Dictionary.Symbol;
   Parent           : STree.SyntaxNode;
begin
   Parent := STree.Parent_Node (Current_Node => Exp_Node);
   -- ASSUME Parent = integer_type_definition OR floating_point_constraint OR
   --                 fixed_point_constraint OR derived_type_definition OR
   --                 constraint OR case_choice OR
   --                 aggregate_choice OR annotation_aggregate_choice
   case STree.Syntax_Node_Type (Node => Parent) is
      when SP_Symbols.case_choice =>
         -- ASSUME Parent = case_choice
         -- In case_choice, the expected subtype is passed in from
         -- wf_case_choice, so no change here.
         New_Context_Type := Type_Context_Stack.Top (Stack => T_Stack);
      when SP_Symbols.aggregate_choice | SP_Symbols.annotation_aggregate_choice =>
         -- ASSUME Parent = aggregate_choice OR annotation_aggregate_choice
         -- In *_aggregate_choice, the range constraint is always preceeded by
         -- a simple_expression which denotes the subtype be to constrained, which
         -- must be on the top of the Exp_Stack.  That's the type needed for the new context.
         New_Context_Type := Exp_Stack.Top (Stack => E_Stack).Type_Symbol;
      when SP_Symbols.constraint                |
        SP_Symbols.integer_type_definition   |
        SP_Symbols.derived_type_definition   |
        SP_Symbols.floating_point_constraint |
        SP_Symbols.fixed_point_constraint    =>
         -- ASSUME Parent = constraint OR integer_type_definition OR floating_point_constraint OR
         --                 fixed_point_constraint OR derived_type_definition
         -- In these cases, the context has been supplied by whoever called WalkExpression,
         -- so is simply preserved.
         New_Context_Type := Type_Context_Stack.Top (Stack => T_Stack);
      when others =>
         -- Must be an error - this will be caught later on in the UP
         -- pass, but we need to push something so...
         New_Context_Type := Dictionary.NullSymbol;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Parent = integer_type_definition OR floating_point_constraint OR fixed_point_constraint OR " &
              "derived_type_definition OR constraint OR case_choice OR " &
              "aggregate_choice OR annotation_aggregate_choice in Range_Constraint_Type_From_Context");
   end case;
   return New_Context_Type;
end Range_Constraint_Type_From_Context;
