-------------------------------------------------------------------------------
-- (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 FileSystem;
with IndexManager;
with ScreenEcho;
with SP_Symbols;
with SystemErrors;

use type SP_Symbols.SP_Symbol;

package body ContextManager.Ops is

   type File_Entries is record
      Name             : LexTokenManager.Lex_String;
      Status           : ContextManager.FileStatus;
      File             : SPARK_IO.File_Type;
      Listing_Req      : Boolean;
      Listing_Filename : E_Strings.T;
      Line_Context     : SparkLex.Line_Context;
      Error_Context    : ErrorHandler.Error_Contexts;
      Unit_Count       : Natural;
      Errs_Reported    : Boolean;
   end record;

   Null_File_Entry : constant File_Entries :=
     File_Entries'
     (Name             => LexTokenManager.Null_String,
      Status           => ContextManager.NoFileEntry,
      File             => SPARK_IO.Null_File,
      Listing_Req      => False,
      Listing_Filename => E_Strings.Empty_String,
      Line_Context     => SparkLex.Null_Line_Context,
      Error_Context    => ErrorHandler.Null_Error_Context,
      Unit_Count       => Natural'First,
      Errs_Reported    => False);

   type Unit_Entries is record
      Name            : LexTokenLists.Lists;
      Unit_Type       : ContextManager.UnitTypes;
      Status          : ContextManager.UnitStatus;
      File_Descriptor : ContextManager.FileDescriptors;
      Parse_Tree      : STree.SyntaxNode;
      VCG             : Boolean;
      Unit_Number     : Natural;
      Cycle_Detected  : Boolean;
      Comp_Unit_Flag  : Natural;
      Inherit_Clause  : STree.SyntaxNode;
   end record;

   Null_Unit_Entry : constant Unit_Entries :=
     Unit_Entries'
     (Name            => LexTokenLists.Null_List,
      Unit_Type       => ContextManager.PackageSpecification,
      Status          => ContextManager.NoUnitEntry,
      File_Descriptor => ContextManager.NullFile,
      Parse_Tree      => STree.NullNode,
      VCG             => False,
      Unit_Number     => 0,
      Cycle_Detected  => False,
      Comp_Unit_Flag  => 0,
      Inherit_Clause  => STree.NullNode);

   subtype File_Pointers is ContextManager.FileDescriptors range 1 .. ContextManager.FileDescriptors'Last;

   type File_Heap_Contents is array (File_Pointers) of File_Entries;

   type File_Heaps is record
      Content   : File_Heap_Contents;
      Last_Used : ContextManager.FileDescriptors;
   end record;

   subtype Unit_Pointers is ContextManager.UnitDescriptors range 1 .. ContextManager.UnitDescriptors'Last;

   type Unit_Heap_Contents is array (Unit_Pointers) of Unit_Entries;

   type Unit_Heaps is record
      Content   : Unit_Heap_Contents;
      Last_Used : ContextManager.UnitDescriptors;
   end record;

   subtype Stack_Heights is Integer range 0 .. ExaminerConstants.ContextManagerMaxUnits;

   subtype Stack_Pointers is Integer range 1 .. ExaminerConstants.ContextManagerMaxUnits;

   type Stack_Contents is array (Stack_Pointers) of ContextManager.UnitDescriptors;

   type Unit_Stacks is record
      Content : Stack_Contents;
      Height  : Stack_Heights;
   end record;

   File_Heap  : File_Heaps;
   Unit_Heap  : Unit_Heaps;
   Unit_Stack : Unit_Stacks;

   procedure Open_File (File_Descriptor : in ContextManager.FileDescriptors) is
      Source_Filename : E_Strings.T;
      Source_File     : SPARK_IO.File_Type := SPARK_IO.Null_File;
      Status          : SPARK_IO.File_Status;
      Full_Name       : E_Strings.T;
      Stat            : FileSystem.Typ_File_Spec_Status;
   begin
      Source_Filename := LexTokenManager.Lex_String_To_String (Lex_Str => File_Heap.Content (File_Descriptor).Name);
      FileSystem.Open_Source_File (File   => Source_File,
                                   Name   => Source_Filename,
                                   Status => Status);
      if Status = SPARK_IO.Ok then
         File_Heap.Content (File_Descriptor).File := Source_File;
         SparkLex.Clear_Line_Context;
         SparkLex.Store_Line_Context (File_Line => File_Heap.Content (File_Descriptor).Line_Context);
         ErrorHandler.Error_Init (Source_File_Name => Source_Filename,
                                  Echo             => CommandLineData.Content.Echo);
         ErrorHandler.Get_Error_Context (Context => File_Heap.Content (File_Descriptor).Error_Context);
         File_Heap.Content (File_Descriptor).Status := ContextManager.FileOpen;
      else
         ScreenEcho.Put_String ("Cannot open file ");
         if CommandLineData.Content.Plain_Output then
            Full_Name := FileSystem.Just_File (Fn  => Source_Filename,
                                               Ext => True);
         else
            --# accept F, 10, Stat, "Stat not used";
            FileSystem.Find_Full_File_Name (File_Spec      => Source_Filename,
                                            File_Status    => Stat,
                                            Full_File_Name => Full_Name);
            --# end accept;
         end if;
         ScreenEcho.Put_ExaminerString (Full_Name);
         ScreenEcho.New_Line (1);
         File_Heap.Content (File_Descriptor).Status := ContextManager.UnableToOpen;
         ErrorHandler.Set_File_Open_Error;
      end if;
      --# accept F, 33, Stat, "Stat not used";
   end Open_File;

   procedure Close_File (File_Descriptor : in ContextManager.FileDescriptors) is
      Success : SPARK_IO.File_Status;
   begin
      if File_Heap.Content (File_Descriptor).Status = ContextManager.FileOpen then
         --# accept F, 10, Success, "Not required here";
         SPARK_IO.Close (File_Heap.Content (File_Descriptor).File, Success);
         --# end accept;
      end if;
      File_Heap.Content (File_Descriptor).Status := ContextManager.FileEnd;
      --# accept F, 33, Success, "Not required here" ;
   end Close_File;

   function Current_Unit return  ContextManager.UnitDescriptors is
      Result : ContextManager.UnitDescriptors;
   begin
      if Unit_Stack.Height > 0 then
         Result := Unit_Stack.Content (Unit_Stack.Height);
      else
         Result := ContextManager.NullUnit;
      end if;
      return Result;
   end Current_Unit;

   function Get_Unit_Status (Unit_Descriptor : ContextManager.UnitDescriptors) return ContextManager.UnitStatus is
   begin
      return Unit_Heap.Content (Unit_Descriptor).Status;
   end Get_Unit_Status;

   procedure Create_Unit_Descriptor
     (File_Descriptor : in     ContextManager.FileDescriptors;
      Unit_Descriptor :    out ContextManager.UnitDescriptors)
   is
   begin
      if Unit_Heap.Last_Used = Unit_Pointers'Last then
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Context_Unit_Heap_Overflow,
                                   Msg     => "");
      end if;
      Unit_Heap.Last_Used                                 := Unit_Heap.Last_Used + 1;
      Unit_Descriptor                                     := Unit_Heap.Last_Used;
      Unit_Heap.Content (Unit_Descriptor)                 := Null_Unit_Entry;
      Unit_Heap.Content (Unit_Descriptor).Status          := ContextManager.UnitCreated;
      Unit_Heap.Content (Unit_Descriptor).File_Descriptor := File_Descriptor;
      Unit_Heap.Content (Unit_Descriptor).VCG             := False;
      if File_Descriptor /= ContextManager.NullFile then
         File_Heap.Content (File_Descriptor).Unit_Count  := File_Heap.Content (File_Descriptor).Unit_Count + 1;
         Unit_Heap.Content (Unit_Descriptor).Unit_Number := File_Heap.Content (File_Descriptor).Unit_Count;
      else
         Unit_Heap.Content (Unit_Descriptor).Unit_Number := 0;
      end if;
   end Create_Unit_Descriptor;

   function Get_File_Descriptor (Unit_Descriptor : ContextManager.UnitDescriptors) return ContextManager.FileDescriptors is
   begin
      return Unit_Heap.Content (Unit_Descriptor).File_Descriptor;
   end Get_File_Descriptor;

   procedure SetUnitStatus (Descriptor : in ContextManager.UnitDescriptors;
                            Status     : in ContextManager.UnitStatus) is
   begin
      Unit_Heap.Content (Descriptor).Status := Status;
   end SetUnitStatus;

   procedure MarkUnitInCycle (Descriptor : in ContextManager.UnitDescriptors) is
   begin
      Unit_Heap.Content (Descriptor).Cycle_Detected := True;
   end MarkUnitInCycle;

   function UnitInCycle (Descriptor : ContextManager.UnitDescriptors) return Boolean is
   begin
      return Unit_Heap.Content (Descriptor).Cycle_Detected;
   end UnitInCycle;

   function GetFileStatus (Descriptor : ContextManager.FileDescriptors) return ContextManager.FileStatus is
   begin
      return File_Heap.Content (Descriptor).Status;
   end GetFileStatus;

   procedure SetVCG (Descriptor : in ContextManager.UnitDescriptors;
                     VCG        : in Boolean) is
   begin
      Unit_Heap.Content (Descriptor).VCG := VCG;
   end SetVCG;

   procedure GetVCG (Descriptor : in     ContextManager.UnitDescriptors;
                     VCG        :    out Boolean) is
   begin
      VCG := Unit_Heap.Content (Descriptor).VCG;
   end GetVCG;

   procedure GetUnitByName
     (UnitName    : in     LexTokenLists.Lists;
      UnitTypeSet : in     ContextManager.UnitTypeSets;
      Descriptor  :    out ContextManager.UnitDescriptors)
   is
   begin
      Descriptor := ContextManager.NullUnit;
      for I in Unit_Pointers range 1 .. Unit_Heap.Last_Used loop
         if LexTokenLists.Eq_Unit (First_Item => UnitName,
                                   Second     => Unit_Heap.Content (I).Name) and
           UnitTypeSet (Unit_Heap.Content (I).Unit_Type) then
            Descriptor := I;
            exit;
         end if;
      end loop;
   end GetUnitByName;

   procedure SetUnitName
     (Descriptor : in ContextManager.UnitDescriptors;
      UnitName   : in LexTokenLists.Lists;
      UnitType   : in ContextManager.UnitTypes)
   is
   begin
      Unit_Heap.Content (Descriptor).Name      := UnitName;
      Unit_Heap.Content (Descriptor).Unit_Type := UnitType;
   end SetUnitName;

   procedure GetUnitName
     (Descriptor : in     ContextManager.UnitDescriptors;
      UnitName   :    out LexTokenLists.Lists;
      UnitType   :    out ContextManager.UnitTypes)
   is
   begin
      UnitName := Unit_Heap.Content (Descriptor).Name;
      UnitType := Unit_Heap.Content (Descriptor).Unit_Type;
   end GetUnitName;

   procedure SetParseTree (Descriptor : in ContextManager.UnitDescriptors;
                           ParseTree  : in STree.SyntaxNode) is
   begin
      Unit_Heap.Content (Descriptor).Parse_Tree     := ParseTree;
      Unit_Heap.Content (Descriptor).Inherit_Clause :=
        STree.Get_Node
        (It => STree.Find_First_Node (Node_Kind    => SP_Symbols.inherit_clause,
                                      From_Root    => ParseTree,
                                      In_Direction => STree.Down));
   end SetParseTree;

   procedure GetParseTree (Descriptor : in     ContextManager.UnitDescriptors;
                           ParseTree  :    out STree.SyntaxNode) is
   begin
      ParseTree := Unit_Heap.Content (Descriptor).Parse_Tree;
   end GetParseTree;

   function FirstUnitDescriptor return  ContextManager.UnitDescriptors is
      Result : ContextManager.UnitDescriptors;
   begin
      if Unit_Heap.Last_Used = ContextManager.NullUnit then
         Result := ContextManager.NullUnit;
      else
         Result := Unit_Pointers'First;
      end if;
      return Result;
   end FirstUnitDescriptor;

   function NextUnitDescriptor (Descriptor : ContextManager.UnitDescriptors) return ContextManager.UnitDescriptors is
      Result : ContextManager.UnitDescriptors;
   begin
      if Descriptor = Unit_Heap.Last_Used then
         Result := ContextManager.NullUnit;
      else
         Result := Descriptor + 1;
      end if;
      return Result;
   end NextUnitDescriptor;

   procedure PushUnit (Descriptor : in ContextManager.UnitDescriptors) is
   begin
      if Unit_Stack.Height = Stack_Heights'Last then
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Context_Unit_Stack_Overflow,
                                   Msg     => "");
      end if;

      Unit_Stack.Height                      := Unit_Stack.Height + 1;
      Unit_Stack.Content (Unit_Stack.Height) := Descriptor;
   end PushUnit;

   procedure PopUnit (Descriptor : out ContextManager.UnitDescriptors) is
   begin
      if Unit_Stack.Height = 0 then
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Context_Unit_Stack_Underflow,
                                   Msg     => "");
      end if;

      Descriptor        := Unit_Stack.Content (Unit_Stack.Height);
      Unit_Stack.Height := Unit_Stack.Height - 1;
   end PopUnit;

   procedure CreateFileDescriptor (Descriptor : out ContextManager.FileDescriptors) is
   begin
      if File_Heap.Last_Used = File_Pointers'Last then
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Context_File_Heap_Overflow,
                                   Msg     => "");
      end if;
      File_Heap.Last_Used                                   := File_Heap.Last_Used + 1;
      Descriptor                                            := File_Heap.Last_Used;
      File_Heap.Content (File_Heap.Last_Used).Status        := ContextManager.NoFileEntry;
      File_Heap.Content (File_Heap.Last_Used).Unit_Count    := 0;
      File_Heap.Content (File_Heap.Last_Used).Errs_Reported := False;
   end CreateFileDescriptor;

   procedure SetSourceFileName (Descriptor     : in ContextManager.FileDescriptors;
                                SourceFileName : in LexTokenManager.Lex_String) is
   begin
      File_Heap.Content (Descriptor).Name := SourceFileName;
   end SetSourceFileName;

   function GetSourceFileName (Descriptor : in ContextManager.FileDescriptors) return LexTokenManager.Lex_String is
   begin
      return File_Heap.Content (Descriptor).Name;
   end GetSourceFileName;

   procedure GetSourceFile (Descriptor : in     ContextManager.FileDescriptors;
                            SourceFile :    out SPARK_IO.File_Type) is
   begin
      SourceFile := File_Heap.Content (Descriptor).File;
   end GetSourceFile;

   function ListingReqt (Descriptor : ContextManager.FileDescriptors) return Boolean is
   begin
      return File_Heap.Content (Descriptor).Listing_Req;
   end ListingReqt;

   function FirstFileDescriptor return  ContextManager.FileDescriptors is
      Result : ContextManager.FileDescriptors;
   begin
      if File_Heap.Last_Used = ContextManager.NullFile then
         Result := ContextManager.NullFile;
      else
         Result := File_Pointers'First;
      end if;
      return Result;
   end FirstFileDescriptor;

   function NextFileDescriptor (Descriptor : ContextManager.FileDescriptors) return ContextManager.FileDescriptors is
      Result : ContextManager.FileDescriptors;
   begin
      if Descriptor = File_Heap.Last_Used then
         Result := ContextManager.NullFile;
      else
         Result := Descriptor + 1;
      end if;
      return Result;
   end NextFileDescriptor;

   function GetFileByName (FileName : in LexTokenManager.Lex_String) return ContextManager.FileDescriptors is
      Descriptor : ContextManager.FileDescriptors;
   begin
      Descriptor := ContextManager.NullFile;
      for I in File_Pointers range 1 .. File_Heap.Last_Used loop
         if LexTokenManager.Lex_String_Case_Sensitive_Compare (Lex_Str1 => FileName,
                                                               Lex_Str2 => File_Heap.Content (I).Name) =
           LexTokenManager.Str_Eq then
            Descriptor := I;
            exit;
         end if;
      end loop;
      return Descriptor;
   end GetFileByName;

   procedure SetFileStatus (Descriptor : in ContextManager.FileDescriptors;
                            Status     : in ContextManager.FileStatus) is
   begin
      File_Heap.Content (Descriptor).Status := Status;
   end SetFileStatus;

   procedure SetListingReq (Descriptor : in ContextManager.FileDescriptors;
                            Req        : in Boolean) is
   begin
      File_Heap.Content (Descriptor).Listing_Req := Req;
   end SetListingReq;

   procedure SetLineContext (Descriptor  : in ContextManager.FileDescriptors;
                             FileContext : in SparkLex.Line_Context) is
   begin
      File_Heap.Content (Descriptor).Line_Context := FileContext;
   end SetLineContext;

   procedure GetLineContext (Descriptor  : in     ContextManager.FileDescriptors;
                             FileContext :    out SparkLex.Line_Context) is
   begin
      FileContext := File_Heap.Content (Descriptor).Line_Context;
   end GetLineContext;

   procedure SetErrorContext (Descriptor : in ContextManager.FileDescriptors;
                              Context    : in ErrorHandler.Error_Contexts) is
   begin
      File_Heap.Content (Descriptor).Error_Context := Context;
   end SetErrorContext;

   procedure GetErrorContext (Descriptor : in     ContextManager.FileDescriptors;
                              Context    :    out ErrorHandler.Error_Contexts) is
   begin
      Context := File_Heap.Content (Descriptor).Error_Context;
   end GetErrorContext;

   procedure SetListingFileName (Descriptor        : in ContextManager.FileDescriptors;
                                 Listing_File_Name : in E_Strings.T) is
   begin
      File_Heap.Content (Descriptor).Listing_Filename := Listing_File_Name;
   end SetListingFileName;

   procedure GetListingFileName (Descriptor        : in     ContextManager.FileDescriptors;
                                 Listing_File_Name :    out E_Strings.T) is
   begin
      Listing_File_Name := File_Heap.Content (Descriptor).Listing_Filename;
   end GetListingFileName;

   procedure SetErrorsReported (Descriptor : in ContextManager.FileDescriptors) is
   begin
      File_Heap.Content (Descriptor).Errs_Reported := True;
   end SetErrorsReported;

   function ErrorsReported (Descriptor : ContextManager.FileDescriptors) return Boolean is
   begin
      return File_Heap.Content (Descriptor).Errs_Reported;
   end ErrorsReported;

   procedure Get_Unit (Descriptor      : in     ContextManager.FileDescriptors;
                       Unit_Descriptor :    out ContextManager.UnitDescriptors) is
      Id_Str : LexTokenManager.Lex_String;
   begin
      Unit_Descriptor := ContextManager.NullUnit;
      for I in Unit_Pointers range 1 .. Unit_Heap.Last_Used loop
         if Unit_Heap.Content (I).Unit_Type /= ContextManager.InterUnitPragma
           and then Unit_Heap.Content (I).File_Descriptor = Descriptor then
            if Unit_Descriptor = ContextManager.NullUnit then
               Unit_Descriptor := I;
            else
               if LexTokenLists.Get_Length (List => Unit_Heap.Content (I).Name) = 0 then
                  Id_Str := LexTokenManager.Null_String;
               else
                  Id_Str :=
                    LexTokenLists.Get_Element
                    (List => Unit_Heap.Content (I).Name,
                     Pos  => LexTokenLists.Get_Length (List => Unit_Heap.Content (I).Name));
               end if;
               ErrorHandler.SLI_Generation_Warning
                 (Position => STree.Node_Position
                    (Node => STree.Get_Node
                       (It => STree.Find_First_Node
                          (Node_Kind    => SP_Symbols.identifier,
                           From_Root    => Unit_Heap.Content (I).Parse_Tree,
                           In_Direction => STree.Down))),
                  Id_Str   => Id_Str);
            end if;
         end if;
      end loop;
   end Get_Unit;

   procedure Get_Parent (Unit_Descriptor : in out ContextManager.UnitDescriptors) is
      Unit_Name  : LexTokenLists.Lists;
      Dummy_Item : LexTokenManager.Lex_String;
   begin
      Unit_Name := Unit_Heap.Content (Unit_Descriptor).Name;
      --# accept F, 10, Dummy_Item, "Ineffective assignment here OK";
      LexTokenLists.Pop (List => Unit_Name,
                         Item => Dummy_Item);
      --# end accept;
      GetUnitByName
        (UnitName    => Unit_Name,
         UnitTypeSet => ContextManager.UnitTypeSets'(ContextManager.SubUnit | ContextManager.PackageBody | ContextManager.MainProgram => True,
                                                     others                                                                           => False),
         Descriptor  => Unit_Descriptor);
      --# accept F, 33, Dummy_Item, "Expect Dummy_Item unused";
   end Get_Parent;

   procedure Dependency_Closure (Descriptor : in ContextManager.FileDescriptors) is
      It              : STree.Iterator;
      Lex_Str         : LexTokenLists.Lists;
      Unit_Descriptor : ContextManager.UnitDescriptors;
      Spec_Found      : Boolean;
      Components      : IndexManager.Component_Lists;

      Queue_Size : constant := ExaminerConstants.ContextManagerMaxUnits;

      subtype Queue_0 is Integer range 0 .. Queue_Size;
      subtype Queue_1 is Queue_0 range 1 .. Queue_0'Last;

      type Queue_Item is record
         Unit_Descriptor : ContextManager.UnitDescriptors;
         Done            : Boolean;
      end record;

      type Queue_Array is array (Queue_1) of Queue_Item;
      type Queue_T is record
         The_Array : Queue_Array;
         Top       : Queue_0;
      end record;

      Queue : Queue_T;

      --  Build a string list from a dotted name identifier (Node).
      function Build_List (Node : in STree.SyntaxNode) return LexTokenLists.Lists
      --# global in STree.Table;
      is
         It         : STree.Iterator;
         Return_Val : LexTokenLists.Lists;
      begin
         SystemErrors.RT_Assert
           (C       => STree.Syntax_Node_Type (Node => Node) = SP_Symbols.dotted_simple_name,
            Sys_Err => SystemErrors.Other_Internal_Error,
            Msg     => "CONTEXTMANAGER.BUILD_LIST : Node should be a SP_Symbols.dotted_simple_name");
         Return_Val := LexTokenLists.Null_List;
         It         := STree.Find_First_Node (Node_Kind    => SP_Symbols.identifier,
                                              From_Root    => Node,
                                              In_Direction => STree.Down);
         while It /= STree.NullIterator loop
            LexTokenLists.Append (List => Return_Val,
                                  Item => STree.Node_Lex_String (Node => STree.Get_Node (It => It)));
            It := STree.NextNode (It => It);
         end loop;
         return Return_Val;
      end Build_List;

      --  Add the compilation unit descriptor (Descriptor) in the
      --  queue.
      procedure Add_Queue (Descriptor : in ContextManager.UnitDescriptors)
      --# global in out Queue;
      --#        in out Unit_Heap;
      --# derives Queue,
      --#         Unit_Heap from *,
      --#                        Descriptor,
      --#                        Queue;
      is
         Found : Boolean;
      begin
         --  Find if the compilation unit descriptor (Descriptor) has
         --  already been in the queue or is already in the queue.
         Found := False;
         for I in Queue_1 range 1 .. Queue.Top loop
            if Queue.The_Array (I).Unit_Descriptor = Descriptor then
               Found := True;
               exit;
            end if;
         end loop;
         if not Found then
            --  Never seen the compilation unit descriptor
            --  (Descriptor) in the queue => add the compilation unit
            --  descriptor (Descriptor) in the queue.
            if Queue.Top < Queue_Size then
               Queue.Top                   := Queue.Top + 1;
               Queue.The_Array (Queue.Top) := Queue_Item'(Unit_Descriptor => Descriptor,
                                                          Done            => False);
               --  Set the closure flag.
               Unit_Heap.Content (Descriptor).Comp_Unit_Flag := 1;
            else
               SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Queue_Overflow,
                                         Msg     => "CONTEXTMANAGER.ADD_QUEUE : Queue full");
            end if;
         end if;
      end Add_Queue;

      --  Get and remove the next compilation unit descriptor
      --  (Unit_Descriptor) from the queue.
      procedure Get_Next (Unit_Descriptor : out ContextManager.UnitDescriptors)
      --# global in out Queue;
      --# derives Queue,
      --#         Unit_Descriptor from Queue;
      is
      begin
         Unit_Descriptor := ContextManager.NullUnit;
         for I in Queue_1 range 1 .. Queue.Top loop
            if not Queue.The_Array (I).Done then
               Queue.The_Array (I).Done := True;
               Unit_Descriptor          := Queue.The_Array (I).Unit_Descriptor;
               exit;
            end if;
         end loop;
      end Get_Next;

   begin
      --  Reset the closure flag.
      for I in Unit_Pointers range 1 .. Unit_Heap.Last_Used loop
         Unit_Heap.Content (I).Comp_Unit_Flag := 0;
      end loop;
      --  Initiate the closure calculation.
      Get_Unit (Descriptor      => Descriptor,
                Unit_Descriptor => Unit_Descriptor);
      Queue      :=
        Queue_T'
        (The_Array => Queue_Array'(others => Queue_Item'(Unit_Descriptor => ContextManager.NullUnit,
                                                         Done            => True)),
         Top       => 0);
      Spec_Found := False;
      while not Spec_Found loop
         if Unit_Heap.Content (Unit_Descriptor).Unit_Type = ContextManager.PackageBody then
            --  Set the closure flag.
            Unit_Heap.Content (Unit_Descriptor).Comp_Unit_Flag := 1;
            --  It is an Ada package body.
            --  Find the specification of the Unit_Pointer_Body.
            for I in Unit_Pointers range 1 .. Unit_Heap.Last_Used loop
               if LexTokenLists.Eq_Unit
                 (First_Item => Unit_Heap.Content (I).Name,
                  Second     => Unit_Heap.Content (Unit_Descriptor).Name)
                 and then Unit_Heap.Content (I).Unit_Type = ContextManager.PackageSpecification then
                  Add_Queue (Descriptor => I);
                  exit;
               end if;
            end loop;
            Spec_Found := True;
         elsif Unit_Heap.Content (Unit_Descriptor).Unit_Type = ContextManager.GenericSubprogramBody then
            --  Set the closure flag.
            Unit_Heap.Content (Unit_Descriptor).Comp_Unit_Flag := 1;
            --  It is an Ada generic subprogram body.
            --  Find the specification of the Unit_Pointer_Body.
            for I in Unit_Pointers range 1 .. Unit_Heap.Last_Used loop
               if LexTokenLists.Eq_Unit
                 (First_Item => Unit_Heap.Content (I).Name,
                  Second     => Unit_Heap.Content (Unit_Descriptor).Name)
                 and then Unit_Heap.Content (I).Unit_Type = ContextManager.GenericSubprogramDeclaration then
                  Add_Queue (Descriptor => I);
                  exit;
               end if;
            end loop;
            Spec_Found := True;
         elsif Unit_Heap.Content (Unit_Descriptor).Unit_Type = ContextManager.PackageSpecification
           or else Unit_Heap.Content (Unit_Descriptor).Unit_Type = ContextManager.MainProgram then
            --  It is an Ada package specification or an Ada main
            --  program.
            Add_Queue (Descriptor => Unit_Descriptor);
            Spec_Found := True;
         elsif Unit_Heap.Content (Unit_Descriptor).Unit_Type = ContextManager.SubUnit then
            --  Set the closure flag.
            Unit_Heap.Content (Unit_Descriptor).Comp_Unit_Flag := 1;
            --  It is an Ada separate unit
            Get_Parent (Unit_Descriptor => Unit_Descriptor);
            Spec_Found := False;
         else
            Spec_Found := False;
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Other_Internal_Error,
               Msg     => "in ContextManager.Ops.Dependency_Closure");
         end if;
      end loop;
      --  Add the private childs units to the closure (if any).
      IndexManager.Look_Up_Components (Required_Unit => Unit_Heap.Content (Unit_Descriptor).Name,
                                       Components    => Components);
      for I in IndexManager.Component_Index loop
         exit when Components (I) = LexTokenLists.Null_List;
         for J in Unit_Pointers range 1 .. Unit_Heap.Last_Used loop
            if LexTokenLists.Eq_Unit (First_Item => Unit_Heap.Content (J).Name,
                                      Second     => Components (I))
              and then Unit_Heap.Content (J).Unit_Type = ContextManager.PackageSpecification then
               Add_Queue (Descriptor => J);
               exit;
            end if;
         end loop;
      end loop;
      --  Calculate the closure.
      Get_Next (Unit_Descriptor => Unit_Descriptor);
      while Unit_Descriptor /= ContextManager.NullUnit loop
         It :=
           STree.Find_First_Node
           (Node_Kind    => SP_Symbols.dotted_simple_name,
            From_Root    => Unit_Heap.Content (Unit_Descriptor).Inherit_Clause,
            In_Direction => STree.Down);
         while It /= STree.NullIterator loop
            Lex_Str := Build_List (Node => STree.Get_Node (It => It));
            GetUnitByName (Lex_Str, ContextManager.PackageSpecificationSet, Unit_Descriptor);
            if Unit_Descriptor /= ContextManager.NullUnit then
               Add_Queue (Descriptor => Unit_Descriptor);
            end if;
            It := STree.NextNode (It => It);
         end loop;
         Get_Next (Unit_Descriptor => Unit_Descriptor);
      end loop;
      if CommandLineData.Content.Debug.SLI then
         --  Debug
         SPARK_IO.Put_Line (File => SPARK_IO.Standard_Output,
                            Item => "DEBUG DEPENDENCY CLOSURE",
                            Stop => 0);
         for I in Unit_Pointers range 1 .. Unit_Heap.Last_Used loop
            if Unit_Heap.Content (I).Comp_Unit_Flag /= 0 then
               SPARK_IO.Put_String (File => SPARK_IO.Standard_Output,
                                    Item => "COMPILATION UNIT = ",
                                    Stop => 0);
               LexTokenLists.Print_List (File => SPARK_IO.Standard_Output,
                                         List => Unit_Heap.Content (I).Name);
               if Unit_Heap.Content (I).Unit_Type = ContextManager.PackageSpecification or
                 Unit_Heap.Content (I).Unit_Type = ContextManager.GenericSubprogramDeclaration then
                  SPARK_IO.Put_Line (File => SPARK_IO.Standard_Output,
                                     Item => " SPEC",
                                     Stop => 0);
               elsif Unit_Heap.Content (I).Unit_Type = ContextManager.PackageBody or
                 Unit_Heap.Content (I).Unit_Type = ContextManager.SubUnit or
                 Unit_Heap.Content (I).Unit_Type = ContextManager.MainProgram then
                  SPARK_IO.Put_Line (File => SPARK_IO.Standard_Output,
                                     Item => " BODY",
                                     Stop => 0);
               else
                  SPARK_IO.Put_Line (File => SPARK_IO.Standard_Output,
                                     Item => " UNKNOWN",
                                     Stop => 0);
               end if;
            end if;
         end loop;
      end if;
   end Dependency_Closure;

   function In_Closure (Descriptor : in ContextManager.UnitDescriptors) return Boolean is
   begin
      return Unit_Heap.Content (Descriptor).Comp_Unit_Flag /= 0;
   end In_Closure;

   procedure Set_Line_Number (Descriptor  : in ContextManager.UnitDescriptors;
                              Line_Number : in Positive) is
   begin
      Unit_Heap.Content (Descriptor).Comp_Unit_Flag := Line_Number;
   end Set_Line_Number;

   function Get_Line_Number (Descriptor : in ContextManager.UnitDescriptors) return Natural is
   begin
      return Unit_Heap.Content (Descriptor).Comp_Unit_Flag;
   end Get_Line_Number;

begin
   Unit_Heap  := Unit_Heaps'(Content   => Unit_Heap_Contents'(others => Null_Unit_Entry),
                             Last_Used => 0);
   Unit_Stack := Unit_Stacks'(Content => Stack_Contents'(others => ContextManager.NullUnit),
                              Height  => Stack_Heights'First);
   --  Keep this partial initialization due to limitation of the stack
   --  size with MacOS/X. It should be:
   -- File_Heap := File_Heaps'(Content   => File_Heap_Contents'(others => Null_File_Entry),
   --                          Last_Used => 0);
   File_Heap.Last_Used := 0;
   --# accept F, 23, File_Heap.Content, "Partial initialization OK here";
   File_Heap.Content (File_Pointers'First) := Null_File_Entry;
   --# accept F, 602, File_Heap, File_Heap.Content, "Partial initialization OK here";
end ContextManager.Ops;