Introspection, the Ada way

scope.adb

with Ada.Strings.Fixed;

package body Scope is

  use all type Ada.Strings.Direction;
  use Ada.Strings.Fixed;

  function Local (This : in Ada.Tags.Tag) return String is
    Full_Tag_Name : constant String := Ada.Tags.Expanded_Name (This);
    -- tag name is (expected to be) in the form of
    -- "package_name.[nested_package_name.]*subroutine_name.[nested_subroutine_name.]*type_name"
    -- hence the short name of the current scope is basically the name between the two last dots.
    Right_Dot : constant Positive := Index (Full_Tag_Name, ".", Full_Tag_Name'Last, Backward);
    Left_Dot  : constant Positive := Index (Full_Tag_Name, ".", Right_Dot - 1,      Backward);
  begin
    return Full_Tag_Name (Left_Dot + 1 .. Right_Dot - 1);
  end Local;

  function Full (This : in Ada.Tags.Tag) return String is
    Full_Tag_Name : constant String := Ada.Tags.Expanded_Name (This);
    -- tag name is (expected to be) in the form of
    -- "package_name.[nested_package_name.]*subroutine_name.[nested_subroutine_name.]*type_name"
    -- hence the full name of the current scope is basically the name before the last dot.
    Right_Dot : constant Positive := Index (Full_Tag_Name, ".", Full_Tag_Name'Last, Backward);
  begin
    return Full_Tag_Name (Full_Tag_Name'First .. Right_Dot - 1);
  end Full;

end Scope;

scope.ads

with Ada.Tags;

package Scope is

  function Local (This : in Ada.Tags.Tag) return String;
  --  Returns the most local name of the scope T was instantiated in.

  function Full (This : in Ada.Tags.Tag) return String;
  --  Returns the full name of the scope T was instantiated in.

end Scope;

scope_test.adb

with Ada.Text_IO;
with Scope;

procedure Scope_Test is
  type T is tagged null record;
begin
  A : declare
    type T is tagged null record;
  begin
    B : declare
      type T is tagged null record;
    begin
      Ada.Text_IO.Put_Line ("S (F) => " & Scope.Full (Scope_Test.T'Tag));
      Ada.Text_IO.Put_Line ("S (L) => " & Scope.Local (Scope_Test.T'Tag));
      Ada.Text_IO.Put_Line ("A (F) => " & Scope.Full (A.T'Tag));
      Ada.Text_IO.Put_Line ("A (L) => " & Scope.Local (A.T'Tag));
      Ada.Text_IO.Put_Line ("B (F) => " & Scope.Full (B.T'Tag));
      Ada.Text_IO.Put_Line ("B (L) => " & Scope.Local (B.T'Tag));
    end B;
  end A;
end Scope_Test;