------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                        B I N D O . W R I T E R S                         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--             Copyright (C) 2019, Free Software Foundation, Inc.           --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT 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 GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Binderr; use Binderr;
with Butil;   use Butil;
with Debug;   use Debug;
with Fname;   use Fname;
with Opt;     use Opt;
with Output;  use Output;

with Bindo.Units;
use  Bindo.Units;

with GNAT;        use GNAT;
with GNAT.Graphs; use GNAT.Graphs;
with GNAT.Sets;   use GNAT.Sets;

package body Bindo.Writers is

   -----------------
   -- ALI_Writers --
   -----------------

   package body ALI_Writers is

      -----------------------
      -- Local subprograms --
      -----------------------

      procedure Write_All_Units;
      pragma Inline (Write_All_Units);
      --  Write the common form of units to standard output

      procedure Write_Invocation_Construct (IC_Id : Invocation_Construct_Id);
      pragma Inline (Write_Invocation_Construct);
      --  Write invocation construct IC_Id to standard output

      procedure Write_Invocation_Relation (IR_Id : Invocation_Relation_Id);
      pragma Inline (Write_Invocation_Relation);
      --  Write invocation relation IR_Id to standard output

      procedure Write_Invocation_Signature (IS_Id : Invocation_Signature_Id);
      pragma Inline (Write_Invocation_Signature);
      --  Write invocation signature IS_Id to standard output

      procedure Write_Statistics;
      pragma Inline (Write_Statistics);
      --  Write the statistical information of units to standard output

      procedure Write_Unit (U_Id : Unit_Id);
      pragma Inline (Write_Unit);
      --  Write the invocation constructs and relations of unit U_Id to
      --  standard output.

      procedure Write_Unit_Common (U_Id : Unit_Id);
      pragma Inline (Write_Unit_Common);
      --  Write the common form of unit U_Id to standard output

      -----------
      -- Debug --
      -----------

      procedure pau renames Write_All_Units;
      pragma Unreferenced (pau);

      procedure pu (U_Id : Unit_Id) renames Write_Unit_Common;
      pragma Unreferenced (pu);

      ----------------------
      -- Write_ALI_Tables --
      ----------------------

      procedure Write_ALI_Tables is
      begin
         --  Nothing to do when switch -d_A (output invocation tables) is not
         --  in effect.

         if not Debug_Flag_Underscore_AA then
            return;
         end if;

         Write_Str ("ALI Tables");
         Write_Eol;
         Write_Eol;

         Write_Statistics;
         For_Each_Unit (Write_Unit'Access);

         Write_Str ("ALI Tables end");
         Write_Eol;
         Write_Eol;
      end Write_ALI_Tables;

      ---------------------
      -- Write_All_Units --
      ---------------------

      procedure Write_All_Units is
      begin
         For_Each_Unit (Write_Unit_Common'Access);
      end Write_All_Units;

      --------------------------------
      -- Write_Invocation_Construct --
      --------------------------------

      procedure Write_Invocation_Construct (IC_Id : Invocation_Construct_Id) is
      begin
         pragma Assert (Present (IC_Id));

         Write_Str ("  invocation construct (IC_Id_");
         Write_Int (Int (IC_Id));
         Write_Str (")");
         Write_Eol;

         Write_Str ("    Body_Placement = ");
         Write_Str (Body_Placement (IC_Id)'Img);
         Write_Eol;

         Write_Str ("    Kind = ");
         Write_Str (Kind (IC_Id)'Img);
         Write_Eol;

         Write_Str ("    Spec_Placement = ");
         Write_Str (Spec_Placement (IC_Id)'Img);
         Write_Eol;

         Write_Invocation_Signature (Signature (IC_Id));
         Write_Eol;
      end Write_Invocation_Construct;

      -------------------------------
      -- Write_Invocation_Relation --
      -------------------------------

      procedure Write_Invocation_Relation (IR_Id : Invocation_Relation_Id) is
      begin
         pragma Assert (Present (IR_Id));

         Write_Str ("  invocation relation (IR_Id_");
         Write_Int (Int (IR_Id));
         Write_Str (")");
         Write_Eol;

         if Present (Extra (IR_Id)) then
            Write_Str  ("    Extra = ");
            Write_Name (Extra (IR_Id));
         else
            Write_Str ("    Extra = none");
         end if;

         Write_Eol;
         Write_Str ("    Invoker");
         Write_Eol;

         Write_Invocation_Signature (Invoker (IR_Id));

         Write_Str ("    Kind = ");
         Write_Str (Kind (IR_Id)'Img);
         Write_Eol;

         Write_Str ("    Target");
         Write_Eol;

         Write_Invocation_Signature (Target (IR_Id));
         Write_Eol;
      end Write_Invocation_Relation;

      --------------------------------
      -- Write_Invocation_Signature --
      --------------------------------

      procedure Write_Invocation_Signature (IS_Id : Invocation_Signature_Id) is
      begin
         pragma Assert (Present (IS_Id));

         Write_Str ("    Signature (IS_Id_");
         Write_Int (Int (IS_Id));
         Write_Str (")");
         Write_Eol;

         Write_Str ("      Column = ");
         Write_Int (Int (Column (IS_Id)));
         Write_Eol;

         Write_Str ("      Line = ");
         Write_Int (Int (Line (IS_Id)));
         Write_Eol;

         if Present (Locations (IS_Id)) then
            Write_Str  ("      Locations = ");
            Write_Name (Locations (IS_Id));
         else
            Write_Str ("      Locations = none");
         end if;

         Write_Eol;
         Write_Str  ("      Name = ");
         Write_Name (Name (IS_Id));
         Write_Eol;

         Write_Str  ("      Scope = ");
         Write_Name (Scope (IS_Id));
         Write_Eol;
      end Write_Invocation_Signature;

      ----------------------
      -- Write_Statistics --
      ----------------------

      procedure Write_Statistics is
      begin
         Write_Str ("Units             : ");
         Write_Num (Int (Number_Of_Units));
         Write_Eol;

         Write_Str ("Units to elaborate: ");
         Write_Num (Int (Number_Of_Elaborable_Units));
         Write_Eol;
         Write_Eol;
      end Write_Statistics;

      ----------------
      -- Write_Unit --
      ----------------

      procedure Write_Unit (U_Id : Unit_Id) is
         pragma Assert (Present (U_Id));

         U_Rec : Unit_Record renames ALI.Units.Table (U_Id);

      begin
         Write_Unit_Common (U_Id);

         Write_Str ("  First_Invocation_Construct (IC_Id_");
         Write_Int (Int (U_Rec.First_Invocation_Construct));
         Write_Str (")");
         Write_Eol;

         Write_Str ("  Last_Invocation_Construct  (IC_Id_");
         Write_Int (Int (U_Rec.Last_Invocation_Construct));
         Write_Str (")");
         Write_Eol;

         Write_Str ("  First_Invocation_Relation  (IR_Id_");
         Write_Int (Int (U_Rec.First_Invocation_Relation));
         Write_Str (")");
         Write_Eol;

         Write_Str ("  Last_Invocation_Relation   (IR_Id_");
         Write_Int (Int (U_Rec.Last_Invocation_Relation));
         Write_Str (")");
         Write_Eol;

         Write_Str ("  Invocation_Graph_Encoding = ");
         Write_Str (Invocation_Graph_Encoding (U_Id)'Img);
         Write_Eol;
         Write_Eol;

         For_Each_Invocation_Construct
           (U_Id      => U_Id,
            Processor => Write_Invocation_Construct'Access);

         For_Each_Invocation_Relation
           (U_Id      => U_Id,
            Processor => Write_Invocation_Relation'Access);
      end Write_Unit;

      -----------------------
      -- Write_Unit_Common --
      -----------------------

      procedure Write_Unit_Common (U_Id : Unit_Id) is
         pragma Assert (Present (U_Id));

         U_Rec : Unit_Record renames ALI.Units.Table (U_Id);

      begin
         Write_Str  ("unit (U_Id_");
         Write_Int  (Int (U_Id));
         Write_Str  (") name = ");
         Write_Name (U_Rec.Uname);
         Write_Eol;

         if U_Rec.SAL_Interface then
            Write_Str ("  SAL_Interface = True");
            Write_Eol;
         end if;
      end Write_Unit_Common;
   end ALI_Writers;

   -------------------
   -- Cycle_Writers --
   -------------------

   package body Cycle_Writers is

      -----------------------
      -- Local subprograms --
      -----------------------

      procedure Write_Cycle
        (G     : Library_Graph;
         Cycle : Library_Graph_Cycle_Id);
      pragma Inline (Write_Cycle);
      --  Write the path of cycle Cycle found in library graph G to standard
      --  output.

      procedure Write_Cyclic_Edge
        (G    : Library_Graph;
         Edge : Library_Graph_Edge_Id);
      pragma Inline (Write_Cyclic_Edge);
      --  Write cyclic edge Edge of library graph G to standard

      -----------
      -- Debug --
      -----------

      procedure palgc (G : Library_Graph) renames Write_Cycles;
      pragma Unreferenced (palgc);

      procedure plgc
        (G     : Library_Graph;
         Cycle : Library_Graph_Cycle_Id) renames Write_Cycle;
      pragma Unreferenced (plgc);

      -----------------
      -- Write_Cycle --
      -----------------

      procedure Write_Cycle
        (G     : Library_Graph;
         Cycle : Library_Graph_Cycle_Id)
      is
         Edge : Library_Graph_Edge_Id;
         Iter : Edges_Of_Cycle_Iterator;

      begin
         pragma Assert (Present (G));
         pragma Assert (Present (Cycle));

         --  Nothing to do when switch -d_P (output cycle paths) is not in
         --  effect.

         if not Debug_Flag_Underscore_PP then
            return;
         end if;

         Write_Str ("cycle (LGC_Id_");
         Write_Int (Int (Cycle));
         Write_Str (")");
         Write_Eol;

         Iter := Iterate_Edges_Of_Cycle (G, Cycle);
         while Has_Next (Iter) loop
            Next (Iter, Edge);

            Write_Cyclic_Edge (G, Edge);
         end loop;

         Write_Eol;
      end Write_Cycle;

      ------------------
      -- Write_Cycles --
      ------------------

      procedure Write_Cycles (G : Library_Graph) is
         Cycle : Library_Graph_Cycle_Id;
         Iter  : All_Cycle_Iterator;

      begin
         pragma Assert (Present (G));

         Iter := Iterate_All_Cycles (G);
         while Has_Next (Iter) loop
            Next (Iter, Cycle);

            Write_Cycle (G, Cycle);
         end loop;
      end Write_Cycles;

      -----------------------
      -- Write_Cyclic_Edge --
      -----------------------

      procedure Write_Cyclic_Edge
        (G    : Library_Graph;
         Edge : Library_Graph_Edge_Id)
      is
         pragma Assert (Present (G));
         pragma Assert (Present (Edge));

         Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
         Succ : constant Library_Graph_Vertex_Id := Successor   (G, Edge);

      begin
         Indent_By (Nested_Indentation);
         Write_Name (Name (G, Succ));
         Write_Str  (" --> ");
         Write_Name (Name (G, Pred));
         Write_Str  ("   ");

         if Is_Elaborate_All_Edge (G, Edge) then
            Write_Str ("Elaborate_All edge");

         elsif Is_Elaborate_Body_Edge (G, Edge) then
            Write_Str ("Elaborate_Body edge");

         elsif Is_Elaborate_Edge (G, Edge) then
            Write_Str ("Elaborate edge");

         elsif Is_Forced_Edge (G, Edge) then
            Write_Str ("forced edge");

         elsif Is_Invocation_Edge (G, Edge) then
            Write_Str ("invocation edge");

         else
            pragma Assert (Is_With_Edge (G, Edge));

            Write_Str ("with edge");
         end if;

         Write_Eol;
      end Write_Cyclic_Edge;
   end Cycle_Writers;

   ------------------------
   -- Dependency_Writers --
   ------------------------

   package body Dependency_Writers is

      -----------------------
      -- Local subprograms --
      -----------------------

      procedure Write_Dependencies_Of_Vertex
        (G      : Library_Graph;
         Vertex : Library_Graph_Vertex_Id);
      pragma Inline (Write_Dependencies_Of_Vertex);
      --  Write the dependencies of vertex Vertex of library graph G to
      --  standard output.

      procedure Write_Dependency_Edge
        (G    : Library_Graph;
         Edge : Library_Graph_Edge_Id);
      pragma Inline (Write_Dependency_Edge);
      --  Write the dependency described by edge Edge of library graph G to
      --  standard output.

      ------------------------
      -- Write_Dependencies --
      ------------------------

      procedure Write_Dependencies (G : Library_Graph) is
         Use_Formatting : constant Boolean := not Zero_Formatting;

         Iter   : Library_Graphs.All_Vertex_Iterator;
         Vertex : Library_Graph_Vertex_Id;

      begin
         pragma Assert (Present (G));

         --  Nothing to do when switch -e (output complete list of elaboration
         --  order dependencies) is not in effect.

         if not Elab_Dependency_Output then
            return;
         end if;

         if Use_Formatting then
            Write_Eol;
            Write_Line ("ELABORATION ORDER DEPENDENCIES");
            Write_Eol;
         end if;

         Info_Prefix_Suppress := True;

         Iter := Iterate_All_Vertices (G);
         while Has_Next (Iter) loop
            Next (Iter, Vertex);

            Write_Dependencies_Of_Vertex (G, Vertex);
         end loop;

         Info_Prefix_Suppress := False;

         if Use_Formatting then
            Write_Eol;
         end if;
      end Write_Dependencies;

      ----------------------------------
      -- Write_Dependencies_Of_Vertex --
      ----------------------------------

      procedure Write_Dependencies_Of_Vertex
        (G      : Library_Graph;
         Vertex : Library_Graph_Vertex_Id)
      is
         Edge : Library_Graph_Edge_Id;
         Iter : Edges_To_Successors_Iterator;

      begin
         pragma Assert (Present (G));
         pragma Assert (Present (Vertex));

         --  Nothing to do for internal and predefined units

         if Is_Internal_Unit (G, Vertex)
           or else Is_Predefined_Unit (G, Vertex)
         then
            return;
         end if;

         Iter := Iterate_Edges_To_Successors (G, Vertex);
         while Has_Next (Iter) loop
            Next (Iter, Edge);

            Write_Dependency_Edge (G, Edge);
         end loop;
      end Write_Dependencies_Of_Vertex;

      ---------------------------
      -- Write_Dependency_Edge --
      ---------------------------

      procedure Write_Dependency_Edge
        (G    : Library_Graph;
         Edge : Library_Graph_Edge_Id)
      is
         pragma Assert (Present (G));
         pragma Assert (Present (Edge));

         Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
         Succ : constant Library_Graph_Vertex_Id := Successor   (G, Edge);

      begin
         --  Nothing to do for internal and predefined units

         if Is_Internal_Unit (G, Succ)
           or else Is_Predefined_Unit (G, Succ)
         then
            return;
         end if;

         Error_Msg_Unit_1 := Name (G, Pred);
         Error_Msg_Unit_2 := Name (G, Succ);
         Error_Msg_Output
           (Msg  => "   unit $ must be elaborated before unit $",
            Info => True);

         Error_Msg_Unit_1 := Name (G, Succ);
         Error_Msg_Unit_2 := Name (G, Pred);

         if Is_Elaborate_All_Edge (G, Edge) then
            Error_Msg_Output
              (Msg  =>
                 "     reason: unit $ has with clause and pragma "
                 & "Elaborate_All for unit $",
               Info => True);

         elsif Is_Elaborate_Body_Edge (G, Edge) then
            Error_Msg_Output
              (Msg  => "     reason: unit $ has with clause for unit $",
               Info => True);

         elsif Is_Elaborate_Edge (G, Edge) then
            Error_Msg_Output
              (Msg  =>
                 "     reason: unit $ has with clause and pragma Elaborate "
                 & "for unit $",
               Info => True);

         elsif Is_Forced_Edge (G, Edge) then
            Error_Msg_Output
              (Msg  =>
                 "     reason: unit $ has a dependency on unit $ forced by -f "
                 & "switch",
               Info => True);

         elsif Is_Invocation_Edge (G, Edge) then
            Error_Msg_Output
              (Msg  =>
                 "     reason: unit $ invokes a construct of unit $ at "
                 & "elaboration time",
               Info => True);

         elsif Is_Spec_Before_Body_Edge (G, Edge) then
            Error_Msg_Output
              (Msg  => "     reason: spec must be elaborated before body",
               Info => True);

         else
            pragma Assert (Is_With_Edge (G, Edge));

            Error_Msg_Output
              (Msg  => "     reason: unit $ has with clause for unit $",
               Info => True);
         end if;
      end Write_Dependency_Edge;
   end Dependency_Writers;

   -------------------------------
   -- Elaboration_Order_Writers --
   -------------------------------

   package body Elaboration_Order_Writers is

      -----------------------
      -- Local subprograms --
      -----------------------

      procedure Write_Unit (U_Id : Unit_Id);
      pragma Inline (Write_Unit);
      --  Write unit U_Id to standard output

      procedure Write_Units (Order : Unit_Id_Table);
      pragma Inline (Write_Units);
      --  Write all units found in elaboration order Order to standard output

      -----------------------------
      -- Write_Elaboration_Order --
      -----------------------------

      procedure Write_Elaboration_Order (Order : Unit_Id_Table) is
         Use_Formatting : constant Boolean := not Zero_Formatting;

      begin
         --  Nothing to do when switch -l (output chosen elaboration order) is
         --  not in effect.

         if not Elab_Order_Output then
            return;
         end if;

         if Use_Formatting then
            Write_Eol;
            Write_Str ("ELABORATION ORDER");
            Write_Eol;
         end if;

         Write_Units (Order);

         if Use_Formatting then
            Write_Eol;
         end if;
      end Write_Elaboration_Order;

      ----------------
      -- Write_Unit --
      ----------------

      procedure Write_Unit (U_Id : Unit_Id) is
         Use_Formatting : constant Boolean := not Zero_Formatting;

      begin
         pragma Assert (Present (U_Id));

         if Use_Formatting then
            Write_Str ("   ");
         end if;

         Write_Unit_Name (Name (U_Id));
         Write_Eol;
      end Write_Unit;

      -----------------
      -- Write_Units --
      -----------------

      procedure Write_Units (Order : Unit_Id_Table) is
      begin
         for Index in Unit_Id_Tables.First .. Unit_Id_Tables.Last (Order) loop
            Write_Unit (Order.Table (Index));
         end loop;
      end Write_Units;
   end Elaboration_Order_Writers;

   ---------------
   -- Indent_By --
   ---------------

   procedure Indent_By (Indent : Indentation_Level) is
   begin
      for Count in 1 .. Indent loop
         Write_Char (' ');
      end loop;
   end Indent_By;

   ------------------------------
   -- Invocation_Graph_Writers --
   ------------------------------

   package body Invocation_Graph_Writers is

      -----------------------
      -- Local subprograms --
      -----------------------

      procedure Write_Elaboration_Root
        (G    : Invocation_Graph;
         Root : Invocation_Graph_Vertex_Id);
      pragma Inline (Write_Elaboration_Root);
      --  Write elaboration root Root of invocation graph G to standard output

      procedure Write_Elaboration_Roots (G : Invocation_Graph);
      pragma Inline (Write_Elaboration_Roots);
      --  Write all elaboration roots of invocation graph G to standard output

      procedure Write_Invocation_Graph_Edge
        (G    : Invocation_Graph;
         Edge : Invocation_Graph_Edge_Id);
      pragma Inline (Write_Invocation_Graph_Edge);
      --  Write edge Edge of invocation graph G to standard output

      procedure Write_Invocation_Graph_Edges
        (G      : Invocation_Graph;
         Vertex : Invocation_Graph_Vertex_Id);
      pragma Inline (Write_Invocation_Graph_Edges);
      --  Write all edges to targets of vertex Vertex of invocation graph G to
      --  standard output.

      procedure Write_Invocation_Graph_Vertex
        (G      : Invocation_Graph;
         Vertex : Invocation_Graph_Vertex_Id);
      pragma Inline (Write_Invocation_Graph_Vertex);
      --  Write vertex Vertex of invocation graph G to standard output

      procedure Write_Invocation_Graph_Vertices (G : Invocation_Graph);
      pragma Inline (Write_Invocation_Graph_Vertices);
      --  Write all vertices of invocation graph G to standard output

      procedure Write_Statistics (G : Invocation_Graph);
      pragma Inline (Write_Statistics);
      --  Write the statistical information of invocation graph G to standard
      --  output.

      -----------
      -- Debug --
      -----------

      procedure pige
        (G    : Invocation_Graph;
         Edge : Invocation_Graph_Edge_Id) renames Write_Invocation_Graph_Edge;
      pragma Unreferenced (pige);

      procedure pigv
        (G      : Invocation_Graph;
         Vertex : Invocation_Graph_Vertex_Id)
         renames Write_Invocation_Graph_Vertex;
      pragma Unreferenced (pigv);

      ----------------------------
      -- Write_Elaboration_Root --
      ----------------------------

      procedure Write_Elaboration_Root
        (G    : Invocation_Graph;
         Root : Invocation_Graph_Vertex_Id)
      is
      begin
         pragma Assert (Present (G));
         pragma Assert (Present (Root));

         Write_Str  ("elaboration root (IGV_Id_");
         Write_Int  (Int (Root));
         Write_Str  (") name = ");
         Write_Name (Name (G, Root));
         Write_Eol;
      end Write_Elaboration_Root;

      -----------------------------
      -- Write_Elaboration_Roots --
      -----------------------------

      procedure Write_Elaboration_Roots (G : Invocation_Graph) is
         pragma Assert (Present (G));

         Num_Of_Roots : constant Natural := Number_Of_Elaboration_Roots (G);

         Iter : Elaboration_Root_Iterator;
         Root : Invocation_Graph_Vertex_Id;

      begin
         Write_Str ("Elaboration roots: ");
         Write_Int (Int (Num_Of_Roots));
         Write_Eol;

         if Num_Of_Roots > 0 then
            Iter := Iterate_Elaboration_Roots (G);
            while Has_Next (Iter) loop
               Next (Iter, Root);

               Write_Elaboration_Root (G, Root);
            end loop;
         else
            Write_Eol;
         end if;
      end Write_Elaboration_Roots;

      ----------------------------
      -- Write_Invocation_Graph --
      ----------------------------

      procedure Write_Invocation_Graph (G : Invocation_Graph) is
      begin
         pragma Assert (Present (G));

         --  Nothing to do when switch -d_I (output invocation graph) is not in
         --  effect.

         if not Debug_Flag_Underscore_II then
            return;
         end if;

         Write_Str ("Invocation Graph");
         Write_Eol;
         Write_Eol;

         Write_Statistics (G);
         Write_Invocation_Graph_Vertices (G);
         Write_Elaboration_Roots (G);

         Write_Str ("Invocation Graph end");
         Write_Eol;

         Write_Eol;
      end Write_Invocation_Graph;

      ---------------------------------
      -- Write_Invocation_Graph_Edge --
      ---------------------------------

      procedure Write_Invocation_Graph_Edge
        (G    : Invocation_Graph;
         Edge : Invocation_Graph_Edge_Id)
      is
         pragma Assert (Present (G));
         pragma Assert (Present (Edge));

         Targ : constant Invocation_Graph_Vertex_Id := Target (G, Edge);

      begin
         Write_Str ("    invocation graph edge (IGE_Id_");
         Write_Int (Int (Edge));
         Write_Str (")");
         Write_Eol;

         Write_Str ("      Relation (IR_Id_");
         Write_Int (Int (Relation (G, Edge)));
         Write_Str (")");
         Write_Eol;

         Write_Str ("      Target (IGV_Id_");
         Write_Int (Int (Targ));
         Write_Str (") name = ");
         Write_Name (Name (G, Targ));
         Write_Eol;

         Write_Eol;
      end Write_Invocation_Graph_Edge;

      ----------------------------------
      -- Write_Invocation_Graph_Edges --
      ----------------------------------

      procedure Write_Invocation_Graph_Edges
        (G      : Invocation_Graph;
         Vertex : Invocation_Graph_Vertex_Id)
      is
         pragma Assert (Present (G));
         pragma Assert (Present (Vertex));

         Num_Of_Edges : constant Natural :=
                          Number_Of_Edges_To_Targets (G, Vertex);

         Edge : Invocation_Graph_Edge_Id;
         Iter : Invocation_Graphs.Edges_To_Targets_Iterator;

      begin
         Write_Str ("  Edges to targets: ");
         Write_Int (Int (Num_Of_Edges));
         Write_Eol;

         if Num_Of_Edges > 0 then
            Iter := Iterate_Edges_To_Targets (G, Vertex);
            while Has_Next (Iter) loop
               Next (Iter, Edge);

               Write_Invocation_Graph_Edge (G, Edge);
            end loop;
         else
            Write_Eol;
         end if;
      end Write_Invocation_Graph_Edges;

      -----------------------------------
      -- Write_Invocation_Graph_Vertex --
      -----------------------------------

      procedure Write_Invocation_Graph_Vertex
        (G      : Invocation_Graph;
         Vertex : Invocation_Graph_Vertex_Id)
      is
      begin
         pragma Assert (Present (G));
         pragma Assert (Present (Vertex));

         Write_Str  ("invocation graph vertex (IGV_Id_");
         Write_Int  (Int (Vertex));
         Write_Str  (") name = ");
         Write_Name (Name (G, Vertex));
         Write_Eol;

         Write_Str ("  Body_Vertex (LGV_Id_");
         Write_Int (Int (Body_Vertex (G, Vertex)));
         Write_Str (")");
         Write_Eol;

         Write_Str ("  Construct (IC_Id_");
         Write_Int (Int (Construct (G, Vertex)));
         Write_Str (")");
         Write_Eol;

         Write_Str ("  Spec_Vertex (LGV_Id_");
         Write_Int (Int (Spec_Vertex (G, Vertex)));
         Write_Str (")");
         Write_Eol;

         Write_Invocation_Graph_Edges (G, Vertex);
      end Write_Invocation_Graph_Vertex;

      -------------------------------------
      -- Write_Invocation_Graph_Vertices --
      -------------------------------------

      procedure Write_Invocation_Graph_Vertices (G : Invocation_Graph) is
         Iter   : Invocation_Graphs.All_Vertex_Iterator;
         Vertex : Invocation_Graph_Vertex_Id;

      begin
         pragma Assert (Present (G));

         Iter := Iterate_All_Vertices (G);
         while Has_Next (Iter) loop
            Next (Iter, Vertex);

            Write_Invocation_Graph_Vertex (G, Vertex);
         end loop;
      end Write_Invocation_Graph_Vertices;

      ----------------------
      -- Write_Statistics --
      ----------------------

      procedure Write_Statistics (G : Invocation_Graph) is
      begin
         pragma Assert (Present (G));

         Write_Str ("Edges   : ");
         Write_Num (Int (Number_Of_Edges (G)));
         Write_Eol;

         Write_Str ("Roots   : ");
         Write_Num (Int (Number_Of_Elaboration_Roots (G)));
         Write_Eol;

         Write_Str ("Vertices: ");
         Write_Num (Int (Number_Of_Vertices (G)));
         Write_Eol;
         Write_Eol;

         for Kind in Invocation_Kind'Range loop
            Write_Str ("  ");
            Write_Num (Int (Invocation_Graph_Edge_Count (G, Kind)));
            Write_Str (" - ");
            Write_Str (Kind'Img);
            Write_Eol;
         end loop;

         Write_Eol;
      end Write_Statistics;
   end Invocation_Graph_Writers;

   ---------------------------
   -- Library_Graph_Writers --
   ---------------------------

   package body Library_Graph_Writers is

      -----------------------
      -- Local subprograms --
      -----------------------

      procedure Write_Component
        (G    : Library_Graph;
         Comp : Component_Id);
      pragma Inline (Write_Component);
      --  Write component Comp of library graph G to standard output

      procedure Write_Component_Vertices
        (G    : Library_Graph;
         Comp : Component_Id);
      pragma Inline (Write_Component_Vertices);
      --  Write all vertices of component Comp of library graph G to standard
      --  output.

      procedure Write_Components (G : Library_Graph);
      pragma Inline (Write_Component);
      --  Write all components of library graph G to standard output

      procedure Write_Edges_To_Successors
        (G      : Library_Graph;
         Vertex : Library_Graph_Vertex_Id);
      pragma Inline (Write_Edges_To_Successors);
      --  Write all edges to successors of predecessor Vertex of library graph
      --  G to standard output.

      procedure Write_Library_Graph_Edge
        (G    : Library_Graph;
         Edge : Library_Graph_Edge_Id);
      pragma Inline (Write_Library_Graph_Edge);
      --  Write edge Edge of library graph G to standard output

      procedure Write_Library_Graph_Vertex
        (G      : Library_Graph;
         Vertex : Library_Graph_Vertex_Id);
      pragma Inline (Write_Library_Graph_Vertex);
      --  Write vertex Vertex of library graph G to standard output

      procedure Write_Library_Graph_Vertices (G : Library_Graph);
      pragma Inline (Write_Library_Graph_Vertices);
      --  Write all vertices of library graph G to standard output

      procedure Write_Statistics (G : Library_Graph);
      pragma Inline (Write_Statistics);
      --  Write the statistical information of library graph G to standard
      --  output.

      -----------
      -- Debug --
      -----------

      procedure pc
        (G    : Library_Graph;
         Comp : Component_Id) renames Write_Component;
      pragma Unreferenced (pc);

      procedure plge
        (G    : Library_Graph;
         Edge : Library_Graph_Edge_Id) renames Write_Library_Graph_Edge;
      pragma Unreferenced (plge);

      procedure plgv
        (G      : Library_Graph;
         Vertex : Library_Graph_Vertex_Id) renames Write_Library_Graph_Vertex;
      pragma Unreferenced (plgv);

      ---------------------
      -- Write_Component --
      ---------------------

      procedure Write_Component
        (G    : Library_Graph;
         Comp : Component_Id)
      is
      begin
         pragma Assert (Present (G));
         pragma Assert (Present (Comp));

         Write_Str ("component (Comp_");
         Write_Int (Int (Comp));
         Write_Str (")");
         Write_Eol;

         Write_Str ("  Pending_Strong_Predecessors = ");
         Write_Int (Int (Pending_Strong_Predecessors (G, Comp)));
         Write_Eol;

         Write_Str ("  Pending_Weak_Predecessors   = ");
         Write_Int (Int (Pending_Weak_Predecessors (G, Comp)));
         Write_Eol;

         Write_Component_Vertices (G, Comp);

         Write_Eol;
      end Write_Component;

      ------------------------------
      -- Write_Component_Vertices --
      ------------------------------

      procedure Write_Component_Vertices
        (G    : Library_Graph;
         Comp : Component_Id)
      is
         pragma Assert (Present (G));
         pragma Assert (Present (Comp));

         Num_Of_Vertices : constant Natural :=
                             Number_Of_Component_Vertices (G, Comp);

         Iter   : Component_Vertex_Iterator;
         Vertex : Library_Graph_Vertex_Id;

      begin
         Write_Str ("  Vertices: ");
         Write_Int (Int (Num_Of_Vertices));
         Write_Eol;

         if Num_Of_Vertices > 0 then
            Iter := Iterate_Component_Vertices (G, Comp);
            while Has_Next (Iter) loop
               Next (Iter, Vertex);

               Write_Str  ("    library graph vertex (LGV_Id_");
               Write_Int  (Int (Vertex));
               Write_Str  (") name = ");
               Write_Name (Name (G, Vertex));
               Write_Eol;
            end loop;
         else
            Write_Eol;
         end if;
      end Write_Component_Vertices;

      ----------------------
      -- Write_Components --
      ----------------------

      procedure Write_Components (G : Library_Graph) is
         pragma Assert (Present (G));

         Num_Of_Comps : constant Natural := Number_Of_Components (G);

         Comp : Component_Id;
         Iter : Component_Iterator;

      begin
         --  Nothing to do when switch -d_L (output library item graph) is not
         --  in effect.

         if not Debug_Flag_Underscore_LL then
            return;
         end if;

         Write_Str ("Library Graph components");
         Write_Eol;
         Write_Eol;

         if Num_Of_Comps > 0 then
            Write_Str ("Components: ");
            Write_Num (Int (Num_Of_Comps));
            Write_Eol;

            Iter := Iterate_Components (G);
            while Has_Next (Iter) loop
               Next (Iter, Comp);

               Write_Component (G, Comp);
            end loop;
         else
            Write_Eol;
         end if;

         Write_Str ("Library Graph components end");
         Write_Eol;

         Write_Eol;
      end Write_Components;

      -------------------------------
      -- Write_Edges_To_Successors --
      -------------------------------

      procedure Write_Edges_To_Successors
        (G      : Library_Graph;
         Vertex : Library_Graph_Vertex_Id)
      is
         pragma Assert (Present (G));
         pragma Assert (Present (Vertex));

         Num_Of_Edges : constant Natural :=
                          Number_Of_Edges_To_Successors (G, Vertex);

         Edge : Library_Graph_Edge_Id;
         Iter : Edges_To_Successors_Iterator;

      begin
         Write_Str ("  Edges to successors: ");
         Write_Int (Int (Num_Of_Edges));
         Write_Eol;

         if Num_Of_Edges > 0 then
            Iter := Iterate_Edges_To_Successors (G, Vertex);
            while Has_Next (Iter) loop
               Next (Iter, Edge);

               Write_Library_Graph_Edge (G, Edge);
            end loop;
         else
            Write_Eol;
         end if;
      end Write_Edges_To_Successors;

      -------------------------
      -- Write_Library_Graph --
      -------------------------

      procedure Write_Library_Graph (G : Library_Graph) is
      begin
         pragma Assert (Present (G));

         --  Nothing to do when switch -d_L (output library item graph) is not
         --  in effect.

         if not Debug_Flag_Underscore_LL then
            return;
         end if;

         Write_Str ("Library Graph");
         Write_Eol;
         Write_Eol;

         Write_Statistics (G);
         Write_Library_Graph_Vertices (G);
         Write_Components (G);

         Write_Str ("Library Graph end");
         Write_Eol;

         Write_Eol;
      end Write_Library_Graph;

      ------------------------------
      -- Write_Library_Graph_Edge --
      ------------------------------

      procedure Write_Library_Graph_Edge
        (G    : Library_Graph;
         Edge : Library_Graph_Edge_Id)
      is
         pragma Assert (Present (G));
         pragma Assert (Present (Edge));

         Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
         Succ : constant Library_Graph_Vertex_Id := Successor   (G, Edge);

      begin
         Write_Str ("    library graph edge (LGE_Id_");
         Write_Int (Int (Edge));
         Write_Str (")");
         Write_Eol;

         Write_Str ("      Kind = ");
         Write_Str (Kind (G, Edge)'Img);
         Write_Eol;

         Write_Str  ("      Predecessor (LGV_Id_");
         Write_Int  (Int (Pred));
         Write_Str  (") name = ");
         Write_Name (Name (G, Pred));
         Write_Eol;

         Write_Str  ("      Successor   (LGV_Id_");
         Write_Int  (Int (Succ));
         Write_Str  (") name = ");
         Write_Name (Name (G, Succ));
         Write_Eol;

         Write_Eol;
      end Write_Library_Graph_Edge;

      --------------------------------
      -- Write_Library_Graph_Vertex --
      --------------------------------

      procedure Write_Library_Graph_Vertex
        (G      : Library_Graph;
         Vertex : Library_Graph_Vertex_Id)
      is
         pragma Assert (Present (G));
         pragma Assert (Present (Vertex));

         Item : constant Library_Graph_Vertex_Id :=
                  Corresponding_Item (G, Vertex);
         U_Id : constant Unit_Id := Unit (G, Vertex);

      begin
         Write_Str  ("library graph vertex (LGV_Id_");
         Write_Int  (Int (Vertex));
         Write_Str  (") name = ");
         Write_Name (Name (G, Vertex));
         Write_Eol;

         if Present (Item) then
            Write_Str  ("  Corresponding_Item (LGV_Id_");
            Write_Int  (Int (Item));
            Write_Str  (") name = ");
            Write_Name (Name (G, Item));
         else
            Write_Str ("  Corresponding_Item = none");
         end if;

         Write_Eol;
         Write_Str ("  In_Elaboration_Order = ");

         if In_Elaboration_Order (G, Vertex) then
            Write_Str ("True");
         else
            Write_Str ("False");
         end if;

         Write_Eol;
         Write_Str ("  Pending_Strong_Predecessors = ");
         Write_Int (Int (Pending_Strong_Predecessors (G, Vertex)));
         Write_Eol;

         Write_Str ("  Pending_Weak_Predecessors   = ");
         Write_Int (Int (Pending_Weak_Predecessors (G, Vertex)));
         Write_Eol;

         Write_Str ("  Component (Comp_Id_");
         Write_Int (Int (Component (G, Vertex)));
         Write_Str (")");
         Write_Eol;

         Write_Str  ("  Unit (U_Id_");
         Write_Int  (Int (U_Id));
         Write_Str  (") name = ");
         Write_Name (Name (U_Id));
         Write_Eol;

         Write_Edges_To_Successors (G, Vertex);
      end Write_Library_Graph_Vertex;

      ----------------------------------
      -- Write_Library_Graph_Vertices --
      ----------------------------------

      procedure Write_Library_Graph_Vertices (G : Library_Graph) is
         Iter   : Library_Graphs.All_Vertex_Iterator;
         Vertex : Library_Graph_Vertex_Id;

      begin
         pragma Assert (Present (G));

         Iter := Iterate_All_Vertices (G);
         while Has_Next (Iter) loop
            Next (Iter, Vertex);

            Write_Library_Graph_Vertex (G, Vertex);
         end loop;
      end Write_Library_Graph_Vertices;

      ----------------------
      -- Write_Statistics --
      ----------------------

      procedure Write_Statistics (G : Library_Graph) is
      begin
         Write_Str ("Components: ");
         Write_Num (Int (Number_Of_Components (G)));
         Write_Eol;

         Write_Str ("Edges     : ");
         Write_Num (Int (Number_Of_Edges (G)));
         Write_Eol;

         Write_Str ("Vertices  : ");
         Write_Num (Int (Number_Of_Vertices (G)));
         Write_Eol;
         Write_Eol;

         for Kind in Library_Graph_Edge_Kind'Range loop
            Write_Str ("  ");
            Write_Num (Int (Library_Graph_Edge_Count (G, Kind)));
            Write_Str (" - ");
            Write_Str (Kind'Img);
            Write_Eol;
         end loop;

         Write_Eol;
      end Write_Statistics;
   end Library_Graph_Writers;

   -------------------
   -- Phase_Writers --
   -------------------

   package body Phase_Writers is

      subtype Phase_Message is String (1 .. 32);

      --  The following table contains the phase-specific messages for phase
      --  completion.

      End_Messages : constant array (Elaboration_Phase) of Phase_Message :=
        (Component_Discovery           => "components discovered.          ",
         Cycle_Diagnostics             => "cycle diagnosed.                ",
         Cycle_Discovery               => "cycles discovered.              ",
         Cycle_Validation              => "cycles validated.               ",
         Elaboration_Order_Validation  => "elaboration order validated.    ",
         Invocation_Graph_Construction => "invocation graph constructed.   ",
         Invocation_Graph_Validation   => "invocation graph validated.     ",
         Library_Graph_Augmentation    => "library graph augmented.        ",
         Library_Graph_Construction    => "library graph constructed.      ",
         Library_Graph_Elaboration     => "library graph elaborated.       ",
         Library_Graph_Validation      => "library graph validated.        ",
         Unit_Collection               => "units collected.                ",
         Unit_Elaboration              => "units elaborated.               ");

      --  The following table contains the phase-specific messages for phase
      --  commencement.

      Start_Messages : constant array (Elaboration_Phase) of Phase_Message :=
        (Component_Discovery           => "discovering components...       ",
         Cycle_Diagnostics             => "diagnosing cycle...             ",
         Cycle_Discovery               => "discovering cycles...           ",
         Cycle_Validation              => "validating cycles...            ",
         Elaboration_Order_Validation  => "validating elaboration order... ",
         Invocation_Graph_Construction => "constructing invocation graph...",
         Invocation_Graph_Validation   => "validating invocation graph...  ",
         Library_Graph_Augmentation    => "augmenting library graph...     ",
         Library_Graph_Construction    => "constructing library graph...   ",
         Library_Graph_Elaboration     => "elaborating library graph...    ",
         Library_Graph_Validation      => "validating library graph...     ",
         Unit_Collection               => "collecting units...             ",
         Unit_Elaboration              => "elaborating units...            ");

      -----------------------
      -- Local subprograms --
      -----------------------

      procedure Write_Phase_Message (Msg : Phase_Message);
      pragma Inline (Write_Phase_Message);
      --  Write elaboration phase-related message Msg to standard output

      ---------------
      -- End_Phase --
      ---------------

      procedure End_Phase (Phase : Elaboration_Phase) is
      begin
         Write_Phase_Message (End_Messages (Phase));
      end End_Phase;

      -----------------
      -- Start_Phase --
      -----------------

      procedure Start_Phase (Phase : Elaboration_Phase) is
      begin
         Write_Phase_Message (Start_Messages (Phase));
      end Start_Phase;

      -------------------------
      -- Write_Phase_Message --
      -------------------------

      procedure Write_Phase_Message (Msg : Phase_Message) is
      begin
         --  Nothing to do when switch -d_S (output elaboration order status)
         --  is not in effect.

         if not Debug_Flag_Underscore_SS then
            return;
         end if;

         Write_Str (Msg);
         Write_Eol;
      end Write_Phase_Message;
   end Phase_Writers;

   --------------------------
   -- Unit_Closure_Writers --
   --------------------------

   package body Unit_Closure_Writers is
      function Hash_File_Name (Nam : File_Name_Type) return Bucket_Range_Type;
      pragma Inline (Hash_File_Name);
      --  Obtain the hash value of key Nam

      package File_Name_Tables is new Membership_Sets
        (Element_Type => File_Name_Type,
         "="          => "=",
         Hash         => Hash_File_Name);
      use File_Name_Tables;

      -----------------------
      -- Local subprograms --
      -----------------------

      procedure Write_File_Name (Nam : File_Name_Type);
      pragma Inline (Write_File_Name);
      --  Write file name Nam to standard output

      procedure Write_Subunit_Closure
        (Dep : Sdep_Id;
         Set : Membership_Set);
      pragma Inline (Write_Subunit_Closure);
      --  Write the subunit which corresponds to dependency Dep to standard
      --  output if it does not appear in set Set.

      procedure Write_Subunits_Closure (Set : Membership_Set);
      pragma Inline (Write_Subunits_Closure);
      --  Write all subunits to standard output if they do not appear in set
      --  Set.

      procedure Write_Unit_Closure
        (U_Id : Unit_Id;
         Set  : Membership_Set);
      pragma Inline (Write_Unit_Closure);
      --  Write unit U_Id to standard output if it does not appear in set Set

      procedure Write_Units_Closure
        (Order : Unit_Id_Table;
         Set   : Membership_Set);
      pragma Inline (Write_Units_Closure);
      --  Write all units of elaboration order Order to standard output if they
      --  do not appear in set Set.

      --------------------
      -- Hash_File_Name --
      --------------------

      function Hash_File_Name
        (Nam : File_Name_Type) return Bucket_Range_Type
      is
      begin
         pragma Assert (Present (Nam));

         return Bucket_Range_Type (Nam);
      end Hash_File_Name;

      ---------------------
      -- Write_File_Name --
      ---------------------

      procedure Write_File_Name (Nam : File_Name_Type) is
         Use_Formatting : constant Boolean := not Zero_Formatting;

      begin
         pragma Assert (Present (Nam));

         if Use_Formatting then
            Write_Str ("   ");
         end if;

         Write_Line (Get_Name_String (Nam));
      end Write_File_Name;

      ---------------------------
      -- Write_Subunit_Closure --
      ---------------------------

      procedure Write_Subunit_Closure
        (Dep : Sdep_Id;
         Set : Membership_Set)
      is
         pragma Assert (Present (Dep));
         pragma Assert (Present (Set));

         Dep_Rec : Sdep_Record renames Sdep.Table (Dep);
         Source  : constant File_Name_Type := Dep_Rec.Sfile;

         pragma Assert (Present (Source));

      begin
         --  Nothing to do when the source file has already been written

         if Contains (Set, Source) then
            return;

         --  Nothing to do when the source file does not denote a non-internal
         --  subunit.

         elsif not Present (Dep_Rec.Subunit_Name)
           or else Is_Internal_File_Name (Source)
         then
            return;
         end if;

         --  Mark the subunit as written

         Insert (Set, Source);
         Write_File_Name (Source);
      end Write_Subunit_Closure;

      ----------------------------
      -- Write_Subunits_Closure --
      ----------------------------

      procedure Write_Subunits_Closure (Set : Membership_Set) is
      begin
         pragma Assert (Present (Set));

         for Dep in Sdep.First .. Sdep.Last loop
            Write_Subunit_Closure (Dep, Set);
         end loop;
      end Write_Subunits_Closure;

      ------------------------
      -- Write_Unit_Closure --
      ------------------------

      procedure Write_Unit_Closure (Order : Unit_Id_Table) is
         Use_Formatting : constant Boolean := not Zero_Formatting;

         Set : Membership_Set;

      begin
         --  Nothing to do when switch -R (list sources referenced in closure)
         --  is not in effect.

         if not List_Closure then
            return;
         end if;

         if Use_Formatting then
            Write_Eol;
            Write_Line ("REFERENCED SOURCES");
         end if;

         --  Use a set to avoid writing duplicate units and subunits

         Set := Create (Number_Of_Elaborable_Units);

         Write_Units_Closure (Order, Set);
         Write_Subunits_Closure (Set);

         Destroy (Set);

         if Use_Formatting then
            Write_Eol;
         end if;
      end Write_Unit_Closure;

      ------------------------
      -- Write_Unit_Closure --
      ------------------------

      procedure Write_Unit_Closure
        (U_Id : Unit_Id;
         Set  : Membership_Set)
      is
         pragma Assert (Present (U_Id));
         pragma Assert (Present (Set));

         U_Rec  : Unit_Record renames ALI.Units.Table (U_Id);
         Source : constant File_Name_Type := U_Rec.Sfile;

         pragma Assert (Present (Source));

      begin
         --  Nothing to do when the source file has already been written

         if Contains (Set, Source) then
            return;

         --  Nothing to do for internal source files unless switch -Ra (???) is
         --  in effect.

         elsif Is_Internal_File_Name (Source)
           and then not List_Closure_All
         then
            return;
         end if;

         --  Mark the source file as written

         Insert (Set, Source);
         Write_File_Name (Source);
      end Write_Unit_Closure;

      -------------------------
      -- Write_Units_Closure --
      -------------------------

      procedure Write_Units_Closure
        (Order : Unit_Id_Table;
         Set   : Membership_Set)
      is
      begin
         pragma Assert (Present (Set));

         for Index in reverse Unit_Id_Tables.First ..
                              Unit_Id_Tables.Last (Order)
         loop
            Write_Unit_Closure
              (U_Id => Order.Table (Index),
               Set  => Set);
         end loop;
      end Write_Units_Closure;
   end Unit_Closure_Writers;

   ---------------
   -- Write_Num --
   ---------------

   procedure Write_Num
     (Val        : Int;
      Val_Indent : Indentation_Level := Number_Column)
   is
      function Digits_Indentation return Indentation_Level;
      pragma Inline (Digits_Indentation);
      --  Determine the level of indentation the number requires in order to
      --  be right-justified by Val_Indent.

      ------------------------
      -- Digits_Indentation --
      ------------------------

      function Digits_Indentation return Indentation_Level is
         Indent : Indentation_Level;
         Num    : Int;

      begin
         --  Treat zero as a single digit

         if Val = 0 then
            Indent := 1;

         else
            Indent := 0;
            Num    := Val;

            --  Shrink the input value by dividing it until all of its digits
            --  are exhausted.

            while Num /= 0 loop
               Indent := Indent + 1;
               Num    := Num / 10;
            end loop;
         end if;

         return Val_Indent - Indent;
      end Digits_Indentation;

   --  Start of processing for Write_Num

   begin
      Indent_By (Digits_Indentation);
      Write_Int (Val);
   end Write_Num;

end Bindo.Writers;