-------------------------------------------------------------------------------
-- (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 AddWithReference
  (The_Visibility    : in     Visibility;
   The_Unit          : in     Symbol;
   The_Withed_Symbol : in     Symbol;
   Explicit          : in     Boolean;
   Comp_Unit         : in     ContextManager.UnitDescriptors;
   Declaration       : in     Location;
   Already_Present   :    out Boolean) is
   The_Withed_Package    : RawDict.Package_Info_Ref;
   The_Withed_Subprogram : RawDict.Subprogram_Info_Ref;
   The_Generic_Unit      : RawDict.Generic_Unit_Info_Ref;
   The_Context_Clause    : RawDict.Context_Clause_Info_Ref;
   Need_To_Add           : Boolean;

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

   procedure Add_With_Clause (The_Withed_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_Unit,
   --#                                The_Withed_Symbol;
   is
   begin
      if SPARK_IO.Is_Open (Dict.TemporaryFile) then
         Write_String (Dict.TemporaryFile, "with clause of ");
         Write_Name (File => Dict.TemporaryFile,
                     Item => The_Withed_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_With_Clause;

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

   procedure Add_Package_Visible_With_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_Visible_With_Clauses (The_Package => The_Package));
      RawDict.Set_Package_Visible_With_Clauses (The_Package        => The_Package,
                                                The_Context_Clause => The_Context_Clause);
   end Add_Package_Visible_With_Reference;

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

   procedure Add_Package_Local_With_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_Local_With_Clauses (The_Package => The_Package));
      RawDict.Set_Package_Local_With_Clauses (The_Package        => The_Package,
                                              The_Context_Clause => The_Context_Clause);
   end Add_Package_Local_With_Reference;

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

   procedure Add_Subprogram_With_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_With_Clauses (The_Subprogram => The_Subprogram));
      RawDict.Set_Subprogram_With_Clauses (The_Subprogram     => The_Subprogram,
                                           The_Context_Clause => The_Context_Clause);
   end Add_Subprogram_With_Reference;

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

   procedure Add_Protected_Type_With_Reference
     (The_Context_Clause : in RawDict.Context_Clause_Info_Ref;
      The_Protected_Type : in RawDict.Type_Info_Ref)
   --# global in out Dict;
   --# derives Dict from *,
   --#                   The_Context_Clause,
   --#                   The_Protected_Type;
   is
   begin
      RawDict.Set_Next_Context_Clause
        (The_Context_Clause => The_Context_Clause,
         Next               => RawDict.Get_Protected_Type_With_Clauses (The_Protected_Type => The_Protected_Type));
      RawDict.Set_Protected_Type_With_Clauses (The_Protected_Type => The_Protected_Type,
                                               The_Context_Clause => The_Context_Clause);
   end Add_Protected_Type_With_Reference;

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

   procedure Add_Task_Type_With_Reference
     (The_Context_Clause : in RawDict.Context_Clause_Info_Ref;
      The_Task_Type      : in RawDict.Type_Info_Ref)
   --# global in out Dict;
   --# derives Dict from *,
   --#                   The_Context_Clause,
   --#                   The_Task_Type;
   is
   begin
      RawDict.Set_Next_Context_Clause
        (The_Context_Clause => The_Context_Clause,
         Next               => RawDict.Get_Task_Type_With_Clauses (The_Task_Type => The_Task_Type));
      RawDict.Set_Task_Type_With_Clauses (The_Task_Type      => The_Task_Type,
                                          The_Context_Clause => The_Context_Clause);
   end Add_Task_Type_With_Reference;

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

   procedure Check_If_Already_Present
     (The_Withed_Symbol : in     Symbol;
      The_Visibility    : in     Visibility;
      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_Unit,
   --#                              The_Visibility,
   --#                              The_Withed_Symbol &
   --#         Need_To_Add     from Dict,
   --#                              The_Unit,
   --#                              The_Visibility,
   --#                              The_Withed_Symbol;
   is
      The_Withed_Package    : RawDict.Package_Info_Ref;
      The_Withed_Subprogram : RawDict.Subprogram_Info_Ref;
      The_Generic_Unit      : RawDict.Generic_Unit_Info_Ref;
      The_Context_Clause    : RawDict.Context_Clause_Info_Ref;
   begin
      Already_Present := False;
      Need_To_Add     := True;

      case The_Visibility is
         when Visible | Privat =>
            case RawDict.GetSymbolDiscriminant (The_Unit) is
               when Package_Symbol =>
                  The_Context_Clause := RawDict.Get_Package_Visible_With_Clauses
                    (The_Package => RawDict.Get_Package_Info_Ref (Item => The_Unit)); -- GAA External
               when Generic_Unit_Symbol =>
                  The_Generic_Unit := RawDict.Get_Generic_Unit_Info_Ref (Item => The_Unit); -- GAA External
                  case RawDict.Get_Generic_Unit_Kind (The_Generic_Unit => The_Generic_Unit) is
                     when Generic_Of_Package =>
                        The_Context_Clause := RawDict.Get_Package_Visible_With_Clauses
                          (The_Package => RawDict.Get_Generic_Unit_Owning_Package (The_Generic_Unit => The_Generic_Unit));
                     when Generic_Of_Subprogram =>
                        The_Context_Clause := RawDict.Get_Subprogram_With_Clauses
                          (The_Subprogram => RawDict.Get_Generic_Unit_Owning_Subprogram (The_Generic_Unit => The_Generic_Unit));
                  end case;
               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;
         when Local =>
            case RawDict.GetSymbolDiscriminant (The_Unit) is
               when Package_Symbol =>
                  The_Context_Clause := RawDict.Get_Package_Local_With_Clauses
                    (The_Package => RawDict.Get_Package_Info_Ref (Item => The_Unit)); -- GAA External
               when Subprogram_Symbol =>
                  The_Context_Clause := RawDict.Get_Subprogram_With_Clauses
                    (The_Subprogram => RawDict.Get_Subprogram_Info_Ref (Item => The_Unit)); -- GAA External
               when Type_Symbol =>
                  case RawDict.Get_Type_Discriminant (Type_Mark => RawDict.Get_Type_Info_Ref (Item => The_Unit)) is -- GAA External
                     when Protected_Type_Item =>
                        The_Context_Clause := RawDict.Get_Protected_Type_With_Clauses
                          (The_Protected_Type => RawDict.Get_Type_Info_Ref (Item => The_Unit)); -- GAA External
                     when Task_Type_Item =>
                        The_Context_Clause :=
                          RawDict.Get_Task_Type_With_Clauses (The_Task_Type => RawDict.Get_Type_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;
               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;
      end case;

      case RawDict.GetSymbolDiscriminant (The_Withed_Symbol) is
         when Package_Symbol =>
            The_Withed_Package := RawDict.Get_Package_Info_Ref (Item => The_Withed_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_Withed_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_Withed_Symbol) is
               when Subprogram_Symbol =>
                  The_Withed_Subprogram := RawDict.Get_Subprogram_Info_Ref (Item => The_Withed_Symbol); -- GAA External
               when ImplicitProofFunctionSymbol =>
                  The_Withed_Subprogram := RawDict.GetImplicitProofFunctionAdaFunction (The_Withed_Symbol);
               when others =>
                  The_Withed_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_Withed_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 -- AddWithReference
   Check_If_Already_Present
     (The_Withed_Symbol => The_Withed_Symbol,
      The_Visibility    => The_Visibility,
      The_Unit          => The_Unit,
      Explicit          => Explicit,
      Already_Present   => Already_Present,
      Need_To_Add       => Need_To_Add);
   if Need_To_Add then
      Add_With_Clause (The_Withed_Symbol => The_Withed_Symbol,
                       The_Unit          => The_Unit,
                       Declaration       => Declaration);
      case RawDict.GetSymbolDiscriminant (The_Withed_Symbol) is
         when Package_Symbol =>
            The_Withed_Package    := RawDict.Get_Package_Info_Ref (Item => The_Withed_Symbol); -- GAA External
            The_Withed_Subprogram := RawDict.Null_Subprogram_Info_Ref;
         when Subprogram_Symbol =>
            The_Withed_Package    := RawDict.Null_Package_Info_Ref;
            The_Withed_Subprogram := RawDict.Get_Subprogram_Info_Ref (Item => The_Withed_Symbol); -- GAA External
         when ImplicitProofFunctionSymbol =>
            The_Withed_Package    := RawDict.Null_Package_Info_Ref;
            The_Withed_Subprogram := RawDict.GetImplicitProofFunctionAdaFunction (The_Withed_Symbol);
         when others => -- non-exec code
            The_Withed_Package    := RawDict.Null_Package_Info_Ref;
            The_Withed_Subprogram := RawDict.Null_Subprogram_Info_Ref;
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Symbol_Table,
               Msg     => "in Dictionary.AddWithReference");
      end case;
      RawDict.Create_Context_Clause
        (The_Package        => The_Withed_Package,
         The_Subprogram     => The_Withed_Subprogram,
         Explicit           => Explicit,
         Comp_Unit          => Comp_Unit,
         Loc                => Declaration.Start_Position,
         The_Context_Clause => The_Context_Clause);

      case The_Visibility is
         when Visible | Privat =>
            case RawDict.GetSymbolDiscriminant (The_Unit) is
               when Package_Symbol =>
                  Add_Package_Visible_With_Reference
                    (The_Context_Clause => The_Context_Clause,
                     The_Package        => RawDict.Get_Package_Info_Ref (Item => The_Unit)); -- GAA External
               when Generic_Unit_Symbol =>
                  The_Generic_Unit := RawDict.Get_Generic_Unit_Info_Ref (Item => The_Unit); -- GAA External
                  case RawDict.Get_Generic_Unit_Kind (The_Generic_Unit => The_Generic_Unit) is
                     when Generic_Of_Package =>
                        Add_Package_Visible_With_Reference
                          (The_Context_Clause => The_Context_Clause,
                           The_Package        => RawDict.Get_Generic_Unit_Owning_Package (The_Generic_Unit => The_Generic_Unit));
                     when Generic_Of_Subprogram =>
                        Add_Subprogram_With_Reference
                          (The_Context_Clause => The_Context_Clause,
                           The_Subprogram     => RawDict.Get_Generic_Unit_Owning_Subprogram (The_Generic_Unit => The_Generic_Unit));
                  end case;
               when others => -- non-exec code
                  SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Invalid_Symbol_Table,
                                            Msg     => "in Dictionary.AddWithReference");
            end case;
         when Local =>
            case RawDict.GetSymbolDiscriminant (The_Unit) is
               when Package_Symbol =>
                  Add_Package_Local_With_Reference
                    (The_Context_Clause => The_Context_Clause,
                     The_Package        => RawDict.Get_Package_Info_Ref (Item => The_Unit)); -- GAA External
               when Subprogram_Symbol =>
                  Add_Subprogram_With_Reference
                    (The_Context_Clause => The_Context_Clause,
                     The_Subprogram     => RawDict.Get_Subprogram_Info_Ref (Item => The_Unit)); -- GAA External
               when Type_Symbol =>
                  case RawDict.Get_Type_Discriminant (Type_Mark => RawDict.Get_Type_Info_Ref (Item => The_Unit)) is -- GAA External
                     when Protected_Type_Item =>
                        Add_Protected_Type_With_Reference
                          (The_Context_Clause => The_Context_Clause,
                           The_Protected_Type => RawDict.Get_Type_Info_Ref (Item => The_Unit)); -- GAA External
                     when Task_Type_Item =>
                        Add_Task_Type_With_Reference
                          (The_Context_Clause => The_Context_Clause,
                           The_Task_Type      => RawDict.Get_Type_Info_Ref (Item => The_Unit)); -- GAA External
                     when others => -- non-exec code
                        SystemErrors.Fatal_Error
                          (Sys_Err => SystemErrors.Invalid_Symbol_Table,
                           Msg     => "in Dictionary.AddWithReference");
                  end case;
               when others => -- non-exec code
                  SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Invalid_Symbol_Table,
                                            Msg     => "in Dictionary.AddWithReference");
            end case;
      end case;
      AddOtherReference (The_Withed_Symbol, The_Unit, Declaration);
   end if;
end AddWithReference;
