-------------------------------------------------------------------------------
-- (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 CommandLineData;
with Debug;
with E_Strings;
with SPARK_IO;
with Statistics;
with SystemErrors;

package body ComponentManager is

   HashDivider : constant Integer := HashMax + 1;

   ----------------------------------------------------------------------------
   -- Local  Operations
   -----------------------------------------------------------------------------

   function Hash (Sym : Dictionary.Symbol) return HashIndex is
   begin
      return Natural (Dictionary.SymbolRef (Sym)) mod HashDivider;
   end Hash;

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

   procedure LinkInNewComponent
     (Data         : in out ComponentData;
      HeapSeq      : in out Heap.HeapRecord;
      Sym          : in     Dictionary.Symbol;
      TheComponent :    out Component)
   --# global in out Statistics.TableUsage;
   --# derives Data                  from *,
   --#                                    HeapSeq,
   --#                                    Sym &
   --#         HeapSeq               from * &
   --#         Statistics.TableUsage from *,
   --#                                    Data,
   --#                                    HeapSeq &
   --#         TheComponent          from Data;
   is
      TheComponentLocal : Component;
      HashVal           : HashIndex;

      procedure NewComponent (Data         : in out ComponentData;
                              HeapSeq      : in out Heap.HeapRecord;
                              TheComponent :    out Component)
      --# global in out Statistics.TableUsage;
      --# derives Data,
      --#         Statistics.TableUsage from *,
      --#                                    Data,
      --#                                    HeapSeq &
      --#         HeapSeq               from * &
      --#         TheComponent          from Data;
      is
         ErrSeq            : SeqAlgebra.Seq;
         TheComponentLocal : Component;
      begin
         if Data.TheHeap.HighMark = MaxNumComponents then
            Statistics.SetTableUsage (Statistics.RecordFields, MaxNumComponents);
            SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Component_Manager_Overflow,
                                      Msg     => "");
            --note that above call does not return
         end if;

         --get next array entry
         Data.TheHeap.HighMark := Data.TheHeap.HighMark + 1;
         TheComponentLocal     := Data.TheHeap.HighMark;

         --create empty error sequence
         SeqAlgebra.CreateSeq (HeapSeq, ErrSeq);

         --initialize an entry
         Data.TheHeap.ListOfComponents (TheComponentLocal) :=
           ComponentDescriptor'
           (Name            => Dictionary.NullSymbol,
            ListOfErrors    => ErrSeq,
            NextRoot        => NullComponent,
            Hash            => NullComponent,
            Parent          => NullComponent,
            FirstChild      => NullComponent,
            LastChild       => NullComponent,
            NextSibling     => NullComponent,
            PreviousSibling => NullComponent);

         TheComponent := TheComponentLocal;
      end NewComponent;

   begin --LinkInNewComponent
         --put empty record in next empty slot of heap
      NewComponent (Data, HeapSeq, --to get
                    TheComponentLocal);

      --generate a hash index that will point to new entry
      HashVal := Hash (Sym);

      --if the hash table already points at something this maintains the link
      Data.TheHeap.ListOfComponents (TheComponentLocal).Hash := Data.TheTable (HashVal);

      --and this completes the link from the hash table to the new entry
      Data.TheTable (HashVal) := TheComponentLocal;

      TheComponent := TheComponentLocal;

   end LinkInNewComponent;

   -----------------------------------------------------------------------------
   -- Exported Operations
   -----------------------------------------------------------------------------
   function ComponentToRef (C : Component) return Natural is
   begin
      return Natural (C);
   end ComponentToRef;

   -----------------------------------------------------------------------------
   function RefToComponent (N : Natural) return Component is
   begin
      return Component (N);
   end RefToComponent;

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

   procedure Initialise (Data : out ComponentData) is
   begin
      --# accept F, 32, Data.TheHeap.ListOfComponents, "Initialization partial but effective" &
      --#        F, 31, Data.TheHeap.ListOfComponents, "Initialization partial but effective" &
      --#        F, 602, Data, Data.TheHeap.ListOfComponents, "Initialization partial but effective";
      Data.TheTable          := HashTable'(HashIndex => NullComponent);
      Data.TheHeap.HighMark  := NullComponent;
      Data.TheHeap.FirstRoot := NullComponent;
   end Initialise; --782 expect 2 errors, 1 warning, initialization incomplete but effective

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

   function GetComponentNode (Data : ComponentData;
                              Sym  : Dictionary.Symbol) return Component is
      CurrentComponent : Component;
   begin
      CurrentComponent := Data.TheTable (Hash (Sym));
      if CurrentComponent /= NullComponent then
         -- At least one Component hashes from this symbol
         loop
            -- is this the one we want?
            exit when Data.TheHeap.ListOfComponents (CurrentComponent).Name = Sym;

            --no, try next in hash list
            CurrentComponent := Data.TheHeap.ListOfComponents (CurrentComponent).Hash;

            --any more to try?
            exit when CurrentComponent = NullComponent;

         end loop;
      end if;

      return CurrentComponent;

   end GetComponentNode;

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

   procedure AddRoot (Data    : in out ComponentData;
                      HeapSeq : in out Heap.HeapRecord;
                      RootSym : in     Dictionary.Symbol) is
      NewRootComponent : Component;
   begin
      --this operation is idempotent
      NewRootComponent := GetComponentNode (Data, RootSym);
      if NewRootComponent = NullComponent then
         LinkInNewComponent (Data, HeapSeq, RootSym, --to get
                             NewRootComponent);
         Data.TheHeap.ListOfComponents (NewRootComponent).Name     := RootSym;
         Data.TheHeap.ListOfComponents (NewRootComponent).NextRoot := Data.TheHeap.FirstRoot;
         Data.TheHeap.FirstRoot                                    := NewRootComponent;
      end if;
   end AddRoot;

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

   procedure AddNextChild
     (Data     : in out ComponentData;
      HeapSeq  : in out Heap.HeapRecord;
      Node     : in     Component;
      ChildSym : in     Dictionary.Symbol)
   is
      CurrentChildComponent, NewChildComponent, LastChild : Component;
      NoDuplicates                                        : Boolean := True;
   begin
      if Node /= NullComponent then
         -- Valid node to which to add child, in all other cases we are
         -- attempting to add child to empty node, should not happen in normal use
         -- but may occur when walking expressions in situations such as defining
         -- types and constants where component data is not being collected but
         -- must still be there to make procedure call legal

         CurrentChildComponent := Data.TheHeap.ListOfComponents (Node).FirstChild;
         while CurrentChildComponent /= NullComponent loop
            if Data.TheHeap.ListOfComponents (CurrentChildComponent).Name = ChildSym then

               --# accept F, 41, "Stable expression expected here";
               if CommandLineData.Content.Debug.Components then
                  Debug.Print_Sym (Msg => "Name overload in ComponentManager rejected: ",
                                   Sym => ChildSym);
               end if;
               --# end accept;

               NoDuplicates := False;
            end if;
            CurrentChildComponent := Data.TheHeap.ListOfComponents (CurrentChildComponent).NextSibling;
         end loop;

         if NoDuplicates then
            LinkInNewComponent (Data, HeapSeq, ChildSym, --to get
                                NewChildComponent);

            Data.TheHeap.ListOfComponents (NewChildComponent).Name   := ChildSym;
            Data.TheHeap.ListOfComponents (NewChildComponent).Parent := Node;

            LastChild := Data.TheHeap.ListOfComponents (Node).LastChild;
            if LastChild = NullComponent then -- Adding first child
               Data.TheHeap.ListOfComponents (Node).FirstChild := NewChildComponent;

            else --at least one existing child
               Data.TheHeap.ListOfComponents (LastChild).NextSibling             := NewChildComponent;
               Data.TheHeap.ListOfComponents (NewChildComponent).PreviousSibling := LastChild;
            end if;

            Data.TheHeap.ListOfComponents (Node).LastChild := NewChildComponent;
         end if;
      end if;
   end AddNextChild;

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

   function HasChildren (Data : ComponentData;
                         Node : Component) return Boolean is
   begin
      return Node /= NullComponent and then Data.TheHeap.ListOfComponents (Node).FirstChild /= NullComponent;
   end HasChildren;

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

   function IsNullComponent (Node : Component) return Boolean is
   begin
      return Node = NullComponent;
   end IsNullComponent;

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

   function IsALeaf (Data : ComponentData;
                     Node : Component) return Boolean is
   begin
      return not HasChildren (Data, Node);
   end IsALeaf;

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

   function IsARoot (Data : ComponentData;
                     Node : Component) return Boolean is
   begin
      return Node /= NullComponent and then Data.TheHeap.ListOfComponents (Node).Parent = NullComponent;
   end IsARoot;

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

   function IsTransitiveParent
     (Data   : ComponentData;
      Parent : Component;
      Node   : Component)
     return   Boolean
   is
      CurrentComponent : Component;
      Result           : Boolean := False;
   begin
      CurrentComponent := Node;
      loop
         exit when CurrentComponent = NullComponent;

         if CurrentComponent = Parent then
            Result := True;
            exit;
         end if;

         CurrentComponent := Data.TheHeap.ListOfComponents (CurrentComponent).Parent;

      end loop;
      return Result;
   end IsTransitiveParent;

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

   function GetRoot (Data : ComponentData;
                     Node : Component) return Component is
      CurrentComponent : Component;
   begin
      CurrentComponent := Node;
      loop
         exit when Data.TheHeap.ListOfComponents (CurrentComponent).Parent = NullComponent;

         CurrentComponent := Data.TheHeap.ListOfComponents (CurrentComponent).Parent;
      end loop;
      return CurrentComponent;
   end GetRoot;

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

   function GetParent (Data : ComponentData;
                       Node : Component) return Component is
   begin
      return Data.TheHeap.ListOfComponents (Node).Parent;
   end GetParent;

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

   function GetFirstChild (Data : ComponentData;
                           Node : Component) return Component is
   begin
      return Data.TheHeap.ListOfComponents (Node).FirstChild;
   end GetFirstChild;

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

   function GetNextSibling (Data : ComponentData;
                            Node : Component) return Component is
   begin
      return Data.TheHeap.ListOfComponents (Node).NextSibling;
   end GetNextSibling;

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

   function GetPreviousSibling (Data : ComponentData;
                                Node : Component) return Component is
   begin
      return Data.TheHeap.ListOfComponents (Node).PreviousSibling;
   end GetPreviousSibling;

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

   function GetName (Data : ComponentData;
                     Node : Component) return Dictionary.Symbol is
   begin
      return Data.TheHeap.ListOfComponents (Node).Name;
   end GetName;

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

   procedure GetLeaves
     (HeapSeq        : in out Heap.HeapRecord;
      Data           : in     ComponentData;
      Node           : in     Component;
      SeqOfLeafNames :    out SeqAlgebra.Seq)
   is
      LocalSeq              : SeqAlgebra.Seq;
      CurrentNode, NextNode : Component;
   begin
      SeqAlgebra.CreateSeq (HeapSeq, LocalSeq);
      CurrentNode := Data.TheHeap.ListOfComponents (Node).FirstChild;
      if CurrentNode /= NullComponent then
         loop -- down loop
            if Data.TheHeap.ListOfComponents (CurrentNode).FirstChild /= NullComponent then
               NextNode := Data.TheHeap.ListOfComponents (CurrentNode).FirstChild;
            else
               -- Leaf found
               -- Add name to list
               SeqAlgebra.AddMember
                 (HeapSeq,
                  LocalSeq,
                  Natural (Dictionary.SymbolRef (Data.TheHeap.ListOfComponents (CurrentNode).Name)));
               --now see if there is a sibling
               NextNode := Data.TheHeap.ListOfComponents (CurrentNode).NextSibling;
            end if;

            if NextNode = NullComponent then
               NextNode := CurrentNode;
               loop -- up loop
                  NextNode := Data.TheHeap.ListOfComponents (NextNode).Parent;
                  exit when NextNode = Node; --back to top

                  if Data.TheHeap.ListOfComponents (NextNode).NextSibling /= NullComponent then
                     NextNode := Data.TheHeap.ListOfComponents (NextNode).NextSibling;
                     exit;
                  end if;
               end loop;
            end if;

            exit when NextNode = Node; --entire tree processed

            CurrentNode := NextNode;
         end loop;
      end if;

      SeqOfLeafNames := LocalSeq;
   end GetLeaves;

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

   procedure AddError
     (HeapSeq      : in out Heap.HeapRecord;
      TheErrorHeap : in     ComponentErrors.HeapOfErrors;
      Data         : in     ComponentData;
      Node         : in     Component;
      NewError     : in     Natural)
   is
      ListOfNodesAssociatedWithError : SeqAlgebra.Seq;
   begin
      ListOfNodesAssociatedWithError := ComponentErrors.AssociatedComponentNodesOfError (TheErrorHeap, NewError);
      SeqAlgebra.AddMember (HeapSeq, ListOfNodesAssociatedWithError, Natural (Node));
      SeqAlgebra.AddMember (HeapSeq, Data.TheHeap.ListOfComponents (Node).ListOfErrors, NewError);
   end AddError;

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

   function GetListOfErrors (Data : ComponentData;
                             Node : Component) return SeqAlgebra.Seq is
   begin
      return Data.TheHeap.ListOfComponents (Node).ListOfErrors;
   end GetListOfErrors;

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

   procedure AddNewListOfErrors
     (HeapSeq      : in out Heap.HeapRecord;
      Data         : in out ComponentData;
      Node         : in     Component;
      NewErrorList : in     SeqAlgebra.Seq)
   is
   begin
      SeqAlgebra.DisposeOfSeq (HeapSeq, Data.TheHeap.ListOfComponents (Node).ListOfErrors);
      Data.TheHeap.ListOfComponents (Node).ListOfErrors := NewErrorList;
   end AddNewListOfErrors;

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

   procedure EmptyListOfErrors (HeapSeq : in out Heap.HeapRecord;
                                Data    : in out ComponentData;
                                Node    : in     Component) is
      NewErrSeq : SeqAlgebra.Seq;
   begin
      SeqAlgebra.CreateSeq (HeapSeq, NewErrSeq);
      Data.TheHeap.ListOfComponents (Node).ListOfErrors := NewErrSeq;
   end EmptyListOfErrors;

   -- New function for use by MergeAndHandleErrors
   function GetFirstRoot (Data : ComponentData) return Component is
   begin
      return Data.TheHeap.FirstRoot;
   end GetFirstRoot;

   -- New function for use by MergeAndHandleErrors
   function GetNextRoot (Data     : ComponentData;
                         RootNode : Component) return Component is
   begin
      return Data.TheHeap.ListOfComponents (RootNode).NextRoot;
   end GetNextRoot;

   procedure ReportUsage (Data : in ComponentData) is
   begin
      Statistics.SetTableUsage (Statistics.RecordFields, Integer (Data.TheHeap.HighMark));
   end ReportUsage;

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

   procedure Dump_Component_Tree (Data        : in ComponentData;
                                  Node        : in Component;
                                  Indentation : in Natural) is
      --# hide Dump_Component_Tree;

      Current_Child : Component;

      procedure Print_Sym (Sym : in Dictionary.Symbol) is
      begin
         if Dictionary.Is_Null_Symbol (Sym) then
            SPARK_IO.Put_Line (SPARK_IO.Standard_Output, "Null Symbol", 0);
         else
            E_Strings.Put_String
              (File  => SPARK_IO.Standard_Output,
               E_Str => Dictionary.GetAnyPrefixNeeded (Sym       => Sym,
                                                       Scope     => Dictionary.GlobalScope,
                                                       Separator => "."));
            SPARK_IO.Put_Char (SPARK_IO.Standard_Output, '.');
            E_Strings.Put_String
              (File  => SPARK_IO.Standard_Output,
               E_Str => Dictionary.GenerateSimpleName (Item      => Sym,
                                                       Separator => "."));
         end if;
      end Print_Sym;

   begin
      if CommandLineData.Content.Debug.Components and Node /= NullComponent then
         -- Print this node
         for I in Natural range 1 .. Indentation - 1 loop
            SPARK_IO.Put_String (SPARK_IO.Standard_Output, "|  ", 0);
         end loop;
         if Indentation >= 1 then
            SPARK_IO.Put_String (SPARK_IO.Standard_Output, "+--", 0);
         end if;
         Print_Sym (Sym => GetName (Data, Node));
         SPARK_IO.Put_String (SPARK_IO.Standard_Output, " (", 0);
         SPARK_IO.Put_Integer (SPARK_IO.Standard_Output, ComponentToRef (Node), 0, 10);
         SPARK_IO.Put_String (SPARK_IO.Standard_Output, ")", 0);
         SPARK_IO.New_Line (SPARK_IO.Standard_Output, 1);
         -- Find all children
         Current_Child := GetFirstChild (Data, Node);
         while Current_Child /= NullComponent loop
            Dump_Component_Tree (Data        => Data,
                                 Node        => Current_Child,
                                 Indentation => Indentation + 1);
            Current_Child := GetNextSibling (Data, Current_Child);
         end loop;
      end if;
   end Dump_Component_Tree;

   procedure Dump_All_Component_Trees (Data : in ComponentData) is
      --# hide Dump_All_Component_Trees;
      Current_Root : Component;
   begin
      if CommandLineData.Content.Debug.Components then
         Current_Root := GetFirstRoot (Data);
         while Current_Root /= NullComponent loop
            Dump_Component_Tree (Data        => Data,
                                 Node        => Current_Root,
                                 Indentation => 0);
            SPARK_IO.Put_Line (SPARK_IO.Standard_Output, "----------------------------", 0);
            Current_Root := GetNextRoot (Data, Current_Root);
         end loop;
      end if;
   end Dump_All_Component_Trees;

end ComponentManager;