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

with Unchecked_Deallocation;

package body Asis_Debug_Support is

--| Standard renames...

    package Asis_Cu renames Asis.Compilation_Units;
    package Asis_D renames Asis.Declarations;
    package Asis_E renames Asis.Elements;
    package Asis_Rc renames Asis.Representation_Clauses;
    package Asis_S renames Asis.Statements;
    package Asis_Td renames Asis.Type_Definitions;
    package Asis_X renames Asis.Expressions;

--| Using String_Ptr's instead of String's makes string manipulation easier.

    type String_Ptr is access String;
    procedure Free is new Unchecked_Deallocation (String, String_Ptr);

--| Local subprograms.

    procedure Concatenate (The_String : in out String_Ptr; 
			   And_The_String : in String);

--| +-------------------------------------------------------------------------+
--| | COMPILATION_UNIT_IMAGE (exported)                                       |
--| +-------------------------------------------------------------------------+

    function Compilation_Unit_Image 
		(The_Unit : in Asis.Compilation_Unit) return String is

	Kind : Asis_Cu.Compilation_Unit_Kinds;
	Origin : Asis_Cu.Compilation_Unit_Origins;
	The_Image : String_Ptr;

    begin

	The_Image := new String (1 .. 0);

	Origin := Asis_Cu.Origin (The_Unit);
	Concatenate (The_Image, 
		     Asis_Cu.Compilation_Unit_Origins'Image (Origin));

	Kind := Asis_Cu.Kind (The_Unit);
	Concatenate (The_Image, " " & 
				   Asis_Cu.Compilation_Unit_Kinds'Image (Kind));

	Concatenate (The_Image, " " & """" & Asis_Cu.Name (The_Unit) & """");

	if Asis_Cu.Is_Obsolete (The_Unit) then
	    Concatenate (The_Image, " (obsolete)");
	end if;

	if not Asis_Cu.Is_Consistent (The_Unit) then
	    Concatenate (The_Image, " (inconsistent)");
	end if;

	declare
	    Return_Image : String (1 .. The_Image'Length);
	begin
	    Return_Image := The_Image.all;
	    Free (The_Image);
	    return Return_Image;
	end;

    exception

	when Asis.Asis_Inappropriate_Compilation_Unit | Asis.Asis_Failed =>
	    Free (The_Image);
	    return "<unable to query unit>";

    end Compilation_Unit_Image;

--| +-------------------------------------------------------------------------+
--| | CONCATENATE (local)                                                     |
--| +-------------------------------------------------------------------------+
--| 
--| Concatenates two strings.  The first string is specified by a pointer;
--| the second, directly.  The first string is freed, and the pointer is
--| updated to point to the resultant string.

    procedure Concatenate (The_String : in out String_Ptr; 
			   And_The_String : in String) is

	S : String_Ptr;

    begin

	S := new String (1 .. The_String'Length + And_The_String'Length);
	S.all := The_String.all & And_The_String;
	Free (The_String);
	The_String := S;

    end Concatenate;

--| +-------------------------------------------------------------------------+
--| | ELEMENT_IMAGE (exported)                                                |
--| +-------------------------------------------------------------------------+

    function Element_Image (The_Element : in Asis.Element) return String is

	Alternative_Kind : Asis_S.Select_Alternative_Kinds;
	Attribute_Kind : Asis_X.Attribute_Designator_Kinds;
	Choice_Kind : Asis_Td.Choice_Kinds;
	Clause_Kind : Asis_Rc.Representation_Clause_Kinds;
	Constraint_Kind : Asis_Td.Constraint_Kinds;
	Declaration_Kind : Asis_D.Declaration_Kinds;
	Default_Kind : Asis_D.Generic_Formal_Subprogram_Default_Kinds;
	Definition_Kind : Asis_Td.Type_Definition_Kinds;
	Expression_Kind : Asis_X.Expression_Kinds;
	If_Arm_Kind : Asis_S.If_Statement_Arm_Kinds;
	Kind : Asis_E.Element_Kinds;
	Length_Kind : Asis_Rc.Length_Clause_Attribute_Kinds;
	Loop_Kind : Asis_S.Loop_Kinds;
	Mode_Kind : Asis_D.Parameter_Mode_Kinds;
	Operation_Kind : Asis_X.Special_Operation_Kinds;
	Pragma_Kind : Asis_E.Pragma_Kinds;
	Range_Kind : Asis_Td.Discrete_Range_Kinds;
	Select_Arm_Kind : Asis_S.Select_Statement_Arm_Kinds;
	Selection_Kind : Asis_X.Selection_Kinds;
	Statement_Kind : Asis_S.Statement_Kinds;
	The_Image : String_Ptr;

    begin

	The_Image := new String (1 .. 0);

	Kind := Asis_E.Element_Kind (The_Element);
	Concatenate (The_Image, Asis_E.Element_Kinds'Image (Kind));

	case Kind is

	    when Asis_E.A_Pragma =>
		Pragma_Kind := Asis_E.Pragma_Kind (The_Element);
		Concatenate (The_Image, 
			     " " & Asis_E.Pragma_Kinds'Image (Pragma_Kind));
		case Pragma_Kind is
		    when Asis_E.A_Controlled_Pragma =>
			null;
		    when Asis_E.An_Elaborate_Pragma =>
			null;
		    when Asis_E.An_Inline_Pragma =>
			null;
		    when Asis_E.An_Interface_Pragma =>
			null;
		    when Asis_E.A_List_Pragma =>
			null;
		    when Asis_E.A_Memory_Size_Pragma =>
			null;
		    when Asis_E.An_Optimize_Pragma =>
			null;
		    when Asis_E.A_Pack_Pragma =>
			null;
		    when Asis_E.A_Page_Pragma =>
			null;
		    when Asis_E.A_Priority_Pragma =>
			null;
		    when Asis_E.A_Shared_Pragma =>
			null;
		    when Asis_E.A_Storage_Unit_Pragma =>
			null;
		    when Asis_E.A_Suppress_Pragma =>
			null;
		    when Asis_E.A_System_Name_Pragma =>
			null;
		    when Asis_E.An_Implementation_Defined_Pragma =>
			Concatenate (The_Image, 
				     " " & """" & 
					Asis_E.Name (The_Element) & """");
		    when Asis_E.An_Unknown_Pragma =>
			Concatenate (The_Image, 
				     " " & """" & 
					Asis_E.Name (The_Element) & """");
		    when Asis_E.Not_A_Pragma =>
			Concatenate (The_Image, " ???");
		end case;

	    when Asis_E.An_Argument_Association =>
		null;

	    when Asis_E.A_Declaration =>
		Declaration_Kind := Asis_D.Kind (The_Element);
		Concatenate (The_Image, " " & Asis_D.Declaration_Kinds'Image 
						 (Declaration_Kind));
		case Declaration_Kind is
		    when Asis_D.A_Variable_Declaration =>
			if Asis_D.Is_Initialized (The_Element) then
			    Concatenate (The_Image, " (initialized)");
			end if;
		    when Asis_D.A_Component_Declaration =>
			if Asis_D.Is_Initialized (The_Element) then
			    Concatenate (The_Image, " (defaulted)");
			end if;
		    when Asis_D.A_Constant_Declaration =>
			null;
		    when Asis_D.A_Deferred_Constant_Declaration =>
			null;
		    when Asis_D.A_Generic_Formal_Object_Declaration =>
			Mode_Kind := Asis_D.Parameter_Mode_Kind (The_Element);
			Concatenate (The_Image, 
				     " " & Asis_D.Parameter_Mode_Kinds'Image 
					      (Mode_Kind));
			case Mode_Kind is
			    when Asis_D.A_Default_In_Mode =>
				if Asis_D.Is_Initialized (The_Element) then
				    Concatenate (The_Image, " (defaulted)");
				end if;
			    when Asis_D.An_In_Mode =>
				if Asis_D.Is_Initialized (The_Element) then
				    Concatenate (The_Image, " (defaulted)");
				end if;
			    when Asis_D.An_Out_Mode =>
				null;
			    when Asis_D.An_In_Out_Mode =>
				null;
			    when Asis_D.Not_A_Parameter_Mode =>
				Concatenate (The_Image, " ???");
			end case;
		    when Asis_D.A_Discriminant_Specification =>
			if Asis_D.Is_Initialized (The_Element) then
			    Concatenate (The_Image, " (defaulted)");
			end if;
		    when Asis_D.A_Parameter_Specification =>
			Mode_Kind := Asis_D.Parameter_Mode_Kind (The_Element);
			Concatenate (The_Image, 
				     " " & Asis_D.Parameter_Mode_Kinds'Image 
					      (Mode_Kind));
			case Mode_Kind is
			    when Asis_D.A_Default_In_Mode =>
				if Asis_D.Is_Initialized (The_Element) then
				    Concatenate (The_Image, " (defaulted)");
				end if;
			    when Asis_D.An_In_Mode =>
				if Asis_D.Is_Initialized (The_Element) then
				    Concatenate (The_Image, " (defaulted)");
				end if;
			    when Asis_D.An_Out_Mode =>
				null;
			    when Asis_D.An_In_Out_Mode =>
				null;
			    when Asis_D.Not_A_Parameter_Mode =>
				Concatenate (The_Image, " ???");
			end case;
		    when Asis_D.An_Integer_Number_Declaration =>
			null;
		    when Asis_D.A_Real_Number_Declaration =>
			null;
		    when Asis_D.An_Exception_Declaration =>
			null;
		    when Asis_D.An_Enumeration_Literal_Specification =>
			null;
		    when Asis_D.A_Loop_Parameter_Specification =>
			if Asis_S.Is_Reverse_Loop_Parameter (The_Element) then
			    Concatenate (The_Image, " (reversed)");
			end if;
		    when Asis_D.A_Full_Type_Declaration =>
			null;
		    when Asis_D.An_Incomplete_Type_Declaration =>
			null;
		    when Asis_D.A_Private_Type_Declaration =>
			null;
		    when Asis_D.A_Subtype_Declaration =>
			null;
		    when Asis_D.A_Package_Declaration =>
			null;
		    when Asis_D.A_Package_Body_Declaration =>
			null;
		    when Asis_D.A_Procedure_Declaration =>
			null;
		    when Asis_D.A_Procedure_Body_Declaration =>
			null;
		    when Asis_D.A_Function_Declaration =>
			null;
		    when Asis_D.A_Function_Body_Declaration =>
			null;
		    when Asis_D.An_Object_Rename_Declaration =>
			null;
		    when Asis_D.An_Exception_Rename_Declaration =>
			null;
		    when Asis_D.A_Package_Rename_Declaration =>
			null;
		    when Asis_D.A_Procedure_Rename_Declaration =>
			null;
		    when Asis_D.A_Function_Rename_Declaration =>
			null;
		    when Asis_D.A_Generic_Package_Declaration =>
			null;
		    when Asis_D.A_Generic_Procedure_Declaration =>
			null;
		    when Asis_D.A_Generic_Function_Declaration =>
			null;
		    when Asis_D.A_Package_Instantiation =>
			null;
		    when Asis_D.A_Procedure_Instantiation =>
			null;
		    when Asis_D.A_Function_Instantiation =>
			null;
		    when Asis_D.A_Task_Declaration =>
			null;
		    when Asis_D.A_Task_Body_Declaration =>
			null;
		    when Asis_D.A_Task_Type_Declaration =>
			null;
		    when Asis_D.An_Entry_Declaration =>
			null;
		    when Asis_D.A_Procedure_Body_Stub =>
			null;
		    when Asis_D.A_Function_Body_Stub =>
			null;
		    when Asis_D.A_Package_Body_Stub =>
			null;
		    when Asis_D.A_Task_Body_Stub =>
			null;
		    when Asis_D.A_Generic_Formal_Type_Declaration =>
			null;
		    when Asis_D.A_Generic_Formal_Private_Type_Declaration =>
			null;
		    when Asis_D.A_Generic_Formal_Procedure_Declaration =>
			Default_Kind := 
			   Asis_D.Generic_Formal_Subprogram_Default_Kind 
			      (The_Element);
			case Default_Kind is
			    when Asis_D.A_Box =>
				Concatenate (The_Image, " (default: A_BOX)");
			    when Asis_D.A_Name =>
				Concatenate (The_Image, " (default: A_NAME)");
			    when Asis_D.None =>
				null;
			    when Asis_D.
				    Not_A_Generic_Formal_Subprogram_Default =>
				Concatenate (The_Image, " ???");
			end case;
		    when Asis_D.A_Generic_Formal_Function_Declaration =>
			Default_Kind := 
			   Asis_D.Generic_Formal_Subprogram_Default_Kind 
			      (The_Element);
			case Default_Kind is
			    when Asis_D.A_Box =>
				Concatenate (The_Image, " (default: A_BOX)");
			    when Asis_D.A_Name =>
				Concatenate (The_Image, " (default: A_NAME)");
			    when Asis_D.None =>
				null;
			    when Asis_D.
				    Not_A_Generic_Formal_Subprogram_Default =>
				Concatenate (The_Image, " ???");
			end case;
		    when Asis_D.Not_A_Declaration =>
			Concatenate (The_Image, " ???");
		end case;
		case Asis_D.Origin (The_Element) is
		    when Asis_D.An_Explicit_Declaration =>
			null;
		    when Asis_D.An_Implicit_Derived_Declaration =>
			Concatenate (The_Image, " (implicit)");
		    when Asis_D.An_Implicit_Predefined_Declaration =>
			Concatenate (The_Image, " (predefined)");
		    when Asis_D.Not_A_Declaration =>
			null;
		end case;

	    when Asis_E.An_Entity_Name_Definition =>
		Expression_Kind := Asis_X.Kind (The_Element);
		Concatenate (The_Image, " " & Asis_X.Expression_Kinds'Image 
						 (Expression_Kind));
		case Expression_Kind is
		    when Asis_X.A_Simple_Name =>
			Concatenate (The_Image, 
				     " " & """" & 
					Asis_X.Name (The_Element) & """");
		    when Asis_X.An_Operator_Symbol =>
			Concatenate (The_Image, " " & 
						   Asis_X.Name (The_Element));
		    when Asis_X.A_Character_Literal =>
			Concatenate (The_Image, " " & 
						   Asis_X.Name (The_Element));
		    when Asis_X.An_Enumeration_Literal =>
			Concatenate (The_Image, 
				     " " & """" & 
					Asis_X.Name (The_Element) & """");
		    when others =>
			Concatenate (The_Image, " ???");
		end case;

	    when Asis_E.A_Type_Definition =>
		Definition_Kind := Asis_Td.Kind (The_Element);
		Concatenate (The_Image, 
			     " " & Asis_Td.Type_Definition_Kinds'Image 
				      (Definition_Kind));
		case Definition_Kind is
		    when Asis_Td.A_Subtype_Definition =>
			null;
		    when Asis_Td.An_Enumeration_Type_Definition =>
			null;
		    when Asis_Td.An_Integer_Type_Definition =>
			null;
		    when Asis_Td.A_Float_Type_Definition =>
			null;
		    when Asis_Td.A_Fixed_Type_Definition =>
			null;
		    when Asis_Td.An_Array_Type_Definition =>
			if Asis_Td.Is_Constrained_Array (The_Element) then
			    Concatenate (The_Image, " (constrained)");
			else
			    Concatenate (The_Image, " (unconstrained)");
			end if;
		    when Asis_Td.A_Record_Type_Definition =>
			null;
		    when Asis_Td.An_Access_Type_Definition =>
			null;
		    when Asis_Td.A_Derived_Type_Definition =>
			null;
		    when Asis_Td.A_Task_Type_Definition =>
			null;
		    when Asis_Td.A_Private_Type_Definition =>
			null;
		    when Asis_Td.A_Limited_Private_Type_Definition =>
			null;
		    when Asis_Td.A_Generic_Discrete_Subtype_Definition =>
			null;
		    when Asis_Td.A_Generic_Integer_Subtype_Definition =>
			null;
		    when Asis_Td.A_Generic_Float_Subtype_Definition =>
			null;
		    when Asis_Td.A_Generic_Fixed_Subtype_Definition =>
			null;
		    when Asis_Td.A_Generic_Array_Type_Definition =>
			if Asis_Td.Is_Constrained_Array (The_Element) then
			    Concatenate (The_Image, " (constrained)");
			else
			    Concatenate (The_Image, " (unconstrained)");
			end if;
		    when Asis_Td.A_Generic_Access_Type_Definition =>
			null;
		    when Asis_Td.A_Generic_Private_Type_Definition =>
			null;
		    when Asis_Td.A_Generic_Limited_Private_Type_Definition =>
			null;
		    when Asis_Td.A_Universal_Integer_Definition =>
			null;
		    when Asis_Td.A_Universal_Real_Definition =>
			null;
		    when Asis_Td.A_Universal_Fixed_Definition =>
			null;
		    when Asis_Td.Not_A_Type_Definition =>
			Concatenate (The_Image, " ???");
		end case;

	    when Asis_E.A_Subtype_Indication =>
		null;

	    when Asis_E.A_Constraint =>
		Constraint_Kind := Asis_Td.Constraint_Kind (The_Element);
		Concatenate (The_Image, " " & Asis_Td.Constraint_Kinds'Image 
						 (Constraint_Kind));
		case Constraint_Kind is
		    when Asis_Td.A_Simple_Range =>
			null;
		    when Asis_Td.A_Range_Attribute =>
			null;
		    when Asis_Td.A_Floating_Point_Constraint =>
			null;
		    when Asis_Td.A_Fixed_Point_Constraint =>
			null;
		    when Asis_Td.An_Index_Constraint =>
			null;
		    when Asis_Td.A_Discriminant_Constraint =>
			null;
		    when Asis_Td.Not_A_Constraint =>
			Concatenate (The_Image, " ???");
		end case;

	    when Asis_E.A_Discrete_Range =>
		Range_Kind := Asis_Td.Discrete_Range_Kind (The_Element);
		Concatenate (The_Image, " " & Asis_Td.Discrete_Range_Kinds'Image 
						 (Range_Kind));
		case Range_Kind is
		    when Asis_Td.A_Simple_Range =>
			null;
		    when Asis_Td.A_Range_Attribute =>
			null;
		    when Asis_Td.A_Discrete_Subtype_Indication =>
			null;
		    when Asis_Td.Not_A_Discrete_Range =>
			Concatenate (The_Image, " ???");
		end case;

	    when Asis_E.A_Discriminant_Association =>
		null;

	    when Asis_E.A_Variant_Part =>
		null;

	    when Asis_E.A_Null_Component =>
		null;

	    when Asis_E.A_Variant =>
		null;

	    when Asis_E.A_Choice =>
		Choice_Kind := Asis_Td.Choice_Kind (The_Element);
		Concatenate (The_Image, 
			     " " & Asis_Td.Choice_Kinds'Image (Choice_Kind));
		case Choice_Kind is
		    when Asis_Td.A_Simple_Expression =>
			null;
		    when Asis_Td.A_Discrete_Range =>
			null;
		    when Asis_Td.An_Others_Choice =>
			null;
		    when Asis_Td.A_Simple_Name =>
			null;
		    when Asis_Td.An_Exception_Name =>
			null;
		    when Asis_Td.Not_A_Choice =>
			Concatenate (The_Image, " ???");
		end case;

	    when Asis_E.A_Component_Association =>
		null;

	    when Asis_E.An_Expression =>
		Expression_Kind := Asis_X.Kind (The_Element);
		Concatenate (The_Image, " " & Asis_X.Expression_Kinds'Image 
						 (Expression_Kind));
		case Expression_Kind is
		    when Asis_X.A_Simple_Name =>
			Concatenate (The_Image, 
				     " " & """" & 
					Asis_X.Name (The_Element) & """");
		    when Asis_X.An_Operator_Symbol =>
			Concatenate (The_Image, " " & 
						   Asis_X.Name (The_Element));
		    when Asis_X.A_Character_Literal =>
			Concatenate (The_Image, " " & 
						   Asis_X.Name (The_Element));
		    when Asis_X.An_Enumeration_Literal =>
			Concatenate (The_Image, 
				     " " & """" & 
					Asis_X.Name (The_Element) & """");
		    when Asis_X.An_Indexed_Component =>
			null;
		    when Asis_X.A_Slice =>
			null;
		    when Asis_X.A_Selected_Component =>
			Selection_Kind := Asis_X.Selection_Kind (The_Element);
			Concatenate (The_Image, 
				     " " & Asis_X.Selection_Kinds'Image 
					      (Selection_Kind));
			case Selection_Kind is
			    when Asis_X.A_Discriminant =>
				null;
			    when Asis_X.A_Record_Component =>
				null;
			    when Asis_X.A_Task_Entry =>
				null;
			    when Asis_X.An_Access_Object =>
				null;
			    when Asis_X.An_Expanded_Name =>
				null;
			    when Asis_X.Not_A_Selection =>
				Concatenate (The_Image, " ???");
			end case;
		    when Asis_X.An_Attribute =>
			Attribute_Kind := 
			   Asis_X.Attribute_Designator_Kind 
			      (Asis_X.Attribute_Designator_Name (The_Element));
			Concatenate 
			   (The_Image, 
			    " " & Asis_X.Attribute_Designator_Kinds'Image 
				     (Attribute_Kind));
			case Attribute_Kind is
			    when Asis_X.An_Address_Attribute =>
				null;
			    when Asis_X.An_Aft_Attribute =>
				null;
			    when Asis_X.A_Base_Attribute =>
				null;
			    when Asis_X.A_Callable_Attribute =>
				null;
			    when Asis_X.A_Constrained_Attribute =>
				null;
			    when Asis_X.A_Count_Attribute =>
				null;
			    when Asis_X.A_Delta_Attribute =>
				null;
			    when Asis_X.A_Digits_Attribute =>
				null;
			    when Asis_X.An_Emax_Attribute =>
				null;
			    when Asis_X.An_Epsilon_Attribute =>
				null;
			    when Asis_X.A_First_Attribute =>
				null;
			    when Asis_X.A_First_Bit_Attribute =>
				null;
			    when Asis_X.A_Fore_Attribute =>
				null;
			    when Asis_X.An_Image_Attribute =>
				null;
			    when Asis_X.A_Large_Attribute =>
				null;
			    when Asis_X.A_Last_Attribute =>
				null;
			    when Asis_X.A_Last_Bit_Attribute =>
				null;
			    when Asis_X.A_Length_Attribute =>
				null;
			    when Asis_X.A_Machine_Emax_Attribute =>
				null;
			    when Asis_X.A_Machine_Emin_Attribute =>
				null;
			    when Asis_X.A_Machine_Mantissa_Attribute =>
				null;
			    when Asis_X.A_Machine_Overflows_Attribute =>
				null;
			    when Asis_X.A_Machine_Radix_Attribute =>
				null;
			    when Asis_X.A_Machine_Rounds_Attribute =>
				null;
			    when Asis_X.A_Mantissa_Attribute =>
				null;
			    when Asis_X.A_Pos_Attribute =>
				null;
			    when Asis_X.A_Position_Attribute =>
				null;
			    when Asis_X.A_Pred_Attribute =>
				null;
			    when Asis_X.A_Range_Attribute =>
				null;
			    when Asis_X.A_Safe_Emax_Attribute =>
				null;
			    when Asis_X.A_Safe_Large_Attribute =>
				null;
			    when Asis_X.A_Safe_Small_Attribute =>
				null;
			    when Asis_X.A_Size_Attribute =>
				null;
			    when Asis_X.A_Small_Attribute =>
				null;
			    when Asis_X.A_Storage_Size_Attribute =>
				null;
			    when Asis_X.A_Succ_Attribute =>
				null;
			    when Asis_X.A_Terminated_Attribute =>
				null;
			    when Asis_X.A_Val_Attribute =>
				null;
			    when Asis_X.A_Value_Attribute =>
				null;
			    when Asis_X.A_Width_Attribute =>
				null;
			    when Asis_X.An_Implementation_Defined_Attribute =>
				Concatenate 
				   (The_Image, 
				    " " & """" & 
				       Asis_X.Name 
					  (Asis_X.Attribute_Designator_Name 
					      (The_Element)) & """");
			    when Asis_X.An_Unknown_Attribute =>
				Concatenate 
				   (The_Image, 
				    " " & """" & 
				       Asis_X.Name 
					  (Asis_X.Attribute_Designator_Name 
					      (The_Element)) & """");
			    when Asis_X.Not_An_Attribute =>
				Concatenate (The_Image, " ???");
			end case;
		    when Asis_X.A_Type_Conversion =>
			null;
		    when Asis_X.A_Qualified_Expression =>
			null;
		    when Asis_X.A_Function_Call =>
			if Asis_X.Is_Prefix_Call (The_Element) then
			    Concatenate (The_Image, " (prefix)");
			else
			    Concatenate (The_Image, " (infix)");
			end if;
		    when Asis_X.A_Null_Literal =>
			null;
		    when Asis_X.A_String_Literal =>
			Concatenate (The_Image, 
				     " " & Asis_X.Static_Value (The_Element));
		    when Asis_X.An_Integer_Literal =>
			Concatenate 
			   (The_Image, 
			    " " & """" & 
			       Asis_X.Static_Value (The_Element) & """");
		    when Asis_X.A_Real_Literal =>
			Concatenate 
			   (The_Image, 
			    " " & """" & 
			       Asis_X.Static_Value (The_Element) & """");
		    when Asis_X.An_Aggregate =>
			null;
		    when Asis_X.A_Parenthesized_Expression =>
			null;
		    when Asis_X.A_Special_Operation =>
			Operation_Kind := 
			   Asis_X.Special_Operation_Kind (The_Element);
			Concatenate (The_Image, 
				     " " & Asis_X.Special_Operation_Kinds'Image 
					      (Operation_Kind));
			case Operation_Kind is
			    when Asis_X.An_In_Range =>
				null;
			    when Asis_X.A_Not_In_Range =>
				null;
			    when Asis_X.An_In_Type =>
				null;
			    when Asis_X.A_Not_In_Type =>
				null;
			    when Asis_X.An_And_Then =>
				null;
			    when Asis_X.An_Or_Else =>
				null;
			    when Asis_X.Not_A_Special_Operation =>
				Concatenate (The_Image, " ???");
			end case;
		    when Asis_X.An_Allocation_From_Subtype =>
			null;
		    when Asis_X.An_Allocation_From_Qualified_Expression =>
			null;
		    when Asis_X.Not_An_Expression =>
			Concatenate (The_Image, " ???");
		end case;

	    when Asis_E.A_Statement =>
		Statement_Kind := Asis_S.Kind (The_Element);
		Concatenate (The_Image, " " & Asis_S.Statement_Kinds'Image 
						 (Statement_Kind));
		case Statement_Kind is
		    when Asis_S.A_Null_Statement =>
			null;
		    when Asis_S.An_Assignment_Statement =>
			null;
		    when Asis_S.A_Procedure_Call_Statement =>
			null;
		    when Asis_S.An_Exit_Statement =>
			null;
		    when Asis_S.A_Return_Statement =>
			null;
		    when Asis_S.A_Goto_Statement =>
			null;
		    when Asis_S.An_Entry_Call_Statement =>
			null;
		    when Asis_S.A_Delay_Statement =>
			null;
		    when Asis_S.An_Abort_Statement =>
			null;
		    when Asis_S.A_Raise_Statement =>
			null;
		    when Asis_S.A_Code_Statement =>
			null;
		    when Asis_S.An_If_Statement =>
			null;
		    when Asis_S.A_Case_Statement =>
			null;
		    when Asis_S.A_Loop_Statement =>
			Loop_Kind := Asis_S.Loop_Kind (The_Element);
			Concatenate (The_Image, 
				     " " & Asis_S.Loop_Kinds'Image (Loop_Kind));
			case Loop_Kind is
			    when Asis_S.A_For_Loop =>
				null;
			    when Asis_S.A_While_Loop =>
				null;
			    when Asis_S.A_Simple_Loop =>
				null;
			    when Asis_S.Not_A_Loop =>
				Concatenate (The_Image, " ???");
			end case;
			if not Asis_E.Is_Nil 
				  (Asis_S.Loop_Simple_Name (The_Element)) then
			    Concatenate (The_Image, " (named)");
			end if;
		    when Asis_S.A_Block_Statement =>
			if not Asis_E.Is_Nil 
				  (Asis_S.Block_Simple_Name (The_Element)) then
			    Concatenate (The_Image, " (named)");
			end if;
		    when Asis_S.An_Accept_Statement =>
			null;
		    when Asis_S.A_Selective_Wait_Statement =>
			null;
		    when Asis_S.A_Conditional_Entry_Call_Statement =>
			null;
		    when Asis_S.A_Timed_Entry_Call_Statement =>
			null;
		    when Asis_S.Not_A_Statement =>
			Concatenate (The_Image, " ???");
		end case;
		if Asis_S.Is_Labeled (The_Element) then
		    Concatenate (The_Image, " (labeled)");
		end if;

	    when Asis_E.An_If_Statement_Arm =>
		If_Arm_Kind := Asis_S.If_Statement_Arm_Kind (The_Element);
		Concatenate (The_Image, 
			     " " & Asis_S.If_Statement_Arm_Kinds'Image 
				      (If_Arm_Kind));
		case If_Arm_Kind is
		    when Asis_S.An_If_Arm =>
			null;
		    when Asis_S.An_Elsif_Arm =>
			null;
		    when Asis_S.An_Else_Arm =>
			null;
		    when Asis_S.Not_An_If_Statement_Arm =>
			Concatenate (The_Image, " ???");
		end case;

	    when Asis_E.A_Case_Statement_Alternative =>
		if Asis_S.Is_When_Others (The_Element) then
		    Concatenate (The_Image, " (when others)");
		end if;

	    when Asis_E.A_Parameter_Association =>
		null;

	    when Asis_E.A_Use_Clause =>
		null;

	    when Asis_E.A_Select_Statement_Arm =>
		Select_Arm_Kind := 
		   Asis_S.Select_Statement_Arm_Kind (The_Element);
		Concatenate (The_Image, 
			     " " & Asis_S.Select_Statement_Arm_Kinds'Image 
				      (Select_Arm_Kind));
		case Select_Arm_Kind is
		    when Asis_S.A_Selective_Wait_Select_Arm =>
			null;
		    when Asis_S.A_Selective_Wait_Or_Arm =>
			null;
		    when Asis_S.A_Selective_Wait_Else_Arm =>
			null;
		    when Asis_S.A_Conditional_Entry_Call_Select_Arm =>
			null;
		    when Asis_S.A_Conditional_Entry_Call_Else_Arm =>
			null;
		    when Asis_S.A_Timed_Entry_Call_Select_Arm =>
			null;
		    when Asis_S.A_Timed_Entry_Call_Or_Arm =>
			null;
		    when Asis_S.Not_A_Select_Statement_Arm =>
			Concatenate (The_Image, " ???");
		end case;

	    when Asis_E.A_Select_Alternative =>
		Alternative_Kind := 
		   Asis_S.Select_Alternative_Kind (The_Element);
		Concatenate (The_Image, 
			     " " & Asis_S.Select_Alternative_Kinds'Image 
				      (Alternative_Kind));
		case Alternative_Kind is
		    when Asis_S.An_Accept_Alternative =>
			null;
		    when Asis_S.A_Delay_Alternative =>
			null;
		    when Asis_S.A_Terminate_Alternative =>
			null;
		    when Asis_S.Not_A_Select_Alternative =>
			Concatenate (The_Image, " ???");
		end case;
		if Asis_S.Is_Guarded (The_Element) then
		    Concatenate (The_Image, " (guarded)");
		end if;

	    when Asis_E.A_With_Clause =>
		null;

	    when Asis_E.An_Exception_Handler =>
		if Asis_S.Is_Others_Handler (The_Element) then
		    Concatenate (The_Image, " (when others)");
		end if;

	    when Asis_E.A_Representation_Clause =>
		Clause_Kind := Asis_Rc.Kind (The_Element);
		Concatenate (The_Image, 
			     " " & Asis_Rc.Representation_Clause_Kinds'Image 
				      (Clause_Kind));
		case Clause_Kind is
		    when Asis_Rc.A_Length_Clause =>
			Length_Kind := 
			   Asis_Rc.Length_Clause_Attribute_Kind (The_Element);
			Concatenate 
			   (The_Image, 
			    " " & Asis_Rc.Length_Clause_Attribute_Kinds'Image 
				     (Length_Kind));
			case Length_Kind is
			    when Asis_Rc.A_Size_Attribute =>
				null;
			    when Asis_Rc.A_Collection_Storage_Size_Attribute =>
				null;
			    when Asis_Rc.A_Task_Storage_Size_Attribute =>
				null;
			    when Asis_Rc.A_Small_Attribute =>
				null;
			    when Asis_Rc.Not_A_Length_Clause_Attribute =>
				Concatenate (The_Image, " ???");
			end case;
		    when Asis_Rc.An_Enumeration_Representation_Clause =>
			null;
		    when Asis_Rc.A_Record_Representation_Clause =>
			null;
		    when Asis_Rc.An_Address_Clause =>
			null;
		    when Asis_Rc.Not_A_Representation_Clause =>
			Concatenate (The_Image, " ???");
		end case;

	    when Asis_E.A_Component_Clause =>
		null;

	    when Asis_E.Not_An_Element =>
		Concatenate (The_Image, " ???");

	end case;

	declare
	    Return_Image : String (1 .. The_Image'Length);
	begin
	    Return_Image := The_Image.all;
	    Free (The_Image);
	    return Return_Image;
	end;

    exception

	when Asis.Asis_Inappropriate_Element | Asis.Asis_Failed =>
	    Free (The_Image);
	    return "<unable to query element>";

    end Element_Image;

end Asis_Debug_Support;