-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

with SystemErrors, Statistics;

package body ComponentErrors is

   procedure Initialise (TheErrorHeap : out HeapOfErrors) is
   begin
      --# accept F, 32, TheErrorHeap.ListOfComponentErrors, "Initialization partial but effective" &
      --#        F, 31, TheErrorHeap.ListOfComponentErrors, "Initialization partial but effective" &
      --#        F, 602, TheErrorHeap, TheErrorHeap.ListOfComponentErrors, "Initialization partial but effective";
      TheErrorHeap.HighMark          := NullComponentError;
      TheErrorHeap.NextFreeComponent := NullComponentError;
   end Initialise;

   procedure CreateError
     (TheErrorHeap : in out HeapOfErrors;
      HeapSeq      : in out Heap.HeapRecord;
      ErrClass     : in     ErrorClass;
      ErrVal       : in     Natural;
      Position     : in     LexTokenManager.Token_Position;
      Sym          : in     Dictionary.Symbol;
      NewError     :    out ComponentError)
   is
      NewErrorLocal : ComponentError;
      NodeList      : SeqAlgebra.Seq;
   begin
      if TheErrorHeap.NextFreeComponent /= NullComponentError then
         -- returned locations are re-usable
         NewErrorLocal                  := TheErrorHeap.NextFreeComponent;
         TheErrorHeap.NextFreeComponent := TheErrorHeap.ListOfComponentErrors (NewErrorLocal).NextError;

      elsif TheErrorHeap.HighMark < MaxNumComponentErrors then
         -- return list empty but unused cells remain in array
         TheErrorHeap.HighMark := TheErrorHeap.HighMark + 1;
         NewErrorLocal         := TheErrorHeap.HighMark;
      else
         --returned list empty and array used up, nothing left
         Statistics.SetTableUsage (Statistics.RecordErrors, MaxNumComponentErrors);
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Component_Error_Overflow,
                                   Msg     => "");
         NewErrorLocal := NullComponentError; -- strictly unnecessary since prev lines doesn't return
      end if;

      -- if we get here we have a new, valid index into the array (which may point at garbage)
      SeqAlgebra.CreateSeq (HeapSeq, NodeList);
      TheErrorHeap.ListOfComponentErrors (NewErrorLocal) :=
        ErrorDescriptor'
        (ErrClass                 => ErrClass,
         ErrVal                   => ErrVal,
         Position                 => Position,
         Sym                      => Sym,
         AssociatedComponentNodes => NodeList,
         NextError                => NullComponentError);

      NewError := NewErrorLocal;
   end CreateError;

   procedure DisposeOfError (TheErrorHeap : in out HeapOfErrors;
                             HeapSeq      : in out Heap.HeapRecord;
                             OldError     : in     ComponentError) is
   begin
      SeqAlgebra.DisposeOfSeq (HeapSeq, TheErrorHeap.ListOfComponentErrors (OldError).AssociatedComponentNodes);
      TheErrorHeap.ListOfComponentErrors (OldError).NextError := TheErrorHeap.NextFreeComponent;
      TheErrorHeap.NextFreeComponent                          := OldError;
   end DisposeOfError;

   function IsSameError
     (TheErrorHeap : HeapOfErrors;
      Error1       : ComponentError;
      Error2       : ComponentError)
     return         Boolean
   is
      FirstError, SecondError : ErrorDescriptor;
   begin
      FirstError  := TheErrorHeap.ListOfComponentErrors (Error1);
      SecondError := TheErrorHeap.ListOfComponentErrors (Error2);
      return FirstError.ErrClass = SecondError.ErrClass
        and then FirstError.ErrVal = SecondError.ErrVal
        and then FirstError.Position = SecondError.Position
        and then FirstError.Sym = SecondError.Sym;
   end IsSameError;

   function ClassOfError (TheErrorHeap : HeapOfErrors;
                          Error        : ComponentError) return ErrorClass is
   begin
      return TheErrorHeap.ListOfComponentErrors (Error).ErrClass;
   end ClassOfError;

   function ValueOfError (TheErrorHeap : HeapOfErrors;
                          Error        : ComponentError) return Natural is
   begin
      return TheErrorHeap.ListOfComponentErrors (Error).ErrVal;
   end ValueOfError;

   function PositionOfError (TheErrorHeap : HeapOfErrors;
                             Error        : ComponentError) return LexTokenManager.Token_Position is
   begin
      return TheErrorHeap.ListOfComponentErrors (Error).Position;
   end PositionOfError;

   function SymOfError (TheErrorHeap : HeapOfErrors;
                        Error        : ComponentError) return Dictionary.Symbol is
   begin
      return TheErrorHeap.ListOfComponentErrors (Error).Sym;
   end SymOfError;

   function AssociatedComponentNodesOfError (TheErrorHeap : HeapOfErrors;
                                             Error        : ComponentError) return SeqAlgebra.Seq is
   begin
      return TheErrorHeap.ListOfComponentErrors (Error).AssociatedComponentNodes;
   end AssociatedComponentNodesOfError;

   procedure ReportUsage (TheErrorHeap : in HeapOfErrors) is
   begin
      Statistics.SetTableUsage (Statistics.RecordErrors, TheErrorHeap.HighMark);
   end ReportUsage;

end ComponentErrors;
