-------------------------------------------------------------------------------
-- (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_Full_Type_Declaration)
procedure Wf_Known_Discriminant_Part
  (Node               : in STree.SyntaxNode;
   Protected_Type_Sym : in Dictionary.Symbol;
   Scope              : in Dictionary.Scopes)
is
   --------------------------------------------------------------------------------------------------
   -- Rules:
   --          (1) identifier not already visible
   --          (2) access     -> type_mark is protected type (or susp obj type later)
   --          (3) not access -> type is discrete
   --------------------------------------------------------------------------------------------------

   It        : STree.Iterator;
   Next_Node : STree.SyntaxNode;

   procedure Check_Discriminant
     (Node               : in STree.SyntaxNode;
      Protected_Type_Sym : in Dictionary.Symbol;
      Scope              : in Dictionary.Scopes)
   --# global in     CommandLineData.Content;
   --#        in     ContextManager.Ops.Unit_Stack;
   --#        in     LexTokenManager.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --#        in out STree.Table;
   --# derives Dictionary.Dict            from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Protected_Type_Sym,
   --#                                         Scope,
   --#                                         STree.Table &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Protected_Type_Sym,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table &
   --#         STree.Table                from *,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.discriminant_specification;
   --# post STree.Table = STree.Table~;
   is
      Type_Sym              : Dictionary.Symbol;
      Is_Access             : Boolean;
      Type_Node, Ident_Node : STree.SyntaxNode;

      procedure Check_Identifiers
        (Node               : in STree.SyntaxNode;
         Type_Mark          : in Dictionary.Symbol;
         Protected_Type_Sym : in Dictionary.Symbol;
         Scope              : in Dictionary.Scopes)
      --# global in     CommandLineData.Content;
      --#        in     ContextManager.Ops.Unit_Stack;
      --#        in     LexTokenManager.State;
      --#        in     STree.Table;
      --#        in out Dictionary.Dict;
      --#        in out ErrorHandler.Error_Context;
      --#        in out SPARK_IO.File_Sys;
      --# derives Dictionary.Dict            from *,
      --#                                         CommandLineData.Content,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         LexTokenManager.State,
      --#                                         Node,
      --#                                         Protected_Type_Sym,
      --#                                         Scope,
      --#                                         STree.Table,
      --#                                         Type_Mark &
      --#         ErrorHandler.Error_Context,
      --#         SPARK_IO.File_Sys          from CommandLineData.Content,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         LexTokenManager.State,
      --#                                         Node,
      --#                                         Protected_Type_Sym,
      --#                                         Scope,
      --#                                         SPARK_IO.File_Sys,
      --#                                         STree.Table,
      --#                                         Type_Mark;
      --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.identifier_list;
      is
         It        : STree.Iterator;
         Next_Node : STree.SyntaxNode;
         Ident_Str : LexTokenManager.Lex_String;
         Sym       : Dictionary.Symbol;
      begin
         It := Find_First_Node (Node_Kind    => SP_Symbols.identifier,
                                From_Root    => Node,
                                In_Direction => STree.Down);
         while not STree.IsNull (It) loop
            Next_Node := Get_Node (It => It);
            --# assert Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.identifier and
            --#   Next_Node = Get_Node (It);
            Ident_Str := Node_Lex_String (Node => Next_Node);
            Sym       :=
              Dictionary.LookupItem
              (Name              => Ident_Str,
               Scope             => Scope,
               Context           => Dictionary.ProofContext,
               Full_Package_Name => False);
            if Dictionary.Is_Null_Symbol (Sym) then
               Dictionary.AddKnownDiscriminant
                 (Name                => Ident_Str,
                  Comp_Unit           => ContextManager.Ops.Current_Unit,
                  Declaration         => Dictionary.Location'(Start_Position => Node_Position (Node => Next_Node),
                                                              End_Position   => Node_Position (Node => Next_Node)),
                  ProtectedOrTaskType => Protected_Type_Sym,
                  TypeMark            => Type_Mark);
            else -- already exists
               ErrorHandler.Semantic_Error
                 (Err_Num   => 10,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Next_Node),
                  Id_Str    => Ident_Str);
            end if;
            It := STree.NextNode (It);
         end loop;
      end Check_Identifiers;

   begin -- Check_Discriminant

      -- check type mark is valid
      Is_Access := False;
      Type_Node := Next_Sibling (Current_Node => Child_Node (Current_Node => Node));
      -- ASSUME Type_Node = type_mark OR access_definition
      if Syntax_Node_Type (Node => Type_Node) = SP_Symbols.access_definition then
         -- ASSUME Type_Node = access_definition
         Is_Access := True;
         Type_Node := Child_Node (Current_Node => Type_Node);
      elsif Syntax_Node_Type (Node => Type_Node) /= SP_Symbols.type_mark then
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Type_Node = type_mark OR access_definition in Check_Discriminant");
      end if;
      -- 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 Check_Discriminant");
      Wf_Type_Mark (Node          => Type_Node,
                    Current_Scope => Scope,
                    Context       => Dictionary.ProgramContext,
                    Type_Sym      => Type_Sym);
      if not Dictionary.IsUnknownTypeMark (Type_Sym) then
         if Is_Access then
            -- only a protected type is allowed
            if Dictionary.IsProtectedTypeMark (Type_Sym) then
               if Dictionary.Types_Are_Equal
                 (Left_Symbol        => Type_Sym,
                  Right_Symbol       => Protected_Type_Sym,
                  Full_Range_Subtype => False) then
                  -- "recursive" use in discriminant
                  Type_Sym := Dictionary.GetUnknownTypeMark;
                  -- This error cannot be checked because access types are not
                  -- allowed as descriminants
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 902,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Type_Node),
                     Id_Str    => Dictionary.GetSimpleName (Type_Sym));
               else
                  Type_Sym := Dictionary.GetAccess (Type_Sym);
               end if;
            else
               Type_Sym := Dictionary.GetUnknownTypeMark;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 875,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Type_Node),
                  Id_Str    => LexTokenManager.Null_String);
            end if;
         else
            -- only a discrete type is allowed
            if not Dictionary.TypeIsDiscrete (Type_Sym) then
               Type_Sym := Dictionary.GetUnknownTypeMark;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 46,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Type_Node),
                  Id_Str    => LexTokenManager.Null_String);
            end if;
         end if;
      end if; -- UnknownType

      -- check each identifier associated with type
      Ident_Node := Child_Node (Current_Node => Node);
      -- ASSUME Ident_Node = identifier_list
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.identifier_list,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Ident_Node = identifier_list in Check_Discriminant");
      Check_Identifiers (Node               => Ident_Node,
                         Type_Mark          => Type_Sym,
                         Protected_Type_Sym => Protected_Type_Sym,
                         Scope              => Scope);
   end Check_Discriminant;

begin -- Wf_Known_Discriminant_Part
   It := Find_First_Node (Node_Kind    => SP_Symbols.discriminant_specification,
                          From_Root    => Node,
                          In_Direction => STree.Down);
   while not STree.IsNull (It) loop
      Next_Node := Get_Node (It => It);
      --# assert STree.Table = STree.Table~ and
      --#   Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.discriminant_specification and
      --#   Next_Node = Get_Node (It);
      Check_Discriminant (Node               => Next_Node,
                          Protected_Type_Sym => Protected_Type_Sym,
                          Scope              => Scope);
      It := STree.NextNode (It);
   end loop;
end Wf_Known_Discriminant_Part;
