-------------------------------------------------------------------------------
-- (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 (Dictionary)
procedure AddInheritsReference
  (The_Unit             : in     Symbol;
   The_Inherited_Symbol : in     Symbol;
   Explicit             : in     Boolean;
   Comp_Unit            : in     ContextManager.UnitDescriptors;
   Declaration          : in     Location;
   Already_Present      :    out Boolean) is
   The_Inherited_Package    : RawDict.Package_Info_Ref;
   The_Inherited_Subprogram : RawDict.Subprogram_Info_Ref;
   The_Context_Clause       : RawDict.Context_Clause_Info_Ref;
   Need_To_Add              : Boolean;

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

   procedure Add_Inherits_Annotation (The_Inherited_Symbol : in Symbol;
                                      The_Unit             : in Symbol;
                                      Declaration          : in Location)
   --# global in     Dict;
   --#        in     LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --# derives SPARK_IO.File_Sys from *,
   --#                                Declaration,
   --#                                Dict,
   --#                                LexTokenManager.State,
   --#                                The_Inherited_Symbol,
   --#                                The_Unit;
   is
   begin
      if SPARK_IO.Is_Open (Dict.TemporaryFile) then
         Write_String (Dict.TemporaryFile, "inherits annotation of ");
         Write_Name (File => Dict.TemporaryFile,
                     Item => The_Inherited_Symbol);
         Write_String (Dict.TemporaryFile, " in ");
         Write_Name (File => Dict.TemporaryFile,
                     Item => The_Unit);
         Write_String (Dict.TemporaryFile, " is at ");
         Write_Location (File => Dict.TemporaryFile,
                         Loc  => Declaration);
         Write_Line (Dict.TemporaryFile, " ;");
      end if;
   end Add_Inherits_Annotation;

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

   procedure Add_Package_Inherits_Reference (The_Context_Clause : in RawDict.Context_Clause_Info_Ref;
                                             The_Package        : in RawDict.Package_Info_Ref)
   --# global in out Dict;
   --# derives Dict from *,
   --#                   The_Context_Clause,
   --#                   The_Package;
   is
   begin
      RawDict.Set_Next_Context_Clause
        (The_Context_Clause => The_Context_Clause,
         Next               => RawDict.Get_Package_Inherit_Clauses (The_Package => The_Package));
      RawDict.Set_Package_Inherit_Clauses (The_Package        => The_Package,
                                           The_Context_Clause => The_Context_Clause);
   end Add_Package_Inherits_Reference;

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

   procedure Add_Subprogram_Inherits_Reference
     (The_Context_Clause : in RawDict.Context_Clause_Info_Ref;
      The_Subprogram     : in RawDict.Subprogram_Info_Ref)
   --# global in out Dict;
   --# derives Dict from *,
   --#                   The_Context_Clause,
   --#                   The_Subprogram;
   is
   begin
      RawDict.Set_Next_Context_Clause
        (The_Context_Clause => The_Context_Clause,
         Next               => RawDict.Get_Subprogram_Inherit_Clauses (The_Subprogram => The_Subprogram));
      RawDict.Set_Subprogram_Inherit_Clauses (The_Subprogram     => The_Subprogram,
                                              The_Inherit_Clause => The_Context_Clause);
      if Get_The_Partition /= RawDict.Null_Subprogram_Info_Ref and then The_Subprogram = Get_Main_Program then
         RawDict.Set_Subprogram_Inherit_Clauses (The_Subprogram     => Get_The_Partition,
                                                 The_Inherit_Clause => The_Context_Clause);
      end if;
   end Add_Subprogram_Inherits_Reference;

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

   procedure Check_If_Already_Present
     (The_Inherited_Symbol : in     Symbol;
      The_Unit             : in     Symbol;
      Explicit             : in     Boolean;
      Already_Present      :    out Boolean;
      Need_To_Add          :    out Boolean)
   --# global in out Dict;
   --# derives Already_Present,
   --#         Dict            from Dict,
   --#                              Explicit,
   --#                              The_Inherited_Symbol,
   --#                              The_Unit &
   --#         Need_To_Add     from Dict,
   --#                              The_Inherited_Symbol,
   --#                              The_Unit;
   is
      The_Inherited_Package    : RawDict.Package_Info_Ref;
      The_Inherited_Subprogram : RawDict.Subprogram_Info_Ref;
      The_Context_Clause       : RawDict.Context_Clause_Info_Ref;
   begin
      Already_Present := False;
      Need_To_Add     := True;

      case RawDict.GetSymbolDiscriminant (The_Unit) is
         when Package_Symbol =>
            The_Context_Clause := RawDict.Get_Package_Inherit_Clauses
              (The_Package => RawDict.Get_Package_Info_Ref (Item => The_Unit)); -- GAA External
         when Subprogram_Symbol =>
            The_Context_Clause := RawDict.Get_Subprogram_Inherit_Clauses
              (The_Subprogram => RawDict.Get_Subprogram_Info_Ref (Item => The_Unit)); -- GAA External
         when others => -- non-exec code
            The_Context_Clause := RawDict.Null_Context_Clause_Info_Ref;
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Symbol_Table,
               Msg     => "in Dictionary.Check_If_Already_Present");
      end case;

      case RawDict.GetSymbolDiscriminant (The_Inherited_Symbol) is
         when Package_Symbol =>
            The_Inherited_Package := RawDict.Get_Package_Info_Ref (Item => The_Inherited_Symbol); -- GAA External
            loop
               exit when The_Context_Clause = RawDict.Null_Context_Clause_Info_Ref;
               if not RawDict.Get_Context_Clause_Is_Subprogram (The_Context_Clause => The_Context_Clause)
                 and then RawDict.Get_Context_Clause_Package (The_Context_Clause => The_Context_Clause) = The_Inherited_Package then
                  Need_To_Add := False;
                  if Explicit then
                     if RawDict.Get_Context_Clause_Explicit (The_Context_Clause => The_Context_Clause) then
                        Already_Present := True;
                     else
                        RawDict.Set_Context_Clause_Explicit (The_Context_Clause => The_Context_Clause);
                     end if;
                  end if;
                  exit;
               end if;
               The_Context_Clause := RawDict.Get_Next_Context_Clause (The_Context_Clause => The_Context_Clause);
            end loop;
         when Subprogram_Symbol | ImplicitProofFunctionSymbol =>
            case RawDict.GetSymbolDiscriminant (The_Inherited_Symbol) is
               when Subprogram_Symbol =>
                  The_Inherited_Subprogram := RawDict.Get_Subprogram_Info_Ref (Item => The_Inherited_Symbol); -- GAA External
               when ImplicitProofFunctionSymbol =>
                  The_Inherited_Subprogram := RawDict.GetImplicitProofFunctionAdaFunction (The_Inherited_Symbol);
               when others =>
                  The_Inherited_Subprogram := RawDict.Null_Subprogram_Info_Ref;
                  SystemErrors.Fatal_Error
                    (Sys_Err => SystemErrors.Invalid_Symbol_Table,
                     Msg     => "in Dictionary.Check_If_Already_Present");
            end case;
            loop
               exit when The_Context_Clause = RawDict.Null_Context_Clause_Info_Ref;
               if RawDict.Get_Context_Clause_Is_Subprogram (The_Context_Clause => The_Context_Clause)
                 and then RawDict.Get_Context_Clause_Subprogram (The_Context_Clause => The_Context_Clause) = The_Inherited_Subprogram then
                  Need_To_Add := False;
                  if Explicit then
                     if RawDict.Get_Context_Clause_Explicit (The_Context_Clause => The_Context_Clause) then
                        Already_Present := True;
                     else
                        RawDict.Set_Context_Clause_Explicit (The_Context_Clause => The_Context_Clause);
                     end if;
                  end if;
                  exit;
               end if;
               The_Context_Clause := RawDict.Get_Next_Context_Clause (The_Context_Clause => The_Context_Clause);
            end loop;
         when others => -- non-exec code
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Symbol_Table,
               Msg     => "in Dictionary.Check_If_Already_Present");
      end case;
   end Check_If_Already_Present;

begin -- AddInheritsReference
   Check_If_Already_Present
     (The_Inherited_Symbol => The_Inherited_Symbol,
      The_Unit             => The_Unit,
      Explicit             => Explicit,
      Already_Present      => Already_Present,
      Need_To_Add          => Need_To_Add);
   if Need_To_Add then
      Add_Inherits_Annotation (The_Inherited_Symbol => The_Inherited_Symbol,
                               The_Unit             => The_Unit,
                               Declaration          => Declaration);
      case RawDict.GetSymbolDiscriminant (The_Inherited_Symbol) is
         when Package_Symbol =>
            The_Inherited_Package    := RawDict.Get_Package_Info_Ref (Item => The_Inherited_Symbol); -- GAA External
            The_Inherited_Subprogram := RawDict.Null_Subprogram_Info_Ref;
         when Subprogram_Symbol =>
            The_Inherited_Package    := RawDict.Null_Package_Info_Ref;
            The_Inherited_Subprogram := RawDict.Get_Subprogram_Info_Ref (Item => The_Inherited_Symbol); -- GAA External
         when ImplicitProofFunctionSymbol =>
            The_Inherited_Package    := RawDict.Null_Package_Info_Ref;
            The_Inherited_Subprogram := RawDict.GetImplicitProofFunctionAdaFunction (The_Inherited_Symbol);
         when others => -- non-exec code
            The_Inherited_Package    := RawDict.Null_Package_Info_Ref;
            The_Inherited_Subprogram := RawDict.Null_Subprogram_Info_Ref;
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Symbol_Table,
               Msg     => "in Dictionary.AddInheritsReference");
      end case;
      RawDict.Create_Context_Clause
        (The_Package        => The_Inherited_Package,
         The_Subprogram     => The_Inherited_Subprogram,
         Explicit           => Explicit,
         Comp_Unit          => Comp_Unit,
         Loc                => Declaration.Start_Position,
         The_Context_Clause => The_Context_Clause);

      case RawDict.GetSymbolDiscriminant (The_Unit) is
         when Package_Symbol =>
            Add_Package_Inherits_Reference
              (The_Context_Clause => The_Context_Clause,
               The_Package        => RawDict.Get_Package_Info_Ref (Item => The_Unit)); -- GAA External
         when Subprogram_Symbol =>
            Add_Subprogram_Inherits_Reference
              (The_Context_Clause => The_Context_Clause,
               The_Subprogram     => RawDict.Get_Subprogram_Info_Ref (Item => The_Unit)); -- GAA External
         when others => -- non-exec code
            SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Invalid_Symbol_Table,
                                      Msg     => "in Dictionary.AddInheritsReference");
      end case;
      AddOtherReference (The_Inherited_Symbol, The_Unit, Declaration);
   end if;
end AddInheritsReference;
