--| +=========================================================================+
--| |                                                                         |
--| | NAMESPACE_VIEW (body)                                                   |
--| |                                                                         |
--| | Greg Janee                                                              |
--| | General Research Corporation                                            |
--| |                                                                         |
--| +=========================================================================+

with Asis_Debug_Support;
with Msg_Log;

package body Namespace_View is

    Cuid : constant String := "Namespace_View";
    Io_Format_Version_Number : constant Integer := 1;

--| Standard renames...

    package Asis_D renames Asis.Declarations;
    package Asis_E renames Asis.Elements;
    package Asis_En renames Asis.Environment;
    package Asis_Num renames Asis.Numerics;
    package Asis_Str renames Asis.Strings;
    package Asis_Td renames Asis.Type_Definitions;
    package Asis_Txt renames Asis.Text;
    package Asis_X renames Asis.Expressions;

--| Instantiations.

    package Asis_Id_Cnt_Io is new Text_Io.Integer_Io (Asis_Id_Io.Count);
    package Asis_Int_Io is new Text_Io.Integer_Io (Asis.Asis_Integer);
    package Int_Io is new Text_Io.Integer_Io (Integer);

--| Local subprograms.

    function "<" (Left : in Asis.Element; Right : in Asis.Element) 
		 return Boolean;

    procedure Asis_Failed_Error 
		 (Current_Element : in Asis.Element; Program_Unit : in String);

    procedure Asis_Inappropriate_Element_Error 
		 (Current_Element : in Asis.Element; Program_Unit : in String);

    function Build_View_From_Definition_List return Namespace_View;

    function Diagnosis return String;

--| +-------------------------------------------------------------------------+
--| | "<" (local)                                                             |
--| +-------------------------------------------------------------------------+
--|
--| Returns true if the left element precedes the right element in the
--| source code.  (Of course, this is meaningful only if the elements
--| are in the same source file.)

    function "<" (Left : in Asis.Element; Right : in Asis.Element) 
		 return Boolean is

	Puid : constant String := """<""";

	Current_Element : Asis.Element;
	Lspan : Asis.Span;
	Rspan : Asis.Span;

    begin

	Current_Element := Left;
	Lspan := Asis_Txt.Element_Span (Current_Element);
	Current_Element := Right;
	Rspan := Asis_Txt.Element_Span (Current_Element);

	return Asis_Num."<" (Lspan.First_Line, Rspan.First_Line) or 
		  (Asis_Num."=" (Lspan.First_Line, Rspan.First_Line) and 
		   Asis_Num."<=" (Rspan.First_Column, Rspan.First_Column));

    exception

	when Asis.Asis_Inappropriate_Element =>
	    Asis_Inappropriate_Element_Error (Current_Element, Puid);
	    raise Traversal_Error;

	when Asis.Asis_Failed =>
	    Asis_Failed_Error (Current_Element, Puid);
	    raise Traversal_Error;

    end "<";

--| +-------------------------------------------------------------------------+
--| | ASIS_FAILED_ERROR (local)                                               |
--| +-------------------------------------------------------------------------+

    procedure Asis_Failed_Error (Current_Element : in Asis.Element; 
				 Program_Unit : in String) is
    begin

	Msg_Log.Put_Msg_Debug 
	   ("exception Asis_Failed raised; current element is " & 
	    Asis_Debug_Support.Element_Image (Current_Element) & 
	    "; status is " & Asis_En.Error_Kinds'Image (Asis_En.Status) & 
	    "; diagnosis follows");
	Msg_Log.Put_Msg_Debug (Cuid, Program_Unit, Diagnosis);

    end Asis_Failed_Error;

--| +-------------------------------------------------------------------------+
--| | ASIS_INAPPROPRIATE_ELEMENT_ERROR (local)                                |
--| +-------------------------------------------------------------------------+

    procedure Asis_Inappropriate_Element_Error 
		 (Current_Element : in Asis.Element; 
		  Program_Unit : in String) is
    begin

	Msg_Log.Put_Msg_Debug 
	   ("exception Asis_Inappropriate_Element raised; " & 
	    "current element is " & 
	    Asis_Debug_Support.Element_Image (Current_Element) & 
	    "; status is " & Asis_En.Error_Kinds'Image (Asis_En.Status) & 
	    "; diagnosis follows");
	Msg_Log.Put_Msg_Debug (Cuid, Program_Unit, Diagnosis);

    end Asis_Inappropriate_Element_Error;

--| +-------------------------------------------------------------------------+
--| | BUILD_VIEW_FROM_DEFINITION_LIST (local)                                 |
--| +-------------------------------------------------------------------------+

    function Build_View_From_Definition_List return Namespace_View is

	H : Namespace_Scan.Definition_Holder_Ptr;
	I : Integer;
	Ndefinitions : Integer;
	New_H : Namespace_Scan.Definition_Holder_Ptr;
	Previous_S : Namespace_Scan.Definition_Holder_Ptr;
	S : Namespace_Scan.Definition_Holder_Ptr;
	Sorted_List : Namespace_Scan.Definition_Holder_Ptr;
	T : Namespace_Scan.Definition_Holder_Ptr;
	The_View : Namespace_View;

	procedure Free is new Unchecked_Deallocation 
				 (Namespace_Scan.Definition_Holder, 
				  Namespace_Scan.Definition_Holder_Ptr);

    begin

	Ndefinitions := 0;
	H := Namespace_Scan.Definition_List;
	while Namespace_Scan."/=" (H, null) loop
	    S := Sorted_List;
	    Previous_S := null;
	    while Namespace_Scan."/=" (S, null) and then 
		     S.Element < H.Element loop
		Previous_S := S;
		S := S.Next;
	    end loop;
	    New_H := new Namespace_Scan.Definition_Holder;
	    New_H.Element := H.Element;
	    New_H.Parent := H.Parent;
	    New_H.Next := S;
	    if Namespace_Scan."=" (Previous_S, null) then
		Sorted_List := New_H;
	    else
		Previous_S.Next := New_H;
	    end if;
	    Ndefinitions := Ndefinitions + 1;
	    H := H.Next;
	end loop;

	The_View := new Definition_List (1 .. Ndefinitions);

	H := Sorted_List;
	I := 1;
	while Namespace_Scan."/=" (H, null) loop
	    The_View (I).Element := H.Element;
	    The_View (I).Parent := H.Parent;
	    I := I + 1;
	    T := H.Next;
	    Free (H);
	    H := T;
	end loop;

	return The_View;

    end Build_View_From_Definition_List;

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

    procedure Construct (The_View : in out Namespace_View; 
			 For_Unit : in Asis.Compilation_Unit; 
			 Expand_Instantiations : in Boolean := False; 
			 Trace : in Boolean := False) is

	New_View : Namespace_View;
	Return_View : Namespace_View;

    begin

	Namespace_Scan.Obeying_Regions := False;
	Namespace_Scan.Expand_All_Instantiations (Expand_Instantiations);

	if Trace then
	    Namespace_Scan.Start_Trace;
	end if;

	Namespace_Scan.Scan_Compilation_Unit (For_Unit, Asis.Nil_Element);

	if Trace then
	    Namespace_Scan.Stop_Trace;
	end if;

	New_View := Build_View_From_Definition_List;
	Namespace_Scan.Free_Definition_List;
	Return_View := Merge (The_View, New_View);
	Free (The_View);
	Free (New_View);
	The_View := Return_View;

    exception

	when Namespace_Scan.Traversal_Error =>
	    raise Traversal_Error;

    end Construct;

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

    procedure Construct (The_View : in out Namespace_View; 
			 For_Region : in Region_Support.Region; 
			 Expand_Instantiations : in Boolean := False; 
			 Trace : in Boolean := False) is

	New_View : Namespace_View;
	Return_View : Namespace_View;

    begin

	Namespace_Scan.Obeying_Regions := True;
	Namespace_Scan.Expand_All_Instantiations (Expand_Instantiations);

	if Trace then
	    Namespace_Scan.Start_Trace;
	end if;

	Namespace_Scan.Scan_Declarative_Region_Part 
	   (For_Region, Asis.Nil_Element);

	if Trace then
	    Namespace_Scan.Stop_Trace;
	end if;

	New_View := Build_View_From_Definition_List;
	Namespace_Scan.Free_Definition_List;
	Return_View := Merge (The_View, New_View);
	Free (The_View);
	Free (New_View);
	The_View := Return_View;

    exception

	when Namespace_Scan.Traversal_Error | Region_Support.Region_Error =>
	    raise Traversal_Error;

    end Construct;

--| +-------------------------------------------------------------------------+
--| | DIAGNOSIS (local)                                                       |
--| +-------------------------------------------------------------------------+

    function Diagnosis return String is

	Asis_Diagnosis : constant String := 
	   Asis_Str.To_Standard_String (Asis_En.Diagnosis);

    begin

	if Asis_Diagnosis = "" then
	    return "<no diagnosis available>";
	else
	    return Asis_Diagnosis;
	end if;

    end Diagnosis;

--| +-------------------------------------------------------------------------+
--| | DUMP (exported)                                                         |
--| +-------------------------------------------------------------------------+

    procedure Dump (The_View : in Namespace_View; 
		    To_The_File : in Text_Io.File_Type := 
		       Text_Io.Standard_Output) is

	Puid : constant String := "Dump";

	Current_Element : Asis.Element;
	F : Text_Io.File_Type renames To_The_File;
	Span : Asis.Span;

    begin

	if The_View = null then
	    return;
	end if;

	for I in The_View'Range loop
	    Text_Io.New_Line (F);
	    Text_Io.Put_Line (F, Asis_Debug_Support.Element_Image 
				    (The_View (I).Element));
	    Current_Element := The_View (I).Parent;
	    Span := Asis_Txt.Element_Span (Current_Element);
	    Text_Io.Put (F, "   ");
	    Asis_Int_Io.Put (F, Span.First_Line, 3);
	    Text_Io.Put (F, " ");
	    Asis_Int_Io.Put (F, Span.First_Column, 3);
	    Text_Io.Put_Line (F, " " & Asis_Debug_Support.Element_Image 
					  (The_View (I).Parent));
	end loop;

    exception

	when Asis.Asis_Inappropriate_Element =>
	    Asis_Inappropriate_Element_Error (Current_Element, Puid);
	    raise Traversal_Error;

	when Asis.Asis_Failed =>
	    Asis_Failed_Error (Current_Element, Puid);
	    raise Traversal_Error;

    end Dump;

--| +-------------------------------------------------------------------------+
--| | INPUT (exported)                                                        |
--| +-------------------------------------------------------------------------+
--|
--| This function should really do some validity checking on the input files.

    function Input (From_Control_File : in Text_Io.File_Type; 
		    From_Id_File : in Asis_Id_Io.File_Type; 
		    Library : Asis.Library) return Namespace_View is

	Puid : constant String := "Input";

	Cfile : Text_Io.File_Type renames From_Control_File;
	Header : String (1 .. 14);
	Ifile : Asis_Id_Io.File_Type renames From_Id_File;
	Number_Definitions : Integer;
	Position : Asis_Id_Io.Count;
	The_View : Namespace_View;
	Version : Integer;

    begin

	Text_Io.Get (Cfile, Header);
	Int_Io.Get (Cfile, Version);

	Int_Io.Get (Cfile, Number_Definitions);
	The_View := new Definition_List (1 .. Number_Definitions);

	for I in The_View'Range loop
	    Asis_Id_Cnt_Io.Get (Cfile, Position);
	    Asis_Id_Io.Read (Ifile, The_View (I).Element, Position, Library);
	    Asis_Id_Cnt_Io.Get (Cfile, Position);
	    Asis_Id_Io.Read (Ifile, The_View (I).Parent, Position, Library);
	end loop;

	return The_View;

    exception

	when Asis.Asis_Failed =>
	    Asis_Failed_Error (Asis.Nil_Element, Puid);
	    raise Traversal_Error;

    end Input;

--| +-------------------------------------------------------------------------+
--| | MERGE (exported)                                                        |
--| +-------------------------------------------------------------------------+

    function Merge (The_View : in Namespace_View; 
		    And_The_View : in Namespace_View) return Namespace_View is

	I : Integer;
	J : Integer;
	K : Integer;
	New_View : Namespace_View;

    begin

	if The_View = null and And_The_View = null then
	    return null;
	end if;

	if The_View = null then
	    New_View := new Definition_List (1 .. And_The_View'Length);
	    New_View.all := And_The_View.all;
	    return New_View;
	end if;

	if And_The_View = null then
	    New_View := new Definition_List (1 .. The_View'Length);
	    New_View.all := The_View.all;
	    return New_View;
	end if;

	New_View := new Definition_List 
			   (1 .. The_View'Length + And_The_View'Length);

	I := The_View'First;
	J := And_The_View'First;
	K := 1;

	while I <= The_View'Last and J <= And_The_View'Last loop
	    if The_View (I).Element < And_The_View (J).Element then
		New_View (K) := The_View (I);
		I := I + 1;
		K := K + 1;
	    else
		New_View (K) := And_The_View (J);
		J := J + 1;
		K := K + 1;
	    end if;
	end loop;

	while I <= The_View'Last loop
	    New_View (K) := The_View (I);
	    I := I + 1;
	    K := K + 1;
	end loop;

	while J <= And_The_View'Last loop
	    New_View (K) := And_The_View (J);
	    J := J + 1;
	    K := K + 1;
	end loop;

	return New_View;

    end Merge;

--| +-------------------------------------------------------------------------+
--| | OUTPUT (exported)                                                       |
--| +-------------------------------------------------------------------------+

    procedure Output (The_View : in Namespace_View; 
		      To_Control_File : in Text_Io.File_Type; 
		      To_Id_File : in Asis_Id_Io.File_Type) is

	Puid : constant String := "Output";

	Cfile : Text_Io.File_Type renames To_Control_File;
	Current_Element : Asis.Element;
	Ifile : Asis_Id_Io.File_Type renames To_Id_File;

    begin

	Text_Io.Put (Cfile, "NAMESPACE VIEW ");
	Int_Io.Put (Cfile, Io_Format_Version_Number, 0);
	Text_Io.New_Line (Cfile);

	if The_View = null then
	    Text_Io.Put_Line (Cfile, "0");
	    return;
	else
	    Int_Io.Put (Cfile, The_View'Length, 0);
	    Text_Io.New_Line (Cfile);
	end if;

	for I in The_View'Range loop
	    Asis_Id_Cnt_Io.Put (Cfile, Asis_Id_Io.Index (Ifile), 0);
	    Current_Element := The_View (I).Element;
	    Asis_Id_Io.Write (Ifile, Current_Element);
	    Text_Io.Put (Cfile, " ");
	    Asis_Id_Cnt_Io.Put (Cfile, Asis_Id_Io.Index (Ifile), 0);
	    Current_Element := The_View (I).Parent;
	    Asis_Id_Io.Write (Ifile, Current_Element);
	    Text_Io.New_Line (Cfile);
	end loop;

    exception

	when Asis.Asis_Inappropriate_Element =>
	    Asis_Inappropriate_Element_Error (Current_Element, Puid);
	    raise Traversal_Error;

	when Asis.Asis_Failed =>
	    Asis_Failed_Error (Current_Element, Puid);
	    raise Traversal_Error;

    end Output;

end Namespace_View;