-- ASIS_Application_Example

-- Use to traverse compilation unit

-- The following example of an ASIS tool prompts the user for the name of
-- an Ada package specification, traverses that compilation unit, and prints
-- all explicit declarations with their kind. ASIS Application Example:

with Asis;                                                               --  3.0
with Asis.Errors;                                                        --  4.0
with Asis.Exceptions;                                                    --  5.0
with Asis.Implementation;                                                --  6.0
with Asis.Ada_Environments;                                              --  8.0
with Asis.Compilation_Units;                                             -- 10.0
with Asis.Elements;                                                      -- 13.0
with Asis.Iterator;                                                      -- 14.0
with Asis.Declarations;                                                  -- 15.0
with Ada.Wide_Text_Io; use Ada.Wide_Text_Io;

Procedure ASIS_Application_Example is

   My_Context                 : Asis.Context;                            --  3.7
   My_Unit                    : Asis.Compilation_Unit;                   --  3.10
   Unit_Name                  : Wide_String ( 1 .. 100 );
   Unit_Name_Length           : Natural;

   procedure Report_Declarations (Unit : in Asis.Compilation_Unit) is    --  3.10

      My_Element              : Asis.Element;                            --  3.6
      My_Control              : Asis.Traverse_Control                    --  3.13
                                  := Asis.Continue;
      My_State                : Boolean := True;

      procedure Process_Element
                   (Elem      : in     Asis.Element;                     --  3.6
                    Control   : in out Asis.Traverse_Control;            --  3.13
                    State     : in out Boolean);

      procedure No_Op
                   (Elem      : in     Asis.Element;                     --  3.6
                    Control   : in out Asis.Traverse_Control;            --  3.13
                    State     : in out Boolean);

      procedure Find_and_Print_Declarations is new
                    Asis.Iterator.Traverse_Element                       -- 14.1
                       (Boolean, Process_Element, No_Op);

      procedure No_Op
                   (Elem      : in     Asis.Element;                     --  3.6
                    Control   : in out Asis.Traverse_Control;            --  3.13
                    State     : in out Boolean) is
      begin
         null;
      end No_Op;


      procedure Process_Element
                   (Elem      : in     Asis.Element;                     --  3.6
                    Control   : in out Asis.Traverse_Control;            --  3.13
                    State     : in out Boolean) is

         package Kind_Io is new Ada.Wide_Text_Io.Enumeration_Io
                            (Asis.Declaration_Kinds);                    --  3.9.4

         Decl_Kind : Asis.Declaration_Kinds :=                           --  3.9.4
             Asis.Elements.Declaration_Kind (Elem);                      -- 13.9

      begin -- Process_Element

         case Decl_Kind is

            when Asis.Not_A_Declaration => null;                         --  3.9.4

            when others =>

                if not Asis."="                                          --  3.9.6
                          (Asis.Elements.Declaration_Origin (Elem),      -- 13.11
                           Asis.An_Explicit_Declaration) then            --  3.9.6
                   return;
                end if;

                declare

                   Name_List : Asis.Defining_Name_List                   --  3.8
                          := Asis.Declarations.Names (Elem);             -- 15.1

                begin
                   for I in Name_List'Range loop
                       Put (Asis.Declarations.Defining_Name_Image
                           (Name_List (I)));                             -- 15.2
                       Put (" (is kind) ");
                       Kind_Io.Put (Decl_Kind);
                       New_Line;
                   end loop;
                end;

         end case;

      end Process_Element;

   begin -- Report_Declarations
      My_Element   := Asis.Elements.Unit_Declaration ( Unit );           -- 13.1
      Find_and_Print_Declarations (My_Element, My_Control, My_State);
   end Report_Declarations;

begin -- ASIS_Application_Example

   Asis.Implementation.Initialize;                                       --  6.6
   Asis.Ada_Environments.Associate(My_Context, "My Context");            --  8.3
   Asis.Ada_Environments.Open (My_Context);                              --  8.4

   Put_Line ("Type the name of an Ada package specification");
   Get_Line (Unit_Name, Unit_Name_Length);

   My_Unit := Asis.Compilation_Units.Library_Unit_Declaration            -- 10.8
                  ( Unit_Name ( 1 .. Unit_Name_Length), My_Context );

   if Asis.Compilation_Units.Is_Nil ( My_Unit )                          -- 10.15
   then
      Put ("Context does not contain the requested unit: ");
      Put (Unit_Name ( 1 .. Unit_Name_Length));
      New_Line;
   else
      Put ("Context contains the requested unit: ");
      Put (Unit_Name ( 1 .. Unit_Name_Length));
      New_Line;
      Report_Declarations ( My_Unit );
      New_Line;
   end if;

   Asis.Ada_Environments.Close( My_Context );                            --  8.5
   Asis.Ada_Environments.Dissociate( My_Context );                       --  8.6
   Asis.Implementation.Finalize;                                         --  6.8


exception

   when   Asis.Exceptions.ASIS_Inappropriate_Context                     --  5.0
        | Asis.Exceptions.ASIS_Inappropriate_Container                   --  5.0
        | Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit            --  5.0
        | Asis.Exceptions.ASIS_Inappropriate_Element                     --  5.0
        | Asis.Exceptions.ASIS_Inappropriate_Line                        --  5.0
        | Asis.Exceptions.ASIS_Inappropriate_Line_Number                 --  5.0
        | Asis.Exceptions.ASIS_Failed                                    --  5.0
        =>

        Put (Asis.Implementation.Diagnosis);                             --  6.10
        New_Line;
        Put ("Status Value is ");
        Put (Asis.Errors.Error_Kinds'Wide_Image                          --  4.1
                        (Asis.Implementation.Status));                   --  6.9
        New_Line;

   when others =>

        Put_Line ("ASIS Application failed because of non-ASIS reasons");

end ASIS_Application_Example;

-- ASIS Application Example using following package specification named asis_test:

--         package asis_test is
--
--              type T is ( A, B, C);
--
--              S : integer := T'BASE'SIZE ;
--
--         end asis_test ;


-- Result of executing ASIS Application Example:

--     Type the name of an Ada package specification
--     asis_test
--     Context contains the requested unit: asis_test
--     asis_test (is kind) A_PACKAGE_DECLARATION
--     T (is kind) AN_ORDINARY_TYPE_DECLARATION
--     A (is kind) AN_ENUMERATION_LITERAL_SPECIFICATION
--     B (is kind) AN_ENUMERATION_LITERAL_SPECIFICATION
--     C (is kind) AN_ENUMERATION_LITERAL_SPECIFICATION
--     S (is kind) A_VARIABLE_DECLARATION