--| +=========================================================================+
--| |                                                                         |
--| | NAMESPACE_SCAN.TRACE_SUPPORT (body)                                     |
--| |                                                                         |
--| | Greg Janee                                                              |
--| | General Research Corporation                                            |
--| |                                                                         |
--| +=========================================================================+

with Asis_Debug_Support;
with Unchecked_Deallocation;

separate (Namespace_Scan)
package body Trace_Support is

    Tracing_On : Boolean := False;

--| The numbers of remaining children at each level are stored in a
--| doubly-linked list headed by First_Level and "tailed" by Last_Level.
--| For convenience, there is always one dummy level at the head of
--| the list.

    type Level;
    type Level_Ptr is access Level;

    type Level is
	record
	    Previous : Level_Ptr;
	    Next : Level_Ptr;
	    Remaining_Children : Natural;
	end record;

    First_Level : Level_Ptr;
    Last_Level : Level_Ptr;

    procedure Free is new Unchecked_Deallocation (Level, Level_Ptr);

--| Local subprograms.

    procedure Adjust_Level;
    procedure Put_Indentation (File : in Text_Io.File_Type);

--| +-------------------------------------------------------------------------+
--| | ADD_CHILDREN (exported)                                                 |
--| +-------------------------------------------------------------------------+

    procedure Add_Children (Number_Children : in Natural) is
    begin

	Last_Level.Remaining_Children := 
	   Last_Level.Remaining_Children + Number_Children;

    end Add_Children;

--| +-------------------------------------------------------------------------+
--| | ADD_LEVEL (exported)                                                    |
--| +-------------------------------------------------------------------------+

    procedure Add_Level (Number_Children : in Natural) is

	New_Level : Level_Ptr;

    begin

	New_Level := new Level;
	New_Level.Previous := Last_Level;
	Last_Level.Next := New_Level;
	Last_Level := New_Level;

	New_Level.Remaining_Children := Number_Children;

    end Add_Level;

--| +-------------------------------------------------------------------------+
--| | ADJUST_LEVEL (local)                                                    |
--| +-------------------------------------------------------------------------+
--|
--| Finds the current level and decrements the number of children at that
--| level.

    procedure Adjust_Level is

	L : Level_Ptr;

    begin

	while Last_Level.Remaining_Children = 0 loop
	    L := Last_Level;
	    Last_Level := Last_Level.Previous;
	    Free (L);
	end loop;
	Last_Level.Next := null;

	if Last_Level /= First_Level then
	    Last_Level.Remaining_Children := Last_Level.Remaining_Children - 1;
	end if;

    end Adjust_Level;

--| +-------------------------------------------------------------------------+
--| | LOG/1 (exported)                                                        |
--| +-------------------------------------------------------------------------+

    procedure Log (The_Unit : in Asis.Compilation_Unit) is
    begin

	Adjust_Level;

	if Text_Io.Is_Open (Namespace_Scan.Trace_File) then
	    Put_Indentation (Namespace_Scan.Trace_File);
	    Text_Io.Put_Line 
	       (Namespace_Scan.Trace_File, 
		Asis_Debug_Support.Compilation_Unit_Image (The_Unit));
	else
	    Put_Indentation (Text_Io.Current_Output);
	    Text_Io.Put_Line 
	       (Asis_Debug_Support.Compilation_Unit_Image (The_Unit));
	end if;

    end Log;

--| +-------------------------------------------------------------------------+
--| | LOG/2 (exported)                                                        |
--| +-------------------------------------------------------------------------+

    procedure Log (The_Element : in Asis.Element) is
    begin

	Adjust_Level;

	if Text_Io.Is_Open (Namespace_Scan.Trace_File) then
	    Put_Indentation (Namespace_Scan.Trace_File);
	    Text_Io.Put_Line (Namespace_Scan.Trace_File, 
			      Asis_Debug_Support.Element_Image (The_Element));
	else
	    Put_Indentation (Text_Io.Current_Output);
	    Text_Io.Put_Line (Asis_Debug_Support.Element_Image (The_Element));
	end if;

    end Log;

--| +-------------------------------------------------------------------------+
--| | ON (exported)                                                           |
--| +-------------------------------------------------------------------------+

    function On return Boolean is
    begin

	return Tracing_On;

    end On;

--| +-------------------------------------------------------------------------+
--| | PUT_INDENTATION (local)                                                 |
--| +-------------------------------------------------------------------------+
--|
--| Writes out indentation appropriate for the current level.

    procedure Put_Indentation (File : in Text_Io.File_Type) is

	L : Level_Ptr;

    begin

	L := First_Level.Next;
	while L /= null and L /= Last_Level loop
	    if L.Remaining_Children = 0 then
		Text_Io.Put (File, "   ");
	    else
		Text_Io.Put (File, "|  ");
	    end if;
	    L := L.Next;
	end loop;

	if Last_Level /= First_Level then
	    if Last_Level.Remaining_Children = 0 then
		Text_Io.Put (File, "+--");
	    else
		Text_Io.Put (File, "|--");
	    end if;
	end if;

    end Put_Indentation;

--| +-------------------------------------------------------------------------+
--| | START (exported)                                                        |
--| +-------------------------------------------------------------------------+

    procedure Start is
    begin

	Trace_Support.Stop;
	First_Level := new Level;
	First_Level.Remaining_Children := 1;
	Last_Level := First_Level;
	Tracing_On := True;

    end Start;

--| +-------------------------------------------------------------------------+
--| | STOP (exported)                                                         |
--| +-------------------------------------------------------------------------+

    procedure Stop is

	L : Level_Ptr;

    begin

	while First_Level /= null loop
	    L := First_Level;
	    First_Level := First_Level.Next;
	    Free (L);
	end loop;
	Last_Level := null;
	Tracing_On := False;

    end Stop;

end Trace_Support;