The generic compilation component: a tree interpreter

The program
The Input
The command file
The Output

Sample tree-walking routine: traverse the tree created by a previous compilation, and identify some of the components of the program. In this case, list the kind of all nodes traversed, and list the names of the subprograms declared in the visible part of package declarations, both for for the main unit and for the units that appear in its context clause. ('withed' units).
The program
with Ada.Command_Line; use Ada.Command_Line;
with Atree; use Atree;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Io;
with Lib;
with Nlists; use Nlists;
with Sinfo; use Sinfo;
with Sinput;
with Namet; use Namet;
with Tree_In;
with Types; use Types;

procedure Test_Walker is
   N              : Node_Id;
   Tree_File_Name : String    := Argument (1) & Ascii.Nul;
   Error_Msg      : String    := " had unhandled exception"
                                  & Ascii.LF & Ascii.Nul;
   Result         : Integer;
   FD             : File_Descriptor;
   
   procedure Walk (N : Node_Id);
   --  Recursive procedure that does the work.
   
   procedure Walk (N : Node_Id) is
      Line       : Integer;
      Loc        : Source_Ptr;
      Kind       : Node_Kind;
      Kids       : List_Id;
      L          : Node_Id;
      F          : Node_Id;

   begin
      Kind := Nkind (N);
      Gnat.IO.Put ("Encountered Node Kind : ");
      Gnat.IO.Put_Line (Node_Kind'Image (Kind));

      case Kind is
	 when N_Compilation_Unit =>
	    Walk (Unit (N));
	    Kids := Context_Items (N);        --  list of withed units
	    F := First (Kids);
	    L := F;

	    while L /= Empty loop
	       Walk (L);
	       L := Next (L);
	       exit when L = F;
	    end loop;

	 when N_With_Clause =>
	    Walk (Library_Unit(N));

	 when N_Package_Declaration =>
	    Walk (Specification (N));

	 when N_Package_Specification =>
	    Kids := Visible_Declarations (N);
	    F := First (Kids);
	    L := F;

	    while L /= Empty loop
	       Walk (L);
	       L := Next (L);
	       exit when L = F;
	    end loop;

	 when N_Subprogram_Declaration =>
	    declare 
 	       Subprog_Id : Node_Id := Defining_Unit_Name (Specification (N));
	       Subprog_Name_Id : Name_Id := Chars (Subprog_Id);
            begin
	       Loc := Sloc (Subprog_Id);
	       Line := Integer (Sinput.Get_Line_Number (Loc));
	       Get_Name_String (Chars (Subprog_Id));
	       Gnat.IO.Put ("Declaration of ");
	       Gnat.IO.Put (Name_Buffer (1 .. Name_Len));
	       Gnat.IO.Put (" found on Line ");
	       Gnat.IO.Put (Line);
	       GNAT.IO.New_Line;
	       end;

	 when others =>
	    null;
      end case;
   end Walk;

begin

   FD := Open_Read (Tree_File_Name'Address, Binary);
   Tree_In (FD);
   N := Lib.Cunit (Types.Main_Unit);
   Walk (N);

exception
   when others =>
      Result := GNAT.OS_Lib.Write (Standerr, Tree_File_Name'Address,
				   Tree_File_Name'Length - 1);
      Result := GNAT.OS_Lib.Write (Standerr, Error_Msg'Address,
				   Error_Msg'Length - 1);
end Test_Walker;


test program for tree walker

package Tiny is I: Integer; procedure Foo (J : Integer); procedure Bar; end Tiny;

Command file

#!/bin/csh source ../env-vals gcc -c -gnatv -gnatt tiny.ads gnatmake -gnatv -I../ada -gnatv test_walker ./test_walker tiny.ats

Output of tree walker

spunky% ./test_walker tiny.ats Encountered Node Kind : N_COMPILATION_UNIT Encountered Node Kind : N_PACKAGE_DECLARATION Encountered Node Kind : N_PACKAGE_SPECIFICATION Encountered Node Kind : N_OBJECT_DECLARATION Encountered Node Kind : N_SUBPROGRAM_DECLARATION Declaration of foo found on Line 3 Encountered Node Kind : N_SUBPROGRAM_DECLARATION Declaration of bar found on Line 4