-------------------------------------------------------------------------------
-- (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.Wf_Basic_Declarative_Item.Wf_Basic_Declaration.Wf_Subtype_Declaration)
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)
is
   The_Subtype : Dictionary.Symbol;
   Assoc_Node  : STree.SyntaxNode;

   procedure Process_Expression
     (Exp_Node    : in     STree.SyntaxNode;
      Formal_Sym  : in     Dictionary.Symbol;
      Type_Sym    : in     Dictionary.Symbol;
      Subtype_Sym : in     Dictionary.Symbol;
      Scope       : in     Dictionary.Scopes;
      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,
   --#         STree.Table                from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         Exp_Node,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         Dictionary.Dict,
   --#         LexTokenManager.State      from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         Exp_Node,
   --#                                         Formal_Sym,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         Subtype_Sym,
   --#                                         The_Heap,
   --#                                         Type_Sym &
   --#         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,
   --#                                         Exp_Node,
   --#                                         Formal_Sym,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         Subtype_Sym,
   --#                                         The_Heap,
   --#                                         Type_Sym &
   --#         SLI.State                  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,
   --#                                         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
      Result                : Exp_Record;
      Unwanted_Seq          : SeqAlgebra.Seq;
      Unused_Component_Data : ComponentManager.ComponentData;
      Static_Value          : LexTokenManager.Lex_String;
      Pragma_Kind           : Dictionary.RavenscarPragmasWithValue;
      Value_Rep             : LexTokenManager.Lex_String;
   begin
      Heap.Reset (The_Heap);
      ComponentManager.Initialise (Unused_Component_Data);
      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 => False,
         Ref_Var                 => Unwanted_Seq,
         Result                  => Result,
         Component_Data          => Unused_Component_Data,
         The_Heap                => The_Heap);
      --# end accept;
      SeqAlgebra.DisposeOfSeq (The_Heap, Unwanted_Seq);
      Assignment_Check
        (Position    => Node_Position (Node => Exp_Node),
         Scope       => Scope,
         Target_Type => Dictionary.GetType (Formal_Sym),
         Exp_Result  => Result);
      if Result.Is_Static then
         Maths.StorageRep (Result.Value, Static_Value);
         Dictionary.AddDiscriminantConstraintStaticValue
           (ProtectedOrTaskSubtype => Subtype_Sym,
            Comp_Unit              => ContextManager.Ops.Current_Unit,
            Declaration            => Dictionary.Location'(Start_Position => Node_Position (Node => Exp_Node),
                                                           End_Position   => Node_Position (Node => Exp_Node)),
            TheValue               => Static_Value);
         if Dictionary.SetsPriority (Formal_Sym) then
            if Dictionary.GetTypeHasPragma (Type_Sym, Dictionary.Priority) then
               Pragma_Kind := Dictionary.Priority;
            else
               -- must be
               Pragma_Kind := Dictionary.InterruptPriority;
            end if;
            Check_Priority_Range
              (Error_Sym   => Subtype_Sym,
               Scope       => Scope,
               Pragma_Kind => Pragma_Kind,
               Err_Pos     => Node_Position (Node => Exp_Node),
               Value       => Result.Value,
               Value_Rep   => Value_Rep);
            -- Value_Rep is either a storage rep of a valid value or a null string; we can always add it to dict
            Dictionary.SetSubtypePriority (Subtype_Sym, Value_Rep);
         end if;
      elsif Dictionary.TypeIsAccess (Dictionary.GetType (Formal_Sym)) then
         Dictionary.AddDiscriminantConstraintAccessedObject
           (ProtectedOrTaskSubtype => Subtype_Sym,
            Comp_Unit              => ContextManager.Ops.Current_Unit,
            Declaration            => Dictionary.Location'(Start_Position => Node_Position (Node => Exp_Node),
                                                           End_Position   => Node_Position (Node => Exp_Node)),
            TheObject              => Result.Variable_Symbol);
         -- N.B. VariableSymbol is the accessed _variable_ name, put there by wf_attribute_designator
      else
         -- not static and not a protected types so must be wrong
         ErrorHandler.Semantic_Error
           (Err_Num   => 36,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Exp_Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;
   end Process_Expression;

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

   procedure Handle_Named_Association
     (Node        : in     STree.SyntaxNode;
      Type_Sym    : in     Dictionary.Symbol;
      Subtype_Sym : in     Dictionary.Symbol;
      Scope       : in     Dictionary.Scopes;
      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,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         Subtype_Sym,
   --#                                         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,
   --#                                         Subtype_Sym,
   --#                                         The_Heap,
   --#                                         Type_Sym;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.named_argument_association;
   --# post STree.Table = STree.Table~;
   is
      It              : Dictionary.Iterator;
      Expression_Node : STree.SyntaxNode;
   begin
      Check_Named_Association (The_Formals               => Type_Sym,
                               Scope                     => Scope,
                               Named_Argument_Assoc_Node => Node);
      -- Loop through all the formals
      It := Dictionary.FirstKnownDiscriminant (Type_Sym);
      while not Dictionary.IsNullIterator (It) loop
         --# assert Syntax_Node_Type (Node, STree.Table) = SP_Symbols.named_argument_association and
         --#   STree.Table = STree.Table~;
         Find_Actual_Node
           (For_Formal                => Dictionary.CurrentSymbol (It),
            Named_Argument_Assoc_Node => Node,
            Expression_Node           => Expression_Node);
         -- ASSUME Expression_Node = expression OR NULL
         --# check Syntax_Node_Type (Expression_Node, STree.Table) = SP_Symbols.expression or
         --#   Expression_Node = STree.NullNode;
         if Syntax_Node_Type (Node => Expression_Node) = SP_Symbols.expression then
            -- ASSUME Expression_Node = expression
            Process_Expression
              (Exp_Node    => Expression_Node,
               Formal_Sym  => Dictionary.CurrentSymbol (It),
               Type_Sym    => Type_Sym,
               Subtype_Sym => Subtype_Sym,
               Scope       => Scope,
               The_Heap    => The_Heap);
         end if;
         It := Dictionary.NextSymbol (It);
      end loop;
   end Handle_Named_Association;

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

   procedure Handle_Positional_Association
     (Node        : in     STree.SyntaxNode;
      Type_Sym    : in     Dictionary.Symbol;
      Subtype_Sym : in     Dictionary.Symbol;
      Scope       : in     Dictionary.Scopes;
      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,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         Subtype_Sym,
   --#                                         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,
   --#                                         Subtype_Sym,
   --#                                         The_Heap,
   --#                                         Type_Sym;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.positional_argument_association;
   --# post STree.Table = STree.Table~;
   is
      Expression_Node  : STree.SyntaxNode;
      Formal_It        : Dictionary.Iterator;
      Actual_It        : STree.Iterator;
      Formal_Parameter : Dictionary.Symbol;
   begin
      Formal_It := Dictionary.FirstKnownDiscriminant (Type_Sym);
      Actual_It := Find_First_Node (Node_Kind    => SP_Symbols.expression,
                                    From_Root    => Node,
                                    In_Direction => STree.Down);
      while not Dictionary.IsNullIterator (Formal_It) and then not STree.IsNull (Actual_It) loop
         Formal_Parameter := Dictionary.CurrentSymbol (Formal_It);
         Expression_Node  := Get_Node (It => Actual_It);
         --# assert Syntax_Node_Type (Expression_Node, STree.Table) = SP_Symbols.expression and
         --#   Expression_Node = Get_Node (Actual_It) and
         --#   STree.Table = STree.Table~;
         Process_Expression
           (Exp_Node    => Expression_Node,
            Formal_Sym  => Formal_Parameter,
            Type_Sym    => Type_Sym,
            Subtype_Sym => Subtype_Sym,
            Scope       => Scope,
            The_Heap    => The_Heap);
         Formal_It := Dictionary.NextSymbol (Formal_It);
         Actual_It := STree.NextNode (Actual_It);
      end loop;

      if not Dictionary.IsNullIterator (Formal_It) or else not STree.IsNull (Actual_It) then
         ErrorHandler.Semantic_Error_Sym
           (Err_Num   => 893,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Node),
            Sym       => Type_Sym,
            Scope     => Scope);
      end if;
   end Handle_Positional_Association;

begin -- Wf_Ravenscar_Subtype
   Dictionary.Add_Task_Or_Protected_Subtype
     (Name        => Id_Str,
      Parent      => Type_Sym,
      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 => The_Subtype);
   STree.Add_Node_Symbol (Node => Ident_Node,
                          Sym  => The_Subtype);
   if ErrorHandler.Generate_SLI then
      SLI.Generate_Xref_Symbol
        (Comp_Unit      => ContextManager.Ops.Current_Unit,
         Parse_Tree     => Ident_Node,
         Symbol         => The_Subtype,
         Is_Declaration => True);
   end if;
   Assoc_Node := Child_Node (Current_Node => Child_Node (Current_Node => Constraint_Node));
   -- ASSUME Assoc_Node = named_argument_association OR positional_argument_association
   if Syntax_Node_Type (Node => Assoc_Node) = SP_Symbols.named_argument_association then
      -- ASSUME Assoc_Node = named_argument_association
      Handle_Named_Association
        (Node        => Assoc_Node,
         Type_Sym    => Type_Sym,
         Subtype_Sym => The_Subtype,
         Scope       => Scope,
         The_Heap    => The_Heap);
   elsif Syntax_Node_Type (Node => Assoc_Node) = SP_Symbols.positional_argument_association then
      -- ASSUME Assoc_Node = positional_argument_association
      Handle_Positional_Association
        (Node        => Assoc_Node,
         Type_Sym    => Type_Sym,
         Subtype_Sym => The_Subtype,
         Scope       => Scope,
         The_Heap    => The_Heap);
   else
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Assoc_Node = named_argument_association OR positional_argument_association in Wf_Ravenscar_Subtype");
   end if;
   -- Check that subtype has a priority, if one has not been set then inherit parent's
   if LexTokenManager.Lex_String_Case_Insensitive_Compare
     (Lex_Str1 => Dictionary.GetTypePriority (The_Subtype),
      Lex_Str2 => LexTokenManager.Null_String) =
     LexTokenManager.Str_Eq then
      Dictionary.SetSubtypePriority (The_Subtype, Dictionary.GetTypePriority (Type_Sym));
   end if;
end Wf_Ravenscar_Subtype;
