-------------------------------------------------------------------------------
-- (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 (ErrorHandler.Conversions)
procedure ToString
  (Err_Num : in     Error_Types.NumericError;
   Purpose : in     Error_Types.ConversionRequestSource;
   Err_Str :    out Error_Types.StringError)
is
   Error_String       : E_Strings.T;
   Explanation_Needed : Boolean;

   procedure AppendReference (E_Str     : in out E_Strings.T;
                              Reference : in     Natural)
   --# global in     CommandLineData.Content;
   --#        in out Source_Used;
   --# derives E_Str,
   --#         Source_Used from *,
   --#                          CommandLineData.Content,
   --#                          Reference;
      is separate;

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

   procedure Append_Lex_String (E_Str : in out E_Strings.T;
                                L_Str : in     LexTokenManager.Lex_String)
   --# global in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    LexTokenManager.State,
   --#                    L_Str;
   is
      pragma Inline (Append_Lex_String);
   begin
      E_Strings.Append_Examiner_String (E_Str1 => E_Str,
                                        E_Str2 => LexTokenManager.Lex_String_To_String (Lex_Str => L_Str));
   end Append_Lex_String;

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

   procedure Append_Symbol (E_Str : in out E_Strings.T;
                            Sym   : in     Dictionary.Symbol;
                            Scope : in     Dictionary.Scopes)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    LexTokenManager.State,
   --#                    Scope,
   --#                    Sym;
   is
      Package_Ex_Str : E_Strings.T;
   begin
      -- put Access on the front of access types before constructing rest of string
      if Dictionary.IsType (Sym) and then Dictionary.TypeIsAccess (Sym) then
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "Access ");
      end if;
      -- construct rest of string
      Package_Ex_Str := Dictionary.GetAnyPrefixNeeded (Sym       => Sym,
                                                       Scope     => Scope,
                                                       Separator => ".");
      if E_Strings.Get_Length (E_Str => Package_Ex_Str) > 0 then
         E_Strings.Append_Examiner_String (E_Str1 => E_Str,
                                           E_Str2 => Package_Ex_Str);
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => ".");
      end if;
      E_Strings.Append_Examiner_String (E_Str1 => E_Str,
                                        E_Str2 => Dictionary.GenerateSimpleName (Item      => Sym,
                                                                                 Separator => "."));
   end Append_Symbol;

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

   procedure Append_Name (E_Str : in out E_Strings.T;
                          Name  : in     Error_Types.Names;
                          Scope : in     Dictionary.Scopes)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    LexTokenManager.State,
   --#                    Name,
   --#                    Scope;
   is
   begin
      case Name.Name_Sort is
         when Error_Types.None =>
            null;
         when Error_Types.LexString =>
            Append_Lex_String (E_Str => E_Str,
                               L_Str => Name.Name_Str);
         when Error_Types.Entity =>
            null;
         when Error_Types.Symbol =>
            Append_Symbol (E_Str => E_Str,
                           Sym   => Name.Name_Sym,
                           Scope => Scope);
         when Error_Types.ParserSymbol =>
            null;
         when Error_Types.StabilityIndex =>
            null;
         when Error_Types.ThePartition =>
            null;
      end case;
   end Append_Name;

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

   procedure Append_Export_Var
     (E_Str      : in out E_Strings.T;
      Name       : in     Error_Types.Names;
      Scope      : in     Dictionary.Scopes;
      Capitalise : in     Boolean)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    Capitalise,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    LexTokenManager.State,
   --#                    Name,
   --#                    Scope;
   is
   begin
      if Name = Error_Types.NoName then
         if Capitalise then
            E_Strings.Append_String (E_Str => E_Str,
                                     Str   => "T");
         else
            E_Strings.Append_String (E_Str => E_Str,
                                     Str   => "t");
         end if;
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "he function value");
      else
         Append_Name (E_Str => E_Str,
                      Name  => Name,
                      Scope => Scope);
      end if;
   end Append_Export_Var;

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

   procedure UncondFlowErr
     (Err_Num          : in     Error_Types.NumericError;
      With_Explanation : in     Boolean;
      E_Str            : in out E_Strings.T)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    Err_Num,
   --#                    LexTokenManager.State,
   --#                    With_Explanation;
      is separate;

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

   procedure CondlFlowErr
     (Err_Num          : in     Error_Types.NumericError;
      With_Explanation : in     Boolean;
      E_Str            : in out E_Strings.T)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    Err_Num,
   --#                    LexTokenManager.State,
   --#                    With_Explanation;
      is separate;

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

   procedure UncondDependency
     (Err_Num          : in     Error_Types.NumericError;
      With_Explanation : in     Boolean;
      E_Str            : in out E_Strings.T)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    Err_Num,
   --#                    LexTokenManager.State,
   --#                    With_Explanation;
      is separate;

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

   procedure CondlDependency
     (Err_Num          : in     Error_Types.NumericError;
      With_Explanation : in     Boolean;
      E_Str            : in out E_Strings.T)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    Err_Num,
   --#                    LexTokenManager.State,
   --#                    With_Explanation;
      is separate;

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

   procedure SemanticErr
     (Err_Num          : in     Error_Types.NumericError;
      With_Explanation : in     Boolean;
      E_Str            : in out E_Strings.T)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in out Source_Used;
   --# derives E_Str       from *,
   --#                          CommandLineData.Content,
   --#                          Dictionary.Dict,
   --#                          Err_Num,
   --#                          LexTokenManager.State,
   --#                          With_Explanation &
   --#         Source_Used from *,
   --#                          CommandLineData.Content,
   --#                          Err_Num;
      is separate;

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

   procedure DepSemanticErr
     (Err_Num          : in     Error_Types.NumericError;
      With_Explanation : in     Boolean;
      E_Str            : in out E_Strings.T)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    Err_Num,
   --#                    LexTokenManager.State,
   --#                    With_Explanation;
      is separate;

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

   procedure WarningWithPosition
     (Err_Num          : in     Error_Types.NumericError;
      With_Explanation : in     Boolean;
      E_Str            : in out E_Strings.T)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    Err_Num,
   --#                    LexTokenManager.State,
   --#                    With_Explanation;
      is separate;

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

   procedure WarningWithoutPosition
     (Err_Num          : in     Error_Types.NumericError;
      With_Explanation : in     Boolean;
      E_Str            : in out E_Strings.T)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    Err_Num,
   --#                    LexTokenManager.State,
   --#                    With_Explanation;
      is separate;

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

   procedure ControlFlowError
     (Err_Num          : in     Error_Types.NumericError;
      With_Explanation : in     Boolean;
      E_Str            : in out E_Strings.T)
   --# derives E_Str from *,
   --#                    Err_Num,
   --#                    With_Explanation;
      is separate;

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

   procedure IneffectiveStatement
     (Err_Num          : in     Error_Types.NumericError;
      With_Explanation : in     Boolean;
      E_Str            : in out E_Strings.T)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    Err_Num,
   --#                    LexTokenManager.State,
   --#                    With_Explanation;
      is separate;

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

   procedure StabilityError
     (Err_Num          : in     Error_Types.NumericError;
      With_Explanation : in     Boolean;
      E_Str            : in out E_Strings.T)
   --# derives E_Str from *,
   --#                    Err_Num,
   --#                    With_Explanation;
      is separate;

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

   procedure UsageError
     (Err_Num          : in     Error_Types.NumericError;
      With_Explanation : in     Boolean;
      E_Str            : in out E_Strings.T)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    Err_Num,
   --#                    LexTokenManager.State,
   --#                    With_Explanation;
      is separate;

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

   procedure NoErr (Err_Num : in     Error_Types.NumericError;
                    E_Str   : in out E_Strings.T)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    Err_Num,
   --#                    LexTokenManager.State;
      is separate;

   ------------------------------------------------------------
   procedure Note (Err_Num          : in     Error_Types.NumericError;
                   With_Explanation : in     Boolean;
                   E_Str            : in out E_Strings.T)
   --# derives E_Str from *,
   --#                    Err_Num,
   --#                    With_Explanation;
      is separate;

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

   procedure Syntax_Or_Lex_Error (Err_Num : in     Error_Types.NumericError;
                                  E_Str   : in out E_Strings.T)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives E_Str from *,
   --#                    CommandLineData.Content,
   --#                    Dictionary.Dict,
   --#                    Err_Num,
   --#                    LexTokenManager.State;
   is
   begin
      -- When a syntax error has been constructed the entire text string of the error
      -- gets put into the string table and included as Name1 in the numeric form of the
      -- error record.  Conversion back to a string just needs the following:
      Append_Name (E_Str => E_Str,
                   Name  => Err_Num.Name1,
                   Scope => Err_Num.Scope);
   end Syntax_Or_Lex_Error;

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

   procedure Check_Explanation
     (Explanation_Class  : in     Explanation_Classes;
      Error_Number       : in     Error_Types.ErrNumRange;
      Purpose            : in     Error_Types.ConversionRequestSource;
      Explanation_Needed :    out Boolean)
   --# global in     CommandLineData.Content;
   --#        in out Explanation_Table;
   --# derives Explanation_Needed,
   --#         Explanation_Table  from CommandLineData.Content,
   --#                                 Error_Number,
   --#                                 Explanation_Class,
   --#                                 Explanation_Table,
   --#                                 Purpose;
   is
   begin
      -- In general, explanation depend on command line switch setting and whether that explanation
      -- has appeared before.
      case CommandLineData.Content.Error_Explanation is
         when CommandLineData.Off =>
            Explanation_Needed := False;
         when CommandLineData.First_Occurrence =>
            Explanation_Needed                                               :=
              not Explanation_Table (Explanation_Class) (Error_Number) (Purpose);
            Explanation_Table (Explanation_Class) (Error_Number) (Purpose)   := True;
         when CommandLineData.Every_Occurrence =>
            Explanation_Needed := True;
      end case;
      -- But we also have a special case where we turn explanations off if (HTML and (Purpose=ForReport)).
      -- This is because explanations are only a click away when looking at HTML report files, so why clutter up screen?
      if CommandLineData.Content.HTML and then Purpose in Error_Types.ForReport then
         Explanation_Needed := False;
      end if;
      -- We also turn it off for XML generation, at least for now.
      if CommandLineData.Content.XML then
         Explanation_Needed := False;
      end if;
   end Check_Explanation;

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

begin --ToString
   if Err_Num = Error_Types.Empty_NumericError then
      Err_Str := Error_Types.Empty_StringError;
   else
      Error_String := E_Strings.Empty_String;
      case Err_Num.ErrorType is
         when Error_Types.UncondFlowErr =>
            Check_Explanation
              (Explanation_Class  => Flow_Errors,
               Error_Number       => Err_Num.ErrorNum,
               Purpose            => Purpose,
               Explanation_Needed => Explanation_Needed);
            UncondFlowErr (Err_Num, Explanation_Needed, Error_String);
         when Error_Types.CondlFlowErr =>
            Check_Explanation
              (Explanation_Class  => Flow_Errors,
               Error_Number       => Err_Num.ErrorNum,
               Purpose            => Purpose,
               Explanation_Needed => Explanation_Needed);
            CondlFlowErr (Err_Num, Explanation_Needed, Error_String);
         when Error_Types.UncondDependencyErr =>
            Check_Explanation
              (Explanation_Class  => Dependency_Errs,
               Error_Number       => Err_Num.ErrorNum,
               Purpose            => Purpose,
               Explanation_Needed => Explanation_Needed);
            UncondDependency (Err_Num, Explanation_Needed, Error_String);
         when Error_Types.CondlDependencyErr =>
            Check_Explanation
              (Explanation_Class  => Dependency_Errs,
               Error_Number       => Err_Num.ErrorNum,
               Purpose            => Purpose,
               Explanation_Needed => Explanation_Needed);
            CondlDependency (Err_Num, Explanation_Needed, Error_String);
         when Error_Types.SemanticErr =>
            Check_Explanation
              (Explanation_Class  => Semantic_Errs,
               Error_Number       => Err_Num.ErrorNum,
               Purpose            => Purpose,
               Explanation_Needed => Explanation_Needed);
            SemanticErr (Err_Num, Explanation_Needed, Error_String);
         when Error_Types.DepSemanticErr =>
            Check_Explanation
              (Explanation_Class  => Dep_Semantic_Errs,
               Error_Number       => Err_Num.ErrorNum,
               Purpose            => Purpose,
               Explanation_Needed => Explanation_Needed);
            DepSemanticErr (Err_Num, Explanation_Needed, Error_String);
         when Error_Types.WarningWithPosition =>
            Check_Explanation
              (Explanation_Class  => Warnings,
               Error_Number       => Err_Num.ErrorNum,
               Purpose            => Purpose,
               Explanation_Needed => Explanation_Needed);
            WarningWithPosition (Err_Num, Explanation_Needed, Error_String);
         when Error_Types.WarningWithoutPosition =>
            Check_Explanation
              (Explanation_Class  => Warnings,
               Error_Number       => Err_Num.ErrorNum,
               Purpose            => Purpose,
               Explanation_Needed => Explanation_Needed);
            WarningWithoutPosition (Err_Num, Explanation_Needed, Error_String);
         when Error_Types.ControlFlowErr =>
            Check_Explanation
              (Explanation_Class  => Control_Flows,
               Error_Number       => Err_Num.ErrorNum,
               Purpose            => Purpose,
               Explanation_Needed => Explanation_Needed);
            ControlFlowError (Err_Num, Explanation_Needed, Error_String);
         when Error_Types.NoErr =>
            NoErr (Err_Num, Error_String);
         when Error_Types.IneffectiveStat =>
            Check_Explanation
              (Explanation_Class  => Ineffective_Statements,
               Error_Number       => Err_Num.ErrorNum,
               Purpose            => Purpose,
               Explanation_Needed => Explanation_Needed);
            IneffectiveStatement (Err_Num, Explanation_Needed, Error_String);
         when Error_Types.StabilityErr =>
            Check_Explanation
              (Explanation_Class  => Flow_Errors,
               Error_Number       => Err_Num.ErrorNum,
               Purpose            => Purpose,
               Explanation_Needed => Explanation_Needed);
            StabilityError (Err_Num, Explanation_Needed, Error_String);
         when Error_Types.UsageErr =>
            Check_Explanation
              (Explanation_Class  => Flow_Errors,
               Error_Number       => Err_Num.ErrorNum,
               Purpose            => Purpose,
               Explanation_Needed => Explanation_Needed);
            UsageError (Err_Num, Explanation_Needed, Error_String);
         when Error_Types.Note =>
            Check_Explanation
              (Explanation_Class  => Notes,
               Error_Number       => Err_Num.ErrorNum,
               Purpose            => Purpose,
               Explanation_Needed => Explanation_Needed);
            Note (Err_Num, Explanation_Needed, Error_String);
         when Error_Types.SyntaxErr | Error_Types.LexErr | Error_Types.SyntaxRec =>
            Syntax_Or_Lex_Error (Err_Num => Err_Num,
                                 E_Str   => Error_String);
      end case;

      Err_Str :=
        Error_Types.StringError'
        (ErrorType => Err_Num.ErrorType,
         Position  => Err_Num.Position,
         Message   => Error_String,
         MessageId => Err_Num.ErrorNum);
   end if;
end ToString;
