with Ada.Text_IO;

with Asis.Declarations;
with Asis.Definitions;
with Asis.Elements;
with Asis.Exceptions;
with Asis.Expressions;
with Asis.Report;

with Asis.Toolkit.ObjectAda.Elements;
with Asis.Toolkit.ObjectAda.Expressions;

with Ada.Characters.Handling;

package body Asis.Toolkit.ObjectAda.Declarations is

  package TOOLELEM renames Asis.Toolkit.ObjectAda.Elements;
  package TOOLEXPR renames Asis.Toolkit.ObjectAda.Expressions;

  Debug : constant Boolean := 
	      Asis.Report.Debug ( "Asis.Toolkit.ObjectAda.Declarations.Debug" );

  function Name_Image (Declaration : in Asis.Declaration) return String is
  begin
    case Asis.Elements.Declaration_Kind(Declaration) is
      when Asis.Not_A_Declaration =>
	raise Asis.Exceptions.Asis_Inappropriate_Element;

      when others =>
        return Ada.Characters.Handling.To_String
		  (Asis.Declarations.Defining_Name_Image
                      (Asis.Declarations.Names(Declaration)(1)));
    end case;
  end Name_Image;

  function Parent_Full_Expanded_Name_Image 
			   (Declaration : in Asis.Declaration) return String is
  begin
    if Debug then
      Ada.Text_IO.Put_Line(Item => "PFENI:" & Asis.Declaration_Kinds'Image
			   (Asis.Elements.Declaration_Kind(Declaration)));
    end if;
    case Asis.Elements.Declaration_Kind(Declaration) is
      when Asis.Not_A_Declaration =>
	return "";

      when others =>
	return Full_Expanded_Name_Image
	         (TOOLELEM.Enclosing_Declaration(Declaration));
    end case;
  end Parent_Full_Expanded_Name_Image;

  function Full_Expanded_Name_Image 
		   (Declaration : in Asis.Declaration) return String is
    Parent : Asis.Declaration;
  begin
    if Debug then
      Ada.Text_IO.Put_Line(Item => "FENI:" & Asis.Declaration_Kinds'Image
			   (Asis.Elements.Declaration_Kind(Declaration)));
    end if;
    case Asis.Elements.Declaration_Kind(Declaration) is
      when Asis.Not_A_Declaration =>
	return "";

      when others =>
	Parent := TOOLELEM.Enclosing_Declaration(Declaration);
	case Asis.Elements.Element_Kind(Parent) is
	  when Asis.A_Declaration =>
            return Full_Expanded_Name_Image(Parent)
	       & "." & Ada.Characters.Handling.To_String
		      (Asis.Declarations.Defining_Name_Image
                          (Asis.Declarations.Names(Declaration)(1)));
	  when Asis.Not_An_Element =>
	    return Ada.Characters.Handling.To_String
		      (Asis.Declarations.Defining_Name_Image
                          (Asis.Declarations.Names(Declaration)(1)));
	  when others =>
	    null;  -- not happen
        end case;
    end case;
    return "";
  end Full_Expanded_Name_Image;


  function Type_Constraint (Declaration : in Asis.Declaration)
		      return Asis.Constraint is

    Type_Kind : Asis.Type_Kinds;
    Def_Kind  : Asis.Definition_Kinds;
    View      : Asis.Definition;
  begin

    case Asis.Elements.Declaration_Kind(Declaration) is
      when Asis.A_Task_Type_Declaration =>
        return Asis.Nil_Element;

      when Asis.A_Protected_Type_Declaration =>
        return Asis.Nil_Element;

      when Asis.An_Ordinary_Type_Declaration |
           Asis.A_Private_Type_Declaration |
           Asis.A_Private_Extension_Declaration |
           Asis.A_Subtype_Declaration =>

    -- Check view of first subtype.
    -- Let Type_Declaration_View determine what is appropriate;
    -- exception returns Nil_Element;

    View := Asis.Declarations.Type_Declaration_View(Declaration);

    Def_Kind := Asis.Elements.Definition_Kind(View);
    case Def_Kind is
      when Asis.A_Subtype_Indication =>

	    declare
	      Constraint : Asis.Constraint :=
	         Asis.Definitions.Subtype_Constraint(View);
	    begin
	      if not Asis.Elements.Is_Nil(Constraint) then
		return Constraint;

	      else
		-- recurse to look for a constraint
	        return Type_Constraint
		    (Asis.Declarations.Corresponding_Last_Constraint
							     (Declaration));

	      end if;
	    end;

      when Asis.A_Type_Definition =>

        Type_Kind := Asis.Elements.Type_Kind(View);
        case Type_Kind is
	  when Asis.Not_A_Type_Definition =>
            null;

          when A_Root_Type_Definition =>
            null;

          when Asis.An_Enumeration_Type_Definition =>
            null;

          when Asis.A_Signed_Integer_Type_Definition =>
            return Asis.Definitions.Integer_Constraint(View);

          when Asis.A_Modular_Type_Definition =>
            null;

          when Asis.A_Floating_Point_Definition =>
            return Asis.Definitions.Real_Range_Constraint(View);

          when Asis.An_Ordinary_Fixed_Point_Definition =>
            return Asis.Definitions.Real_Range_Constraint(View);

          when Asis.A_Decimal_Fixed_Point_Definition =>
            return Asis.Definitions.Real_Range_Constraint(View);

          when Asis.An_Unconstrained_Array_Definition =>
            null;
	    
          when Asis.A_Constrained_Array_Definition =>
            null;

          when Asis.An_Access_Type_Definition =>
	    null;

          when Asis.A_Record_Type_Definition =>
            null;

          when Asis.A_Derived_Record_Extension_Definition |
	       Asis.A_Tagged_Record_Type_Definition =>
            null;

          when Asis.A_Derived_Type_Definition =>
	    -- recurse to check the parent subtype
	    -- this will unwind subtypes and derivations
	    declare
	      Constraint : Asis.Constraint :=
	         Asis.Definitions.Subtype_Constraint
	            (Asis.Definitions.Parent_Subtype_Indication(View));
	    begin
	      if not Asis.Elements.Is_Nil(Constraint) then
		return Constraint;

	      else
		-- recurse to look for a constraint
	        return Type_Constraint
			 (Asis.Definitions.Corresponding_Parent_Subtype(View));

	      end if;
	    end;

        end case;

      when Asis.A_Private_Type_Definition =>
	-- recurse to check the parent subtype
	-- this will unwind each derivation
	return Type_Constraint
		     (Asis.Declarations.Corresponding_Type_Declaration
			  (Asis.Elements.Enclosing_Element(View)));
			     --####(Declaration));

      when others =>
        null;
    end case;


      when Asis.A_Formal_Type_Declaration =>
	--## may implement later
        null;

      when others =>
        null;
    end case;

    return Asis.Nil_Element;

  exception
    when others =>
      return Asis.Nil_Element;
  end Type_Constraint;



  function Corresponding_Class_Type (Declaration : in Asis.Declaration)
		      return Asis.Declaration is

    Type_Kind : Asis.Type_Kinds;
    Def_Kind  : Asis.Definition_Kinds;
    View      : Asis.Definition;
  begin

    case Asis.Elements.Declaration_Kind(Declaration) is
      when Asis.A_Task_Type_Declaration =>
        return Declaration;

      when Asis.A_Protected_Type_Declaration =>
        return Declaration;

      when Asis.An_Ordinary_Type_Declaration |
           Asis.A_Private_Type_Declaration |
           Asis.A_Private_Extension_Declaration |
           Asis.A_Subtype_Declaration =>
	null;  -- pass through
 
      when Asis.A_Formal_Type_Declaration =>
	--## may implement later
        return Declaration;

      when others =>
	raise Asis.Exceptions.Asis_Inappropriate_Element;
    end case;

    -- Check view of first subtype.
    -- Let first subtype verify Declaration is appropriate;
    -- exception returns Not_A_Type_Class;

    -- resolve subtypes to a first_subtype
    View := Asis.Declarations.Type_Declaration_View
			  (Asis.Declarations.Corresponding_First_Subtype
			     (Declaration));

    Def_Kind := Asis.Elements.Definition_Kind(View);
    case Def_Kind is
      when Asis.A_Type_Definition =>

        Type_Kind := Asis.Elements.Type_Kind(View);
        case Type_Kind is

          when Asis.A_Derived_Type_Definition =>
	    -- recurse to check the parent subtype
	    -- this will unwind subtypes and derivations
	    return Corresponding_Class_Type
			 (Asis.Definitions.Corresponding_Parent_Subtype(View));

	  when others =>
	    return Asis.Elements.Enclosing_Element(View);

        end case;

      when Asis.A_Private_Type_Definition =>
	-- recurse to check the parent subtype
	-- this will unwind each derivation
	return Corresponding_Class_Type
		     (Asis.Declarations.Corresponding_Type_Declaration
			  (Asis.Elements.Enclosing_Element(View)));
			     --###(Declaration));

      when Asis.A_Tagged_Private_Type_Definition |
	   Asis.A_Private_Extension_Definition =>
	-- The full type of these must be a tagged record
	return Corresponding_Class_Type
		     (Asis.Declarations.Corresponding_Type_Declaration
			  (Asis.Elements.Enclosing_Element(View)));
			     --###(Declaration));

      when others =>
	-- should not happen
        null;
    end case;

    raise Asis.Exceptions.Asis_Inappropriate_Element;

  exception
    when others =>
      raise Asis.Exceptions.Asis_Inappropriate_Element;
  end Corresponding_Class_Type;

  function Type_Class (Declaration : in Asis.Declaration)
			     return Type_Classes is

    Type_Kind     : Asis.Type_Kinds;
    Def_Kind      : Asis.Definition_Kinds;
    First_Subtype : Asis.Declaration;
    View          : Asis.Definition;
  begin

    case Asis.Elements.Declaration_Kind(Declaration) is
      when Asis.A_Task_Type_Declaration =>
        return A_Task_Class;

      when Asis.A_Protected_Type_Declaration =>
        return A_Protected_Class;

      when Asis.An_Ordinary_Type_Declaration |
           Asis.A_Private_Type_Declaration |
           Asis.A_Private_Extension_Declaration |
           Asis.A_Subtype_Declaration =>
	null;  -- pass through
 
      when Asis.A_Formal_Type_Declaration =>
	--## may implement later
        return Not_A_Type_Class;

      when others =>
        return Not_A_Type_Class;
    end case;

    -- Check view of first subtype.
    -- Let first subtype verify Declaration is appropriate;
    -- exception returns Not_A_Type_Class;

    -- resolve subtypes to a first_subtype
    First_Subtype := Asis.Declarations.Corresponding_First_Subtype(Declaration);
    View := Asis.Declarations.Type_Declaration_View(First_Subtype);

    Def_Kind := Asis.Elements.Definition_Kind(View);
    case Def_Kind is
      when Asis.A_Type_Definition =>

        Type_Kind := Asis.Elements.Type_Kind(View);
        case Type_Kind is
	  when Asis.Not_A_Type_Definition =>
            return Not_A_Type_Class;

          when A_Root_Type_Definition =>
            return Not_A_Type_Class;

          when Asis.An_Enumeration_Type_Definition =>
            return An_Enumeration_Class;

          when Asis.A_Signed_Integer_Type_Definition =>
            return A_Signed_Integer_Class;

          when Asis.A_Modular_Type_Definition =>
            return A_Modular_Integer_Class;

          when Asis.A_Floating_Point_Definition =>
            return A_Float_Class;

          when Asis.An_Ordinary_Fixed_Point_Definition =>
            return An_Ordinary_Fixed_Class;

          when Asis.A_Decimal_Fixed_Point_Definition =>
            return A_Decimal_Fixed_Class;

          when Asis.An_Unconstrained_Array_Definition =>
            return An_Unconstrained_Array_Class;
	    
          when Asis.A_Constrained_Array_Definition =>
            return A_Constrained_Array_Class;

          when Asis.An_Access_Type_Definition =>
	    case Asis.Elements.Access_Type_Kind(View) is
              when Asis.Access_To_Object_Definition =>
                return An_Access_To_Object_Class;

              when Asis.Access_To_Subprogram_Definition =>
                return An_Access_To_Subprogram_Class;

	      when Asis.Not_An_Access_Type_Definition =>
		-- would be an error;
                return Not_A_Type_Class;
	    end case;

          when Asis.A_Record_Type_Definition =>
            return An_Untagged_Record_Class;

          when Asis.A_Derived_Record_Extension_Definition |
	       Asis.A_Tagged_Record_Type_Definition =>
            return A_Tagged_Record_Class;

          when Asis.A_Derived_Type_Definition =>
	    -- recurse to check the parent subtype
	    -- this will unwind subtypes and derivations
	    return Type_Class
			 (Asis.Definitions.Corresponding_Parent_Subtype(View));

        end case;

      when Asis.A_Private_Type_Definition =>
	-- recurse to check the parent subtype
	-- this will unwind each derivation
	return Type_Class
		     (Asis.Declarations.Corresponding_Type_Declaration
			     (First_Subtype));

      when Asis.A_Tagged_Private_Type_Definition |
	   Asis.A_Private_Extension_Definition =>
	-- The full type of these must be a tagged record
        return A_Tagged_Record_Class;

      when Asis.A_Task_Definition =>
        return A_Task_Class;

      when Asis.A_Protected_Definition =>
        return A_Protected_Class;

      when others =>
        return Not_A_Type_Class;
    end case;

    return Not_A_Type_Class;

  exception
    when others =>
      return Not_A_Type_Class;
  end Type_Class;

  function Is_Record_Subtype (Declaration : in Asis.Declaration)
			     return Boolean is

    Type_Kind : Asis.Type_Kinds;
    Def_Kind  : Asis.Definition_Kinds;
    View      : Asis.Definition;
    First_Subtype : Asis.Declaration;
  begin
    -- Check view of first subtype.
    -- Let first subtype verify Declaration is appropriate;
    -- exception returns false;

            if Debug then
              --%
              Ada.Text_IO.Put( "Is_Record_Subtype:DECL:argument");
              Asis.Toolkit.ObjectAda.Elements.Print_Element
		        (Declaration, verbose => true, span => True);
	    end if;

    -- resolve subtypes to a first_subtype
    First_Subtype := Asis.Declarations.Corresponding_First_Subtype(Declaration);

            if Debug then
              --%
              Ada.Text_IO.Put( "Is_Record_Subtype:DECL:first_subtype");
              Asis.Toolkit.ObjectAda.Elements.Print_Element
		        (First_Subtype, verbose => true, span => True);
	    end if;

    View := Asis.Declarations.Type_Declaration_View(First_Subtype);

    Def_Kind := Asis.Elements.Definition_Kind(View);
    case Def_Kind is
      when Asis.A_Type_Definition =>

        Type_Kind := Asis.Elements.Type_Kind(View);
        case Type_Kind is
          when Asis.A_Record_Type_Definition | 
               Asis.A_Derived_Record_Extension_Definition |
	       Asis.A_Tagged_Record_Type_Definition =>
	    return True;

          when Asis.A_Derived_Type_Definition =>
	    -- recurse to check the parent subtype
	    -- this will unwind subtypes and derivations
	    return Is_Record_Subtype
			 (Asis.Definitions.Corresponding_Parent_Subtype(View));

          when others =>
            if Debug then
              --%
              Ada.Text_IO.Put( "Is_Record_Subtype:FALSE:type_kind:others");
              Asis.Toolkit.ObjectAda.Elements.Print_Element
		        (Declaration, verbose => true, span => True);
	    end if;
	    return False;
        end case;

      when Asis.A_Private_Type_Definition =>
	-- recurse to check the parent subtype
	-- this will unwind each derivation
	return Is_Record_Subtype
		     (Asis.Declarations.Corresponding_Type_Declaration
			     (First_Subtype));

      when Asis.A_Tagged_Private_Type_Definition |
	   Asis.A_Private_Extension_Definition =>
	-- The full type of these must be a record
	return True;

      when others =>
            if Debug then
              --%
              Ada.Text_IO.Put( "Is_Record_Subtype:FALSE:def_kind:others");
              Asis.Toolkit.ObjectAda.Elements.Print_Element
		        (Declaration, verbose => true, span => True);
	    end if;
	return False;
    end case;

    return False;

  exception
    when others =>
            if Debug then
              --%
              Ada.Text_IO.Put( "Is_Record_Subtype:FALSE:exception");
              Asis.Toolkit.ObjectAda.Elements.Print_Element
		        (Declaration, verbose => true, span => True);
	    end if;
      return False;
  end Is_Record_Subtype;

  function Components(Definition : in Asis.Definition)
      return Asis.Element_List is

    Result_List  : Asis.Element_List(1..1000); --##
    Result_Count : Asis.Asis_Natural := 0;
    Discrim_Part : Asis.Element;
    Rec_Def      : Asis.Definition;

    procedure Flatten(Record_Definition : in Asis.Definition) is
      Comp_List : Asis.Element_List := 
		         Asis.Definitions.Record_Components(Record_Definition);
      use type Asis.Element_List;
    begin
      -- assign the Result_List components up to a variant part, then
      -- flatten the variant part into variants and their components
      for I in Comp_List'Range loop
	-- first look for component decls
	case Asis.Elements.Declaration_Kind(Comp_List(I)) is
	  when Asis.A_Component_Declaration =>
	    Result_Count := Result_Count + 1;
	    Result_List(Result_Count) := Comp_List(I);
	  when others =>
	    null;
	end case;

	case Asis.Elements.Definition_Kind(Comp_List(I)) is
	  when Asis.A_Variant_Part =>
	    declare
	      Variant_List : Asis.Element_List := 
			        Asis.Definitions.Variants(Comp_List(I));
	    begin
	      for V in Variant_List'Range loop
	        Flatten(Variant_List(V));
	      end loop;
	    end;
	  when others =>
	    null;
	end case;
      end loop;
    end Flatten;

  begin

    --%
    --%Ada.Text_IO.Put( "Components:");
    --%Asis.Toolkit.ObjectAda.Elements.Print_Element
	      --%(Definition, verbose => true, span => True);
    --%Ada.Text_IO.Put( "Components:Enclosing");
    --%Asis.Toolkit.ObjectAda.Elements.Print_Element
	      --%(Asis.Elements.Enclosing_Element(Definition),
		  --%verbose => true, span => True);

      -- check discrims of the enclosing declaration of the definition
      Discrim_Part := Asis.Declarations.Discriminant_Part
			(Asis.Elements.Enclosing_Element(Definition));
      if not Asis.Elements.Is_Nil(Discrim_Part) then
	declare
          Discrim_List : Asis.Element_List := 
			     Asis.Definitions.Discriminants(Discrim_Part);
	begin
	  for I in Discrim_List'range loop
	    Result_Count := Result_Count + 1;
	    Result_List(Result_Count) := Discrim_List(I);
	  end loop;
	end;
      end if;

      Rec_Def := Asis.Definitions.Record_Definition(Definition);
      case Asis.Elements.Definition_Kind(Rec_Def) is
	when Asis.A_Record_Definition =>
          Flatten(Rec_Def);
          return Result_List(1 .. Result_Count);

	when Asis.A_Null_Record_Definition =>
          return Result_List(1 .. Result_Count);

        when others =>
	  raise Asis.Exceptions.Asis_Inappropriate_Element;
      end case;
  end Components;

  function Record_Components (Declaration : in Asis.Declaration)
		             return Asis.Element_List is
    Type_Kind : Asis.Type_Kinds;
    Def_Kind  : Asis.Definition_Kinds;
    View      : Asis.Definition;

   begin

    -- resolve subtypes to a first_subtype
    View := Asis.Declarations.Type_Declaration_View
			  (Asis.Declarations.Corresponding_First_Subtype
			     (Declaration));
  
    Def_Kind := Asis.Elements.Definition_Kind(View);
    case Def_Kind is
      when Asis.A_Type_Definition =>

        Type_Kind := Asis.Elements.Type_Kind(View);
        case Type_Kind is
          when Asis.A_Record_Type_Definition | 
	       Asis.A_Tagged_Record_Type_Definition =>
	    return Components(View);

          when Asis.A_Derived_Record_Extension_Definition =>
            return Asis."&" 
		 (Record_Components
			(Asis.Definitions.Corresponding_Parent_Subtype(View)),
		  Components(View));

          when Asis.A_Derived_Type_Definition =>
	    -- recurse to check the parent subtype
	    -- this will unwind subtypes and derivations
	    return Record_Components
			 (Asis.Definitions.Corresponding_Parent_Subtype(View));

          when others =>
            if Debug then
              --%
              Ada.Text_IO.Put( "Record_Components:type_kind:others");
              Asis.Toolkit.ObjectAda.Elements.Print_Element
		        (Declaration, verbose => true, span => True);
            end if;
	    return Asis.Nil_Element_List;
        end case;

      when Asis.A_Private_Type_Definition |
           Asis.A_Tagged_Private_Type_Definition |
	   Asis.A_Private_Extension_Definition =>

	-- The full type of these must be a record
	-- recurse to check the parent subtype
	-- this will unwind each derivation
            if Debug then
              --%
              Ada.Text_IO.Put( "Record_Components:Priv_Type:Corresp");
              Asis.Toolkit.ObjectAda.Elements.Print_Element
		(Declaration, verbose => true, span => True);
            end if;
	return Record_Components
		     (Asis.Declarations.Corresponding_Type_Declaration
			  (Asis.Elements.Enclosing_Element(View)));

      when others =>
        if Debug then
          --%
          Ada.Text_IO.Put( "Record_Components:def_kind:others");
          Asis.Toolkit.ObjectAda.Elements.Print_Element
		      (Declaration, verbose => true, span => True);
        end if;
	return Asis.Nil_Element_List;
    end case;

  end Record_Components;

  function All_Record_Components (Declaration : in Asis.Declaration)
		             return Asis.Element_List is
  begin
    case Asis.Elements.Declaration_Kind(Declaration) is
      when Asis.An_Ordinary_Type_Declaration |
           Asis.A_Task_Type_Declaration |
           Asis.A_Protected_Type_Declaration |
           Asis.A_Private_Type_Declaration |
           Asis.A_Private_Extension_Declaration |
           Asis.A_Subtype_Declaration |
           Asis.A_Formal_Type_Declaration =>
 
        if Is_Record_Subtype(Declaration) then
          return Record_Components(Declaration);
        else
          if Debug then
            --%
            Ada.Text_IO.Put( "Is_Record_Subtype:FALSE");
            Asis.Toolkit.ObjectAda.Elements.Print_Element
		(Declaration, verbose => true, span => True);
          end if;
          return Asis.Nil_Element_List;
        end if;

      when others =>
        raise Asis.Exceptions.Asis_Inappropriate_Element;
    end case;

  end All_Record_Components;

  function Discriminants (Declaration : in Asis.Declaration)
		             return Asis.Element_List is
    Discrim_Part : Asis.Definition;
  begin
    case Asis.Elements.Declaration_Kind(Declaration) is
      when Asis.An_Ordinary_Type_Declaration |
           Asis.A_Task_Type_Declaration |
           Asis.A_Protected_Type_Declaration |
           Asis.A_Private_Type_Declaration |
           Asis.A_Private_Extension_Declaration |
           Asis.A_Formal_Type_Declaration =>
 
        -- check discrims of the enclosing declaration of the definition
        Discrim_Part := Asis.Declarations.Discriminant_Part(Declaration);
        if not Asis.Elements.Is_Nil(Discrim_Part) then
          return Asis.Definitions.Discriminants(Discrim_Part);
	else
          return Asis.Nil_Element_List;
        end if;

      when others =>
        raise Asis.Exceptions.Asis_Inappropriate_Element;
    end case;

  end Discriminants;

  function Is_Package (Declaration : in Asis.Declaration) return Boolean is
  begin
    case Asis.Elements.Declaration_Kind(Declaration) is
      when Asis.A_Package_Declaration | 
           Asis.A_Package_Body_Declaration | 
           Asis.A_Package_Renaming_Declaration | 
           Asis.A_Generic_Package_Renaming_Declaration | 
           Asis.A_Package_Body_Stub | 
           Asis.A_Generic_Package_Declaration | 
           Asis.A_Package_Instantiation | 
           Asis.A_Formal_Package_Declaration | 
           Asis.A_Formal_Package_Declaration_With_Box =>
	return True;

      when others =>
	return False;

    end case;
  end Is_Package;

  function Is_Generic (Declaration : in Asis.Declaration) return Boolean is
  begin

    --%Ada.Text_IO.Put( "Is_Generic:");
    --%Asis.Toolkit.ObjectAda.Elements.Print_Element
		--%(Declaration, verbose => true, span => True);

    if Asis.Declarations.Is_Subunit(Declaration) then
      return Is_Generic
		   (Asis.Declarations.Corresponding_Body_Stub(Declaration));
    end if;

    case Asis.Elements.Declaration_Kind(Declaration) is
      when Asis.A_Generic_Procedure_Declaration |
           Asis.A_Generic_Function_Declaration |
           Asis.A_Generic_Package_Declaration |
           Asis.A_Generic_Procedure_Renaming_Declaration |
           Asis.A_Generic_Function_Renaming_Declaration |
           Asis.A_Generic_Package_Renaming_Declaration =>
	return True;

      when Asis.A_Procedure_Body_Declaration | 
           Asis.A_Function_Body_Declaration | 
           Asis.A_Package_Body_Declaration | 
           Asis.A_Procedure_Body_Stub | 
           Asis.A_Function_Body_Stub | 
           Asis.A_Package_Body_Stub =>
	return Is_Generic
		   (Asis.Declarations.Corresponding_Declaration(Declaration));

      when others =>
        return False;

    end case;
  exception
    when Asis.Exceptions.Asis_Inappropriate_Element =>
      return False;
  end Is_Generic;

  function Is_Part_Of_Generic (Element : in Asis.Element) 
			      return Boolean is
    Encloser : Asis.Element := Element;
  begin
    -- loop over enclosing elements to see if one is_generic.
    loop
      if Is_Generic(Encloser) then
	return True;
      end if;
      Encloser := Asis.Elements.Enclosing_Element(Encloser); 
      --%Ada.Text_IO.Put( "Is_Part_Of_Generic:Encloser:");
      --%Asis.Toolkit.ObjectAda.Elements.Print_Element
		  --%(Encloser, verbose => true, span => True);
      exit when Asis.Elements.Is_Nil(Encloser); 
    end loop;

    return False;

  exception
    when Asis.Exceptions.Asis_Inappropriate_Element =>
      return False;
  end Is_Part_Of_Generic;

  function Is_Global (Declaration : in Asis.Declaration) return Boolean is
    Encloser : Asis.Element;
  begin
    case Asis.Elements.Declaration_Kind(Declaration) is
      when Not_A_Declaration =>
	return False;

      when others =>
	Encloser := Asis.Elements.Enclosing_Element(Declaration);

	while not Asis.Elements.Is_Nil(Encloser) loop
          if not Is_Package(Encloser) then
	    return False;
	  end if;
	  Encloser := Asis.Elements.Enclosing_Element(Encloser);
	end loop;

	-- all enclosing elements are packages
	return True;

    end case;
  end Is_Global;


  function Object_Subtype (Object : in Asis.Declaration) 
			  return Asis.Declaration is
    View : Asis.Definition;
    Indication : Asis.Expression;
  begin
    case Asis.Elements.Declaration_Kind(Object) is
      when Asis.A_Variable_Declaration | 
           Asis.A_Deferred_Constant_Declaration | 
           Asis.A_Component_Declaration |
           Asis.A_Constant_Declaration =>

        View := Asis.Declarations.Object_Declaration_View(Object);
        case Asis.Elements.Definition_Kind(View) is
	  when Asis.A_Subtype_Indication =>

            return TOOLEXPR.Entity_Declaration
		                  (Asis.Definitions.Subtype_Mark(View));

	  when Asis.A_Component_Definition =>
            return TOOLEXPR.Entity_Declaration
		     (Asis.Definitions.Subtype_Mark
		        (Asis.Definitions.Component_Subtype_Indication(View)));

          when others =>
	  --# could be anon array, A_Type_Definition
	    return Asis.Nil_Element;
	end case;

      when Asis.A_Discriminant_Specification |
           Asis.An_Object_Renaming_Declaration =>
         return TOOLEXPR.Entity_Declaration
                     (Asis.Declarations.Declaration_Subtype_Mark(Object));

      when others =>
	raise Asis.Exceptions.Asis_Inappropriate_Element;
    end case;
    
  end Object_Subtype;

  function Object_Constraint (Object : in Asis.Declaration)
		      return Asis.Constraint is
    View : Asis.Definition;
    Indication : Asis.Expression;
  begin
    case Asis.Elements.Declaration_Kind(Object) is
      when Asis.A_Variable_Declaration | 
           Asis.A_Deferred_Constant_Declaration | 
           Asis.A_Component_Declaration |
           Asis.A_Constant_Declaration =>

        View := Asis.Declarations.Object_Declaration_View(Object);
        case Asis.Elements.Definition_Kind(View) is
	  when Asis.A_Subtype_Indication =>

	    declare
	      Constraint : Asis.Constraint :=
	         Asis.Definitions.Subtype_Constraint(View);
	    begin
	      if not Asis.Elements.Is_Nil(Constraint) then
		return Constraint;

	      else
		-- recurse to look for a constraint
	        return Type_Constraint
		    (Asis.Declarations.Corresponding_Last_Constraint
                       (TOOLEXPR.Entity_Declaration
                          (Asis.Definitions.Subtype_Mark(View))));

	      end if;
	    end;

	  when Asis.A_Component_Definition =>

	    declare
	      Constraint : Asis.Constraint :=
	         Asis.Definitions.Subtype_Constraint
		     (Asis.Definitions.Component_Subtype_Indication(View));
	    begin
	      if not Asis.Elements.Is_Nil(Constraint) then
		return Constraint;

	      else
		-- look for a constraint
	        return Type_Constraint
		    (Asis.Declarations.Corresponding_Last_Constraint
                       (TOOLEXPR.Entity_Declaration
                          (Asis.Definitions.Subtype_Mark
		    (Asis.Definitions.Component_Subtype_Indication(View)))));

	      end if;
	    end;

          when others =>
	  --# could be anon array, A_Type_Definition
	    return Asis.Nil_Element;
	end case;

      when Asis.A_Discriminant_Specification =>
	   return Asis.Nil_Element;
	
      when others =>
	raise Asis.Exceptions.Asis_Inappropriate_Element;
    end case;
  end Object_Constraint;

  function Explicit_Object_Constraint (Object : in Asis.Declaration)
		      return Asis.Constraint is
    View : Asis.Definition;
    Indication : Asis.Expression;
  begin
    case Asis.Elements.Declaration_Kind(Object) is
      when Asis.A_Variable_Declaration | 
           Asis.A_Deferred_Constant_Declaration | 
           Asis.A_Component_Declaration |
           Asis.A_Constant_Declaration =>

        View := Asis.Declarations.Object_Declaration_View(Object);
        case Asis.Elements.Definition_Kind(View) is
	  when Asis.A_Subtype_Indication =>

	    return Asis.Definitions.Subtype_Constraint(View);

	  when Asis.A_Component_Definition =>

	    return Asis.Definitions.Subtype_Constraint
		     (Asis.Definitions.Component_Subtype_Indication(View));

          when others =>
	    --# could be anon array, A_Type_Definition
	    return Asis.Nil_Element;
	end case;

      when Asis.A_Discriminant_Specification =>
	   return Asis.Nil_Element;
	
      when others =>
	raise Asis.Exceptions.Asis_Inappropriate_Element;
    end case;
  end Explicit_Object_Constraint;

end Asis.Toolkit.ObjectAda.Declarations;