-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

with SLI;

separate (Sem.Wf_Basic_Declarative_Item.Wf_Basic_Declaration)
procedure Wf_Subtype_Declaration (Node     : in     STree.SyntaxNode;
                                  Scope    : in     Dictionary.Scopes;
                                  The_Heap : in out Heap.HeapRecord) is
   type Real_Type is (Is_Floating, Is_Fixed);

   Type_Node, Ident_Node, Constraint_Node : STree.SyntaxNode;
   Id_Str                                 : LexTokenManager.Lex_String;
   Constraint_Found, Ok_To_Add            : Boolean;
   All_Indexes_OK                         : Boolean;
   Subtype_Sym, Type_Sym                  : Dictionary.Symbol;
   Subtype_Is_Static                      : Boolean;
   Lower, Upper, Accuracy                 : LexTokenManager.Lex_String;
   Subtype_Symbol                         : Dictionary.Symbol;

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

   function Is_Named_Association (Node : STree.SyntaxNode) return Boolean
   --# global in STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.index_or_discriminant_constraint;
   is
      Current_Node : STree.SyntaxNode;
   begin
      Current_Node := Child_Node (Current_Node => Child_Node (Current_Node => Node));
      -- ASSUME Current_Node = named_argument_association OR positional_argument_association
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Current_Node) = SP_Symbols.named_argument_association
           or else Syntax_Node_Type (Node => Current_Node) = SP_Symbols.positional_argument_association,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Current_Node = named_argument_association OR " &
           "positional_argument_association in Is_Named_Association");
      return Syntax_Node_Type (Node => Current_Node) = SP_Symbols.named_argument_association;
   end Is_Named_Association;

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

   procedure Check_Index_Constraints
     (Constraint_Node : in     STree.SyntaxNode;
      Scope           : in     Dictionary.Scopes;
      Subtype_Sym     : in     Dictionary.Symbol;
      Type_Sym        : in     Dictionary.Symbol;
      All_Indexes_OK  :    out Boolean;
      The_Heap        : in out Heap.HeapRecord)
   --# global in     CommandLineData.Content;
   --#        in     ContextManager.Ops.File_Heap;
   --#        in     ContextManager.Ops.Unit_Heap;
   --#        in     ContextManager.Ops.Unit_Stack;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out LexTokenManager.State;
   --#        in out SLI.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out STree.Table;
   --#           out Aggregate_Stack.State;
   --# derives Aggregate_Stack.State,
   --#         All_Indexes_OK,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         STree.Table                from CommandLineData.Content,
   --#                                         Constraint_Node,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         Subtype_Sym,
   --#                                         The_Heap,
   --#                                         Type_Sym &
   --#         ErrorHandler.Error_Context,
   --#         SLI.State,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Constraint_Node,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         Subtype_Sym,
   --#                                         The_Heap,
   --#                                         Type_Sym &
   --#         Statistics.TableUsage,
   --#         The_Heap                   from *,
   --#                                         CommandLineData.Content,
   --#                                         Constraint_Node,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         Subtype_Sym,
   --#                                         The_Heap,
   --#                                         Type_Sym;
   --# pre Syntax_Node_Type (Constraint_Node, STree.Table) = SP_Symbols.index_or_discriminant_constraint;
   --# post STree.Table = STree.Table~;
   is
      Index_Iterator                              : Dictionary.Iterator;
      Current_Constraint_Node                     : STree.SyntaxNode;
      Index_Sym, Constraint_Sym, The_Array_Index  : Dictionary.Symbol;
      Result_Of_First_Check, Result_Of_Last_Check : Maths.Value;
      Constraint_First, Constraint_Last           : LexTokenManager.Lex_String;

      procedure Get_First_Index
        (Type_Sym       : in     Dictionary.Symbol;
         Index_Sym      :    out Dictionary.Symbol;
         Index_Iterator :    out Dictionary.Iterator)
      --# global in Dictionary.Dict;
      --# derives Index_Iterator,
      --#         Index_Sym      from Dictionary.Dict,
      --#                             Type_Sym;
      is
      begin
         Index_Iterator := Dictionary.FirstArrayIndex (Type_Sym);
         if Dictionary.IsNullIterator (Index_Iterator) then
            Index_Sym := Dictionary.NullSymbol;
         else
            Index_Sym := Dictionary.CurrentSymbol (Index_Iterator);
         end if;
      end Get_First_Index;

      procedure Get_Next_Index (Index_Sym      :    out Dictionary.Symbol;
                                Index_Iterator : in out Dictionary.Iterator)
      --# global in Dictionary.Dict;
      --# derives Index_Iterator,
      --#         Index_Sym      from Dictionary.Dict,
      --#                             Index_Iterator;
      is
      begin
         Index_Iterator := Dictionary.NextSymbol (Index_Iterator);
         if Dictionary.IsNullIterator (Index_Iterator) then
            Index_Sym := Dictionary.NullSymbol;
         else
            Index_Sym := Dictionary.CurrentSymbol (Index_Iterator);
         end if;
      end Get_Next_Index;

      procedure Walk_Expression_As_Type_Mark
        (Exp_Node       : in     STree.SyntaxNode;
         Scope          : in     Dictionary.Scopes;
         Constraint_Sym :    out Dictionary.Symbol;
         The_Heap       : in out Heap.HeapRecord)
      --# global in     CommandLineData.Content;
      --#        in     ContextManager.Ops.File_Heap;
      --#        in     ContextManager.Ops.Unit_Heap;
      --#        in     ContextManager.Ops.Unit_Stack;
      --#        in out Dictionary.Dict;
      --#        in out ErrorHandler.Error_Context;
      --#        in out LexTokenManager.State;
      --#        in out SLI.State;
      --#        in out SPARK_IO.File_Sys;
      --#        in out Statistics.TableUsage;
      --#        in out STree.Table;
      --#           out Aggregate_Stack.State;
      --# derives Aggregate_Stack.State,
      --#         Constraint_Sym,
      --#         Dictionary.Dict,
      --#         LexTokenManager.State,
      --#         STree.Table                from CommandLineData.Content,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Dictionary.Dict,
      --#                                         Exp_Node,
      --#                                         LexTokenManager.State,
      --#                                         Scope,
      --#                                         STree.Table,
      --#                                         The_Heap &
      --#         ErrorHandler.Error_Context,
      --#         SLI.State,
      --#         SPARK_IO.File_Sys          from CommandLineData.Content,
      --#                                         ContextManager.Ops.File_Heap,
      --#                                         ContextManager.Ops.Unit_Heap,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         Exp_Node,
      --#                                         LexTokenManager.State,
      --#                                         Scope,
      --#                                         SLI.State,
      --#                                         SPARK_IO.File_Sys,
      --#                                         STree.Table,
      --#                                         The_Heap &
      --#         Statistics.TableUsage,
      --#         The_Heap                   from *,
      --#                                         CommandLineData.Content,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Dictionary.Dict,
      --#                                         Exp_Node,
      --#                                         LexTokenManager.State,
      --#                                         Scope,
      --#                                         STree.Table,
      --#                                         The_Heap;
      --# pre Syntax_Node_Type (Exp_Node, STree.Table) = SP_Symbols.expression;
      --# post STree.Table = STree.Table~;
      is
         Unwanted_Seq          : SeqAlgebra.Seq;
         Unused_Component_Data : ComponentManager.ComponentData;
         Constraint_Record     : Exp_Record;
      begin
         Heap.Reset (The_Heap);
         SeqAlgebra.CreateSeq (The_Heap, Unwanted_Seq);
         ComponentManager.Initialise (Unused_Component_Data);
         --# accept Flow, 10, Unused_Component_Data, "Expected ineffective assignment";
         Walk_Expression_P.Walk_Expression
           (Exp_Node                => Exp_Node,
            Scope                   => Scope,
            Type_Context            => Dictionary.GetUnknownTypeMark,
            Context_Requires_Static => False,
            Ref_Var                 => Unwanted_Seq,
            Result                  => Constraint_Record,
            Component_Data          => Unused_Component_Data,
            The_Heap                => The_Heap);
         --# end accept;
         SeqAlgebra.DisposeOfSeq (The_Heap, Unwanted_Seq);

         if Constraint_Record.Is_ARange then
            Constraint_Sym := Constraint_Record.Type_Symbol;
         else
            ErrorHandler.Semantic_Error
              (Err_Num   => 95,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Exp_Node),
               Id_Str    => LexTokenManager.Null_String);
            Constraint_Sym := Dictionary.GetUnknownTypeMark;
         end if;
         Heap.ReportUsage (The_Heap);
      end Walk_Expression_As_Type_Mark;

      procedure Get_First_Constraint
        (Constraint_Node         : in     STree.SyntaxNode;
         Scope                   : in     Dictionary.Scopes;
         Current_Constraint_Node :    out STree.SyntaxNode;
         Constraint_Sym          :    out Dictionary.Symbol;
         The_Heap                : in out Heap.HeapRecord)
      --# global in     CommandLineData.Content;
      --#        in     ContextManager.Ops.File_Heap;
      --#        in     ContextManager.Ops.Unit_Heap;
      --#        in     ContextManager.Ops.Unit_Stack;
      --#        in out Dictionary.Dict;
      --#        in out ErrorHandler.Error_Context;
      --#        in out LexTokenManager.State;
      --#        in out SLI.State;
      --#        in out SPARK_IO.File_Sys;
      --#        in out Statistics.TableUsage;
      --#        in out STree.Table;
      --#           out Aggregate_Stack.State;
      --# derives Aggregate_Stack.State,
      --#         Constraint_Sym,
      --#         Dictionary.Dict,
      --#         LexTokenManager.State,
      --#         STree.Table                from CommandLineData.Content,
      --#                                         Constraint_Node,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Dictionary.Dict,
      --#                                         LexTokenManager.State,
      --#                                         Scope,
      --#                                         STree.Table,
      --#                                         The_Heap &
      --#         Current_Constraint_Node    from Constraint_Node,
      --#                                         STree.Table &
      --#         ErrorHandler.Error_Context,
      --#         SLI.State,
      --#         SPARK_IO.File_Sys          from CommandLineData.Content,
      --#                                         Constraint_Node,
      --#                                         ContextManager.Ops.File_Heap,
      --#                                         ContextManager.Ops.Unit_Heap,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         LexTokenManager.State,
      --#                                         Scope,
      --#                                         SLI.State,
      --#                                         SPARK_IO.File_Sys,
      --#                                         STree.Table,
      --#                                         The_Heap &
      --#         Statistics.TableUsage,
      --#         The_Heap                   from *,
      --#                                         CommandLineData.Content,
      --#                                         Constraint_Node,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Dictionary.Dict,
      --#                                         LexTokenManager.State,
      --#                                         Scope,
      --#                                         STree.Table,
      --#                                         The_Heap;
      --# pre Syntax_Node_Type (Constraint_Node, STree.Table) = SP_Symbols.index_or_discriminant_constraint;
      --# post Syntax_Node_Type (Current_Constraint_Node, STree.Table) = SP_Symbols.expression and
      --#   STree.Table = STree.Table~;
      is
      begin
         Current_Constraint_Node := Child_Node (Current_Node => Child_Node (Current_Node => Constraint_Node));
         while Syntax_Node_Type (Node => Current_Constraint_Node) /= SP_Symbols.expression loop
            --# assert STree.Table = STree.Table~;
            -- ASSUME Current_Constraint_Node = positional_argument_association
            SystemErrors.RT_Assert
              (C       => Syntax_Node_Type (Node => Current_Constraint_Node) = SP_Symbols.positional_argument_association,
               Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Current_Constraint_Node = positional_argument_association in Get_First_Constraint");
            Current_Constraint_Node := Child_Node (Current_Node => Current_Constraint_Node);
         end loop;
         -- ASSUME Current_Constraint_Node = expression
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Current_Constraint_Node) = SP_Symbols.expression,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Current_Constraint_Node = expression in Get_First_Constraint");
         Walk_Expression_As_Type_Mark
           (Exp_Node       => Current_Constraint_Node,
            Scope          => Scope,
            Constraint_Sym => Constraint_Sym,
            The_Heap       => The_Heap);
      end Get_First_Constraint;

      procedure Get_Next_Constraint
        (Scope                   : in     Dictionary.Scopes;
         Current_Constraint_Node : in out STree.SyntaxNode;
         Constraint_Sym          :    out Dictionary.Symbol;
         The_Heap                : in out Heap.HeapRecord)
      --# global in     CommandLineData.Content;
      --#        in     ContextManager.Ops.File_Heap;
      --#        in     ContextManager.Ops.Unit_Heap;
      --#        in     ContextManager.Ops.Unit_Stack;
      --#        in out Aggregate_Stack.State;
      --#        in out Dictionary.Dict;
      --#        in out ErrorHandler.Error_Context;
      --#        in out LexTokenManager.State;
      --#        in out SLI.State;
      --#        in out SPARK_IO.File_Sys;
      --#        in out Statistics.TableUsage;
      --#        in out STree.Table;
      --# derives Aggregate_Stack.State,
      --#         Dictionary.Dict,
      --#         LexTokenManager.State,
      --#         Statistics.TableUsage,
      --#         STree.Table,
      --#         The_Heap                   from *,
      --#                                         CommandLineData.Content,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Current_Constraint_Node,
      --#                                         Dictionary.Dict,
      --#                                         LexTokenManager.State,
      --#                                         Scope,
      --#                                         STree.Table,
      --#                                         The_Heap &
      --#         Constraint_Sym             from CommandLineData.Content,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Current_Constraint_Node,
      --#                                         Dictionary.Dict,
      --#                                         LexTokenManager.State,
      --#                                         Scope,
      --#                                         STree.Table,
      --#                                         The_Heap &
      --#         Current_Constraint_Node    from *,
      --#                                         STree.Table &
      --#         ErrorHandler.Error_Context,
      --#         SLI.State,
      --#         SPARK_IO.File_Sys          from CommandLineData.Content,
      --#                                         ContextManager.Ops.File_Heap,
      --#                                         ContextManager.Ops.Unit_Heap,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Current_Constraint_Node,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         LexTokenManager.State,
      --#                                         Scope,
      --#                                         SLI.State,
      --#                                         SPARK_IO.File_Sys,
      --#                                         STree.Table,
      --#                                         The_Heap;
      --# pre Syntax_Node_Type (Current_Constraint_Node, STree.Table) = SP_Symbols.expression;
      --# post (Syntax_Node_Type (Current_Constraint_Node, STree.Table) = SP_Symbols.expression or
      --#         Current_Constraint_Node = STree.NullNode) and
      --#   STree.Table = STree.Table~;
      is
      begin
         Current_Constraint_Node := Next_Sibling (Current_Node => Parent_Node (Current_Node => Current_Constraint_Node));
         -- ASSUME Current_Constraint_Node = expression OR NULL
         if Current_Constraint_Node = STree.NullNode then
            -- ASSUME Current_Constraint_Node = NULL
            Constraint_Sym := Dictionary.NullSymbol;
         elsif Syntax_Node_Type (Node => Current_Constraint_Node) = SP_Symbols.expression then
            -- ASSUME Current_Constraint_Node = expression
            Walk_Expression_As_Type_Mark
              (Exp_Node       => Current_Constraint_Node,
               Scope          => Scope,
               Constraint_Sym => Constraint_Sym,
               The_Heap       => The_Heap);
         else
            Constraint_Sym := Dictionary.NullSymbol;
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Current_Constraint_Node = expression OR NULL in Get_Next_Constraint");
         end if;
      end Get_Next_Constraint;

   begin -- Check_Index_Constraints
      All_Indexes_OK := True;
      Get_First_Index (Type_Sym       => Type_Sym,
                       Index_Sym      => Index_Sym,
                       Index_Iterator => Index_Iterator);
      Get_First_Constraint
        (Constraint_Node         => Constraint_Node,
         Scope                   => Scope,
         Current_Constraint_Node => Current_Constraint_Node,
         Constraint_Sym          => Constraint_Sym,
         The_Heap                => The_Heap);
      while not Dictionary.Is_Null_Symbol (Index_Sym) and then Current_Constraint_Node /= STree.NullNode loop
         --# assert Syntax_Node_Type (Constraint_Node, STree.Table) = SP_Symbols.index_or_discriminant_constraint and
         --#   Syntax_Node_Type (Current_Constraint_Node, STree.Table) = SP_Symbols.expression and
         --#   STree.Table = STree.Table~;
         if not Dictionary.CompatibleTypes (Scope, Index_Sym, Constraint_Sym) then
            ErrorHandler.Semantic_Error_Sym2
              (Err_Num   => 107,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Current_Constraint_Node),
               Sym       => Constraint_Sym,
               Sym2      => Index_Sym,
               Scope     => Scope);
            All_Indexes_OK := False;
         end if;

         Constraint_First := Dictionary.GetScalarAttributeValue (False, LexTokenManager.First_Token, Constraint_Sym);
         Constraint_Last  := Dictionary.GetScalarAttributeValue (False, LexTokenManager.Last_Token, Constraint_Sym);

         -- Check that Constraint_Sym'First is OK wrt Index_Sym'First
         if Dictionary.IsPredefinedStringType (Type_Sym) then
            if LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Constraint_First,
               Lex_Str2 => LexTokenManager.One_Value) /=
              LexTokenManager.Str_Eq then
               ErrorHandler.Semantic_Error
                 (Err_Num   => 417,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Current_Constraint_Node),
                  Id_Str    => LexTokenManager.Null_String);
            end if;
         else
            Constraint_Check
              (Val           => Maths.ValueRep (Constraint_First),
               New_Val       => Result_Of_First_Check,
               Is_Annotation => False,
               Typ           => Index_Sym,
               Position      => Node_Position (Node => Current_Constraint_Node));
            if Result_Of_First_Check = Maths.NoValue then
               All_Indexes_OK := False;
            end if;

         end if;

         -- Check that Constraint_Sym'Last is OK wrt Index_Sym'Last
         Constraint_Check
           (Val           => Maths.ValueRep (Constraint_Last),
            New_Val       => Result_Of_Last_Check,
            Is_Annotation => False,
            Typ           => Index_Sym,
            Position      => Node_Position (Node => Current_Constraint_Node));
         if Result_Of_Last_Check = Maths.NoValue then
            All_Indexes_OK := False;
         end if;

         Dictionary.AddArrayIndex
           (TheArrayType  => Subtype_Sym,
            IndexType     => Constraint_Sym,
            Comp_Unit     => ContextManager.Ops.Current_Unit,
            Declaration   => Dictionary.Location'(Start_Position => Node_Position (Node => Current_Constraint_Node),
                                                  End_Position   => Node_Position (Node => Current_Constraint_Node)),
            TheArrayIndex => The_Array_Index);
         STree.Add_Node_Symbol (Node => Current_Constraint_Node,
                                Sym  => The_Array_Index);
         Get_Next_Index (Index_Sym      => Index_Sym,
                         Index_Iterator => Index_Iterator);
         Get_Next_Constraint
           (Scope                   => Scope,
            Current_Constraint_Node => Current_Constraint_Node,
            Constraint_Sym          => Constraint_Sym,
            The_Heap                => The_Heap);
      end loop;
      if not Dictionary.Is_Null_Symbol (Index_Sym) or else Current_Constraint_Node /= STree.NullNode then
         ErrorHandler.Semantic_Error
           (Err_Num   => 93,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Constraint_Node),
            Id_Str    => LexTokenManager.Null_String);
         All_Indexes_OK := False;
      end if;
   end Check_Index_Constraints;

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

   procedure Check_Real_Accuracy
     (Node     : in     STree.SyntaxNode;
      Scope    : in     Dictionary.Scopes;
      Sort     : in     Real_Type;
      Accuracy :    out LexTokenManager.Lex_String;
      Static   :    out Boolean;
      The_Heap : in out Heap.HeapRecord)
   --# global in     CommandLineData.Content;
   --#        in     ContextManager.Ops.File_Heap;
   --#        in     ContextManager.Ops.Unit_Heap;
   --#        in     ContextManager.Ops.Unit_Stack;
   --#        in out Aggregate_Stack.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out LexTokenManager.State;
   --#        in out SLI.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out STree.Table;
   --# derives Accuracy                   from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         Sort,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         Aggregate_Stack.State,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         Statistics.TableUsage,
   --#         STree.Table                from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         SLI.State,
   --#                                         Sort,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         SLI.State                  from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         Static,
   --#         The_Heap                   from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.floating_point_constraint or
   --#   Syntax_Node_Type (Node, STree.Table) = SP_Symbols.fixed_point_constraint;
   --# post STree.Table = STree.Table~;
   is
      Exp_Node              : STree.SyntaxNode;
      Accuracy_Type         : Exp_Record;
      Unwanted_Seq          : SeqAlgebra.Seq;
      Unused_Component_Data : ComponentManager.ComponentData;

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

      function Type_Correct
        (Type_Sym : Dictionary.Symbol;
         Scope    : Dictionary.Scopes;
         Sort     : Real_Type)
        return     Boolean
      --# global in Dictionary.Dict;
      is
         Result : Boolean;
      begin
         if Sort = Is_Floating then
            Result := Dictionary.IsIntegerTypeMark (Type_Sym, Scope);
         else
            Result := Dictionary.IsRealTypeMark (Type_Sym, Scope);
         end if;
         return Result or else Dictionary.IsUnknownTypeMark (Type_Sym);
      end Type_Correct;

   begin -- Check_Real_Accuracy
      Heap.Reset (The_Heap);
      ComponentManager.Initialise (Unused_Component_Data);

      case CommandLineData.Content.Language_Profile is
         when CommandLineData.SPARK83 =>
            Exp_Node := Child_Node (Current_Node => Child_Node (Current_Node => Node));
            -- ASSUME Exp_Node = simple_expression
            SystemErrors.RT_Assert
              (C       => Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.simple_expression,
               Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Exp_Node = simple_expression in Check_Real_Accuracy");
            SeqAlgebra.CreateSeq (The_Heap, Unwanted_Seq);
            --# accept Flow, 10, Unused_Component_Data, "Expected ineffective assignment";
            Walk_Expression_P.Walk_Expression
              (Exp_Node                => Exp_Node,
               Scope                   => Scope,
               Type_Context            => Dictionary.GetUnknownTypeMark,
               Context_Requires_Static => True,
               Ref_Var                 => Unwanted_Seq,
               Result                  => Accuracy_Type,
               Component_Data          => Unused_Component_Data,
               The_Heap                => The_Heap);
            --# end accept;
            SeqAlgebra.DisposeOfSeq (The_Heap, Unwanted_Seq);
            Maths.StorageRep (Accuracy_Type.Value, Accuracy);
            if not Type_Correct (Type_Sym => Accuracy_Type.Type_Symbol,
                                 Scope    => Scope,
                                 Sort     => Sort) then
               Accuracy := LexTokenManager.Null_String;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 38,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Node),
                  Id_Str    => LexTokenManager.Null_String);
            end if;
            Static := Accuracy_Type.Is_Static;
         when CommandLineData.SPARK95_Onwards =>
            -- reduced accuracy subtypes of reals are not allowed in 95 onwards
            Static   := True; -- to reduce knock-on errors
            Accuracy := LexTokenManager.Null_String;
            ErrorHandler.Semantic_Error
              (Err_Num   => 608,
               Reference => 9,
               Position  => Node_Position (Node => Node),
               Id_Str    => LexTokenManager.Null_String);
      end case;
      Heap.ReportUsage (The_Heap);
   end Check_Real_Accuracy;

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

   procedure Check_Range
     (Node         : in     STree.SyntaxNode;
      Type_Sym     : in     Dictionary.Symbol;
      Scope        : in     Dictionary.Scopes;
      Static       : in out Boolean;
      Lower, Upper :    out LexTokenManager.Lex_String;
      The_Heap     : in out Heap.HeapRecord)
   --# global in     CommandLineData.Content;
   --#        in     ContextManager.Ops.File_Heap;
   --#        in     ContextManager.Ops.Unit_Heap;
   --#        in     ContextManager.Ops.Unit_Stack;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out LexTokenManager.State;
   --#        in out SLI.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out STree.Table;
   --#           out Aggregate_Stack.State;
   --# derives Aggregate_Stack.State,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         Lower,
   --#         STree.Table,
   --#         Upper                      from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap,
   --#                                         Type_Sym &
   --#         ErrorHandler.Error_Context,
   --#         SLI.State,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         The_Heap,
   --#                                         Type_Sym &
   --#         Static,
   --#         Statistics.TableUsage,
   --#         The_Heap                   from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap,
   --#                                         Type_Sym;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.arange and
   --#   (Dictionary.Is_Null_Symbol (Type_Sym) or Dictionary.IsTypeMark (Type_Sym, Dictionary.Dict));
   --# post STree.Table = STree.Table~;
   is
      Range_Result                                               : Exp_Record;
      Unwanted_Seq                                               : SeqAlgebra.Seq;
      Unused_Component_Data                                      : ComponentManager.ComponentData;
      Upper_After_Constraint_Check, Lower_After_Constraint_Check : Maths.Value;
      RHS_Node                                                   : STree.SyntaxNode;
   begin
      Heap.Reset (The_Heap);
      SeqAlgebra.CreateSeq (The_Heap, Unwanted_Seq);
      ComponentManager.Initialise (Unused_Component_Data);
      --# accept Flow, 10, Unused_Component_Data, "Expected ineffective assignment";
      Walk_Expression_P.Walk_Expression
        (Exp_Node                => Node,
         Scope                   => Scope,
         Type_Context            => Type_Sym,
         Context_Requires_Static => False,
         Ref_Var                 => Unwanted_Seq,
         Result                  => Range_Result,
         Component_Data          => Unused_Component_Data,
         The_Heap                => The_Heap);
      --# end accept;
      SeqAlgebra.DisposeOfSeq (The_Heap, Unwanted_Seq);
      Static := Static and then Range_Result.Is_Static;
      Maths.StorageRep (Range_Result.Value, Lower);
      Maths.StorageRep (Range_Result.Range_RHS, Upper);

      -- check that range is constant
      if not Range_Result.Is_Constant then
         Lower := LexTokenManager.Null_String;
         Upper := LexTokenManager.Null_String;
         ErrorHandler.Semantic_Error
           (Err_Num   => 43,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;
      if not Dictionary.CompatibleTypes (Scope, Range_Result.Type_Symbol, Type_Sym) then
         Lower := LexTokenManager.Null_String;
         Upper := LexTokenManager.Null_String;
         ErrorHandler.Semantic_Error_Sym2
           (Err_Num   => 107,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Node),
            Sym       => Range_Result.Type_Symbol,
            Sym2      => Type_Sym,
            Scope     => Scope);
      end if;

      -- checks for bounds outside type being constrained
      -- see whether node is attribute or X..Y form and select suitable place
      -- to report errors on upper range bound
      RHS_Node := Child_Node (Current_Node => Node);
      -- ASSUME RHS_Node = attribute OR simple_expression
      if Syntax_Node_Type (Node => RHS_Node) = SP_Symbols.attribute then
         -- ASSUME RHS_Node = attribute
         RHS_Node := Node;
      elsif Syntax_Node_Type (Node => RHS_Node) = SP_Symbols.simple_expression then
         -- ASSUME RHS_Node = simple_expression
         -- must be of form X..Y
         RHS_Node := Next_Sibling (Current_Node => RHS_Node);
      else
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => RHS_Node) = SP_Symbols.attribute
              or else Syntax_Node_Type (Node => RHS_Node) = SP_Symbols.simple_expression,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect RHS_Node = attribute OR simple_expression in Check_Range");
      end if;
      -- ASSUME RHS_Node = arange OR simple_expression
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => RHS_Node) = SP_Symbols.arange
           or else Syntax_Node_Type (Node => RHS_Node) = SP_Symbols.simple_expression,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect RHS_Node = arange OR simple_expression in Check_Range");

      Constraint_Check
        (Val           => Maths.ValueRep (Lower),
         New_Val       => Lower_After_Constraint_Check,
         Is_Annotation => False,
         Typ           => Type_Sym,
         Position      => Node_Position (Node => Node));
      Maths.StorageRep (Lower_After_Constraint_Check, Lower);

      Constraint_Check
        (Val           => Maths.ValueRep (Upper),
         New_Val       => Upper_After_Constraint_Check,
         Is_Annotation => False,
         Typ           => Type_Sym,
         Position      => Node_Position (Node => RHS_Node));
      Maths.StorageRep (Upper_After_Constraint_Check, Upper);

      Heap.ReportUsage (The_Heap);
   end Check_Range;

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

   procedure Check_Real_Range
     (Node         : in     STree.SyntaxNode;
      Type_Sym     : in     Dictionary.Symbol;
      Scope        : in     Dictionary.Scopes;
      Static       : in out Boolean;
      Lower, Upper :    out LexTokenManager.Lex_String;
      The_Heap     : in out Heap.HeapRecord)
   --# global in     CommandLineData.Content;
   --#        in     ContextManager.Ops.File_Heap;
   --#        in     ContextManager.Ops.Unit_Heap;
   --#        in     ContextManager.Ops.Unit_Stack;
   --#        in out Aggregate_Stack.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out LexTokenManager.State;
   --#        in out SLI.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out STree.Table;
   --# derives Aggregate_Stack.State,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         Static,
   --#         Statistics.TableUsage,
   --#         STree.Table                from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap,
   --#                                         Type_Sym &
   --#         ErrorHandler.Error_Context,
   --#         SLI.State,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         The_Heap,
   --#                                         Type_Sym &
   --#         Lower,
   --#         The_Heap,
   --#         Upper                      from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap,
   --#                                         Type_Sym;
   --# pre (Syntax_Node_Type (Node, STree.Table) = SP_Symbols.floating_point_constraint or
   --#        Syntax_Node_Type (Node, STree.Table) = SP_Symbols.fixed_point_constraint) and
   --#   (Dictionary.Is_Null_Symbol (Type_Sym) or Dictionary.IsTypeMark (Type_Sym, Dictionary.Dict));
   --# post STree.Table = STree.Table~;
   is
      Range_Node : STree.SyntaxNode;
   begin
      Range_Node := Next_Sibling (Current_Node => Child_Node (Current_Node => Node));
      -- ASSUME Range_Node = range_constraint OR NULL
      if Range_Node = STree.NullNode then
         -- ASSUME Range_Node = NULL
         -- no range supplied so range is unchanged from parent type
         Upper :=
           Dictionary.GetScalarAttributeValue (False, --no 'base
                                               LexTokenManager.Last_Token, Type_Sym);
         Lower :=
           Dictionary.GetScalarAttributeValue (False, --no 'base
                                               LexTokenManager.First_Token, Type_Sym);
      elsif Syntax_Node_Type (Node => Range_Node) = SP_Symbols.range_constraint then
         -- ASSUME Range_Node = range_constraint
         -- a range is supplied
         Range_Node := Child_Node (Current_Node => Range_Node);
         -- ASSUME Range_Node = arange
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Range_Node) = SP_Symbols.arange,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Range_Node = arange in Check_Real_Range");
         Check_Range
           (Node     => Range_Node,
            Type_Sym => Type_Sym,
            Scope    => Scope,
            Static   => Static,
            Lower    => Lower,
            Upper    => Upper,
            The_Heap => The_Heap);
      else
         Lower := LexTokenManager.Null_String;
         Upper := LexTokenManager.Null_String;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Range_Node = range_constraint OR NULL in Check_Real_Range");
      end if;
   end Check_Real_Range;

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

   procedure Add_Scalar_Subtype
     (Accuracy          : in LexTokenManager.Lex_String;
      Id_Str            : in LexTokenManager.Lex_String;
      Ident_Node        : in STree.SyntaxNode;
      Type_Node_Pos     : in LexTokenManager.Token_Position;
      Type_Sym          : in Dictionary.Symbol;
      Scope             : in Dictionary.Scopes;
      Subtype_Is_Static : in Boolean;
      Lower, Upper      : in LexTokenManager.Lex_String)
   --# global in     CommandLineData.Content;
   --#        in     ContextManager.Ops.File_Heap;
   --#        in     ContextManager.Ops.Unit_Heap;
   --#        in     ContextManager.Ops.Unit_Stack;
   --#        in     ErrorHandler.Error_Context;
   --#        in     LexTokenManager.State;
   --#        in out Dictionary.Dict;
   --#        in out SLI.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out STree.Table;
   --# derives Dictionary.Dict,
   --#         STree.Table       from Accuracy,
   --#                                ContextManager.Ops.Unit_Stack,
   --#                                Dictionary.Dict,
   --#                                Ident_Node,
   --#                                Id_Str,
   --#                                LexTokenManager.State,
   --#                                Lower,
   --#                                Scope,
   --#                                STree.Table,
   --#                                Subtype_Is_Static,
   --#                                Type_Sym,
   --#                                Upper &
   --#         SLI.State         from *,
   --#                                Accuracy,
   --#                                CommandLineData.Content,
   --#                                ContextManager.Ops.Unit_Heap,
   --#                                ContextManager.Ops.Unit_Stack,
   --#                                Dictionary.Dict,
   --#                                ErrorHandler.Error_Context,
   --#                                Ident_Node,
   --#                                Id_Str,
   --#                                LexTokenManager.State,
   --#                                Lower,
   --#                                Scope,
   --#                                STree.Table,
   --#                                Subtype_Is_Static,
   --#                                Type_Sym,
   --#                                Upper &
   --#         SPARK_IO.File_Sys from *,
   --#                                Accuracy,
   --#                                CommandLineData.Content,
   --#                                ContextManager.Ops.File_Heap,
   --#                                ContextManager.Ops.Unit_Heap,
   --#                                ContextManager.Ops.Unit_Stack,
   --#                                Dictionary.Dict,
   --#                                ErrorHandler.Error_Context,
   --#                                Ident_Node,
   --#                                Id_Str,
   --#                                LexTokenManager.State,
   --#                                Lower,
   --#                                Scope,
   --#                                SLI.State,
   --#                                STree.Table,
   --#                                Subtype_Is_Static,
   --#                                Type_Node_Pos,
   --#                                Type_Sym,
   --#                                Upper;
   --# pre Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;
   --# post STree.Table = STree.Table~;
   is
      Subtype_Symbol : Dictionary.Symbol;
   begin
      if Dictionary.TypeIsInteger (Type_Sym) then
         Dictionary.Add_Integer_Subtype
           (Name             => Id_Str,
            Static           => Subtype_Is_Static,
            Parent           => Type_Sym,
            Parent_Reference => Dictionary.Location'(Start_Position => Type_Node_Pos,
                                                     End_Position   => Type_Node_Pos),
            Lower            => Lower,
            Upper            => Upper,
            Comp_Unit        => ContextManager.Ops.Current_Unit,
            Declaration      => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                                     End_Position   => Node_Position (Node => Ident_Node)),
            Scope            => Scope,
            Context          => Dictionary.ProgramContext,
            The_Subtype      => Subtype_Symbol);
      elsif Dictionary.TypeIsModular (Type_Sym) then
         Dictionary.Add_Modular_Subtype
           (Name             => Id_Str,
            Parent           => Type_Sym,
            Parent_Reference => Dictionary.Location'(Start_Position => Type_Node_Pos,
                                                     End_Position   => Type_Node_Pos),
            Lower            => Lower,
            Upper            => Upper,
            Comp_Unit        => ContextManager.Ops.Current_Unit,
            Declaration      => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                                     End_Position   => Node_Position (Node => Ident_Node)),
            Scope            => Scope,
            Context          => Dictionary.ProgramContext,
            The_Subtype      => Subtype_Symbol);
      elsif Dictionary.TypeIsEnumeration (Type_Sym) then
         Dictionary.Add_Enumeration_Subtype
           (Name             => Id_Str,
            Static           => Subtype_Is_Static,
            Parent           => Type_Sym,
            Parent_Reference => Dictionary.Location'(Start_Position => Type_Node_Pos,
                                                     End_Position   => Type_Node_Pos),
            Lower            => Lower,
            Upper            => Upper,
            Comp_Unit        => ContextManager.Ops.Current_Unit,
            Declaration      => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                                     End_Position   => Node_Position (Node => Ident_Node)),
            Scope            => Scope,
            Context          => Dictionary.ProgramContext,
            The_Subtype      => Subtype_Symbol);
      elsif Dictionary.TypeIsFloatingPoint (Type_Sym) then
         Dictionary.Add_Floating_Point_Subtype
           (Name             => Id_Str,
            Static           => Subtype_Is_Static,
            Parent           => Type_Sym,
            Parent_Reference => Dictionary.Location'(Start_Position => Type_Node_Pos,
                                                     End_Position   => Type_Node_Pos),
            Lower            => Lower,
            Upper            => Upper,
            Error_Bound      => Accuracy,
            Comp_Unit        => ContextManager.Ops.Current_Unit,
            Declaration      => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                                     End_Position   => Node_Position (Node => Ident_Node)),
            Scope            => Scope,
            Context          => Dictionary.ProgramContext,
            The_Subtype      => Subtype_Symbol);
      elsif Dictionary.TypeIsFixedPoint (Type_Sym) then
         Dictionary.Add_Fixed_Point_Subtype
           (Name             => Id_Str,
            Static           => Subtype_Is_Static,
            Parent           => Type_Sym,
            Parent_Reference => Dictionary.Location'(Start_Position => Type_Node_Pos,
                                                     End_Position   => Type_Node_Pos),
            Lower            => Lower,
            Upper            => Upper,
            Error_Bound      => Accuracy,
            Comp_Unit        => ContextManager.Ops.Current_Unit,
            Declaration      => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                                     End_Position   => Node_Position (Node => Ident_Node)),
            Scope            => Scope,
            Context          => Dictionary.ProgramContext,
            The_Subtype      => Subtype_Symbol);
      else
         Subtype_Symbol := Dictionary.NullSymbol;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "in Add_Scalar_Subtype");
      end if;
      STree.Add_Node_Symbol (Node => Ident_Node,
                             Sym  => Subtype_Symbol);
      if ErrorHandler.Generate_SLI then
         SLI.Generate_Xref_Symbol
           (Comp_Unit      => ContextManager.Ops.Current_Unit,
            Parse_Tree     => Ident_Node,
            Symbol         => Subtype_Symbol,
            Is_Declaration => True);
      end if;
   end Add_Scalar_Subtype;

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

   function Already_Defined (Ident_Str : LexTokenManager.Lex_String;
                             Scope     : Dictionary.Scopes) return Boolean
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   is
      Sym : Dictionary.Symbol;
   begin
      Sym :=
        Dictionary.LookupItem (Name              => Ident_Str,
                               Scope             => Scope,
                               Context           => Dictionary.ProofContext,
                               Full_Package_Name => False);

      return not (Dictionary.Is_Null_Symbol (Sym)
                    or else (Dictionary.IsTypeMark (Sym)
                               and then Dictionary.TypeIsAnnounced (TheType => Sym)
                               and then not Dictionary.Is_Declared (Item => Sym)));
   end Already_Defined;

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

   function Select_Index_Or_Discriminant_Error (Constraint_Node : STree.SyntaxNode) return Natural
   --# global in CommandLineData.Content;
   --#        in STree.Table;
   --# pre Syntax_Node_Type (Constraint_Node, STree.Table) = SP_Symbols.index_or_discriminant_constraint;
   is
      Result : Natural;
   begin
      -- if an index_or_discriminant_constraint is applied to an inapplicable type we need to report and
      -- error.  This function tries to narrow the scope of the error message returned.
      if CommandLineData.Ravenscar_Selected then
         -- we could be expecting an array, task or protected type
         if Is_Named_Association (Node => Constraint_Node) then
            -- must be Task or protected
            Result := 891;
         else
            -- could be any of Task, Protected, Array
            Result := 892;
         end if;
      else
         -- can only be an array
         Result := 41;
      end if;
      return Result;
   end Select_Index_Or_Discriminant_Error;

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

   procedure Wf_Ravenscar_Subtype
     (Id_Str          : in     LexTokenManager.Lex_String;
      Type_Sym        : in     Dictionary.Symbol;
      Scope           : in     Dictionary.Scopes;
      Ident_Node      : in     STree.SyntaxNode;
      Constraint_Node : in     STree.SyntaxNode;
      The_Heap        : in out Heap.HeapRecord)
   --# global in     CommandLineData.Content;
   --#        in     ContextManager.Ops.File_Heap;
   --#        in     ContextManager.Ops.Unit_Heap;
   --#        in     ContextManager.Ops.Unit_Stack;
   --#        in out Aggregate_Stack.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out LexTokenManager.State;
   --#        in out SLI.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out STree.Table;
   --# derives Aggregate_Stack.State,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         Statistics.TableUsage,
   --#         STree.Table,
   --#         The_Heap                   from *,
   --#                                         CommandLineData.Content,
   --#                                         Constraint_Node,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         Ident_Node,
   --#                                         Id_Str,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap,
   --#                                         Type_Sym &
   --#         ErrorHandler.Error_Context,
   --#         SLI.State,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Constraint_Node,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Ident_Node,
   --#                                         Id_Str,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         The_Heap,
   --#                                         Type_Sym;
   --# pre Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier and
   --#   Syntax_Node_Type (Constraint_Node, STree.Table) = SP_Symbols.index_or_discriminant_constraint;
   --# post STree.Table = STree.Table~;
      is separate;

begin -- Wf_Subtype_Declaration
   Lower    := LexTokenManager.Null_String;
   Upper    := LexTokenManager.Null_String;
   Accuracy := LexTokenManager.Null_String;

   Ident_Node := Child_Node (Current_Node => Node);
   -- ASSUME Ident_Node = identifier
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.identifier,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Ident_Node = identifier in Wf_Subtype_Declaration");
   Id_Str := Node_Lex_String (Node => Ident_Node);

   if Already_Defined (Ident_Str => Id_Str,
                       Scope     => Scope) then
      Ok_To_Add := False;
      ErrorHandler.Semantic_Error
        (Err_Num   => 10,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Ident_Node),
         Id_Str    => Id_Str);
   else
      Ok_To_Add := True;
   end if;

   Type_Node := Child_Node (Current_Node => Next_Sibling (Current_Node => Ident_Node));
   -- ASSUME Type_Node = type_mark
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Type_Node) = SP_Symbols.type_mark,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Type_Node = type_mark in Wf_Subtype_Declaration");

   Wf_Type_Mark (Node          => Type_Node,
                 Current_Scope => Scope,
                 Context       => Dictionary.ProgramContext,
                 Type_Sym      => Type_Sym);

   -- Subtypes of generic types are not allowed because we can't check whether the bounds will be valid
   -- when they are instantiated
   if Dictionary.TypeIsGeneric (Type_Sym) then
      Ok_To_Add := False;
      ErrorHandler.Semantic_Error
        (Err_Num   => 652,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Type_Node),
         Id_Str    => LexTokenManager.Null_String);
   end if;

   Constraint_Node := Next_Sibling (Current_Node => Type_Node);
   -- ASSUME Constraint_Node = constraint OR NULL
   if Syntax_Node_Type (Node => Constraint_Node) = SP_Symbols.constraint then
      Constraint_Found := True;
   elsif Constraint_Node = STree.NullNode then
      Constraint_Found := False;
   else
      Constraint_Found := False;
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Constraint_Node = constraint OR NULL in Wf_Subtype_Declaration");
   end if;

   -- test to prevent Boolean subtype unless full-range
   if Constraint_Found and then Dictionary.TypeIsBoolean (Type_Sym) then
      Ok_To_Add := False;
      ErrorHandler.Semantic_Error
        (Err_Num   => 412,
         Reference => 15,
         Position  => Node_Position (Node => Constraint_Node),
         Id_Str    => LexTokenManager.Null_String);
   end if;

   --# assert Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier and
   --#   Syntax_Node_Type (Type_Node, STree.Table) = SP_Symbols.type_mark and
   --#   (Syntax_Node_Type (Constraint_Node, STree.Table) = SP_Symbols.constraint or
   --#      Constraint_Node = STree.NullNode) and
   --#   (Dictionary.Is_Null_Symbol (Type_Sym) or Dictionary.IsTypeMark (Type_Sym, Dictionary.Dict)) and
   --#   STree.Table = STree.Table~;

   if Ok_To_Add and then not Dictionary.IsUnknownTypeMark (Type_Sym) then
      if Constraint_Found then
         Constraint_Node := Child_Node (Current_Node => Constraint_Node);
         -- ASSUME Constraint_Node = range_constraint OR floating_point_constraint OR fixed_point_constraint OR
         --                          index_or_discriminant_constraint
         -- there is a constraint node so proceed as before
         if Syntax_Node_Type (Node => Constraint_Node) = SP_Symbols.index_or_discriminant_constraint then
            -- ASSUME Constraint_Node = index_or_discriminant_constraint
            if Dictionary.IsArrayTypeMark (Type_Sym, Scope) then
               if Is_Named_Association (Node => Constraint_Node) then
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 92,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Constraint_Node),
                     Id_Str    => LexTokenManager.Null_String);
               else -- positional association is ok
                  if Dictionary.Is_Unconstrained_Array_Type_Mark (Type_Sym, Scope) then
                     Dictionary.Add_Array_Subtype
                       (Name             => Id_Str,
                        Parent           => Type_Sym,
                        Parent_Reference => Dictionary.Location'(Start_Position => Node_Position (Node => Type_Node),
                                                                 End_Position   => Node_Position (Node => Type_Node)),
                        Comp_Unit        => ContextManager.Ops.Current_Unit,
                        Declaration      => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                                                 End_Position   => Node_Position (Node => Ident_Node)),
                        Scope            => Scope,
                        Context          => Dictionary.ProgramContext,
                        Static           => False,
                        The_Subtype      => Subtype_Sym);
                     STree.Add_Node_Symbol (Node => Ident_Node,
                                            Sym  => Subtype_Sym);
                     if ErrorHandler.Generate_SLI then
                        SLI.Generate_Xref_Symbol
                          (Comp_Unit      => ContextManager.Ops.Current_Unit,
                           Parse_Tree     => Ident_Node,
                           Symbol         => Subtype_Sym,
                           Is_Declaration => True);
                     end if;
                     Check_Index_Constraints
                       (Constraint_Node => Constraint_Node,
                        Scope           => Scope,
                        Subtype_Sym     => Subtype_Sym,
                        Type_Sym        => Type_Sym,
                        All_Indexes_OK  => All_Indexes_OK,
                        The_Heap        => The_Heap);
                     Dictionary.SetTypeIsWellformed (Subtype_Sym, All_Indexes_OK);
                  else -- array already constrained
                     ErrorHandler.Semantic_Error
                       (Err_Num   => 99,
                        Reference => ErrorHandler.No_Reference,
                        Position  => Node_Position (Node => Type_Node),
                        Id_Str    => LexTokenManager.Null_String);
                  end if;
               end if; -- illegal named association fo index_constraint
            elsif Dictionary.IsProtectedType (Type_Sym) or else Dictionary.IsTaskType (Type_Sym) then
               Wf_Ravenscar_Subtype
                 (Id_Str          => Id_Str,
                  Type_Sym        => Type_Sym,
                  Scope           => Scope,
                  Ident_Node      => Ident_Node,
                  Constraint_Node => Constraint_Node,
                  The_Heap        => The_Heap);
            else
               -- a type has been supplied for which index_or_discriminant_constraint is
               -- not appropriate
               ErrorHandler.Semantic_Error
                 (Err_Num   => Select_Index_Or_Discriminant_Error (Constraint_Node => Constraint_Node),
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Type_Node),
                  Id_Str    => LexTokenManager.Null_String);
            end if;
         else
            -- ASSUME Constraint_Node = range_constraint OR floating_point_constraint OR fixed_point_constraint
            -- some scalar subtype expected
            if not Dictionary.TypeIsScalar (Type_Sym) then
               ErrorHandler.Semantic_Error
                 (Err_Num   => 59,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Type_Node),
                  Id_Str    => LexTokenManager.Null_String);
            else
               Subtype_Is_Static := True; -- default value
               if Syntax_Node_Type (Node => Constraint_Node) = SP_Symbols.range_constraint then
                  -- ASSUME Constraint_Node = range_constraint
                  Constraint_Node := Child_Node (Current_Node => Constraint_Node);
                  -- ASSUME Constraint_Node = arange
                  SystemErrors.RT_Assert
                    (C       => Syntax_Node_Type (Node => Constraint_Node) = SP_Symbols.arange,
                     Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                     Msg     => "Expect Constraint_Node = arange in Wf_Subtype_Declaration");
                  Check_Range
                    (Node     => Constraint_Node,
                     Type_Sym => Type_Sym,
                     Scope    => Scope,
                     Static   => Subtype_Is_Static,
                     Lower    => Lower,
                     Upper    => Upper,
                     The_Heap => The_Heap);

                  -- if constraint is a range but type is real then no accuracy
                  -- has been supplied so we need to get it from parent
                  if Dictionary.TypeIsFloatingPoint (Type_Sym) then
                     Accuracy := Dictionary.GetScalarAttributeValue (False, LexTokenManager.Digits_Token, Type_Sym);
                  elsif Dictionary.TypeIsFixedPoint (Type_Sym) then
                     Accuracy := Dictionary.GetScalarAttributeValue (False, LexTokenManager.Delta_Token, Type_Sym);
                  end if;
                  Subtype_Is_Static := Subtype_Is_Static and then Dictionary.IsStatic (Type_Sym, Scope);

               elsif Syntax_Node_Type (Node => Constraint_Node) = SP_Symbols.floating_point_constraint then
                  -- ASSUME Constraint_Node = floating_point_constraint
                  if not Dictionary.TypeIsFloatingPoint (Type_Sym) then
                     ErrorHandler.Semantic_Error
                       (Err_Num   => 100,
                        Reference => ErrorHandler.No_Reference,
                        Position  => Node_Position (Node => Type_Node),
                        Id_Str    => LexTokenManager.Null_String);
                  else
                     Check_Real_Accuracy
                       (Node     => Constraint_Node,
                        Scope    => Scope,
                        Sort     => Is_Floating,
                        Accuracy => Accuracy,
                        Static   => Subtype_Is_Static,
                        The_Heap => The_Heap);
                     SystemErrors.RT_Assert
                       (C       => Dictionary.Is_Null_Symbol (Type_Sym) or else Dictionary.IsTypeMark (Type_Sym),
                        Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                        Msg     => "Expect Type_Sym to be a type in Wf_Subtype_Declaration");
                     Check_Real_Range
                       (Node     => Constraint_Node,
                        Type_Sym => Type_Sym,
                        Scope    => Scope,
                        Static   => Subtype_Is_Static,
                        Lower    => Lower,
                        Upper    => Upper,
                        The_Heap => The_Heap);
                  end if;

               elsif Syntax_Node_Type (Node => Constraint_Node) = SP_Symbols.fixed_point_constraint then
                  -- ASSUME Constraint_Node = fixed_point_constraint
                  if not Dictionary.TypeIsFixedPoint (Type_Sym) then
                     ErrorHandler.Semantic_Error
                       (Err_Num   => 101,
                        Reference => ErrorHandler.No_Reference,
                        Position  => Node_Position (Node => Type_Node),
                        Id_Str    => LexTokenManager.Null_String);
                  else
                     Check_Real_Accuracy
                       (Node     => Constraint_Node,
                        Scope    => Scope,
                        Sort     => Is_Fixed,
                        Accuracy => Accuracy,
                        Static   => Subtype_Is_Static,
                        The_Heap => The_Heap);
                     SystemErrors.RT_Assert
                       (C       => Dictionary.Is_Null_Symbol (Type_Sym) or else Dictionary.IsTypeMark (Type_Sym),
                        Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                        Msg     => "Expect Type_Sym to be a type in Wf_Subtype_Declaration");
                     Check_Real_Range
                       (Node     => Constraint_Node,
                        Type_Sym => Type_Sym,
                        Scope    => Scope,
                        Static   => Subtype_Is_Static,
                        Lower    => Lower,
                        Upper    => Upper,
                        The_Heap => The_Heap);
                  end if;
               else
                  SystemErrors.Fatal_Error
                    (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                     Msg     => "Expect Constraint_Node = range_constraint OR floating_point_constraint OR " &
                       "fixed_point_constraint OR index_or_discriminant_constraint in Wf_Subtype_Declaration");
               end if;
               Add_Scalar_Subtype
                 (Accuracy          => Accuracy,
                  Id_Str            => Id_Str,
                  Ident_Node        => Ident_Node,
                  Type_Node_Pos     => Node_Position (Node => Type_Node),
                  Type_Sym          => Type_Sym,
                  Scope             => Scope,
                  Subtype_Is_Static => Subtype_Is_Static,
                  Lower             => Lower,
                  Upper             => Upper);
            end if;
         end if;
      else  -- no constraint node present
         Dictionary.Add_Full_Range_Subtype
           (Name             => Id_Str,
            Parent           => Type_Sym,
            Parent_Reference => Dictionary.Location'(Start_Position => Node_Position (Node => Type_Node),
                                                     End_Position   => Node_Position (Node => Type_Node)),
            Comp_Unit        => ContextManager.Ops.Current_Unit,
            Declaration      => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                                     End_Position   => Node_Position (Node => Ident_Node)),
            Scope            => Scope,
            Context          => Dictionary.ProgramContext,
            The_Subtype      => Subtype_Symbol);
         STree.Add_Node_Symbol (Node => Ident_Node,
                                Sym  => Subtype_Symbol);
         if ErrorHandler.Generate_SLI then
            SLI.Generate_Xref_Symbol
              (Comp_Unit      => ContextManager.Ops.Current_Unit,
               Parse_Tree     => Ident_Node,
               Symbol         => Subtype_Symbol,
               Is_Declaration => True);
         end if;
      end if;
   end if;
end Wf_Subtype_Declaration;
