------------------------------------------------------------------------------
-- --
-- DISPLAY_SOURCE COMPONENTS --
-- --
-- N O D E _ T R A V --
-- --
-- B o d y --
-- --
-- Copyright (c) 1995-2002, Free Software Foundation, Inc. --
-- --
-- Display_Source is free software; you can redistribute it and/or modify it--
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 2, or (at your option) any later --
-- version. Display_Source is distributed in the hope that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details. You should have received a copy of the --
-- GNU General Public License distributed with GNAT; see file COPYING. If --
-- not, write to the Free Software Foundation, 59 Temple Place Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- Display_Source is distributed as a part of the ASIS implementation for --
-- GNAT (ASIS-for-GNAT). --
-- --
-- The original version of Display_Source has been developed by --
-- Jean-Charles Marteau and Serge Reboul, ENSIMAG High School Graduates --
-- (Computer sciences) Grenoble, France in Sema Group Grenoble, France. --
-- --
-- Display_Source is now maintained by Ada Core Technologies Inc --
-- (http://www.gnat.com). --
------------------------------------------------------------------------------
-----------------------------------------------------------------
-- This package is part of the ASIS application display_source --
-----------------------------------------------------------------
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Text_IO; use Text_IO;
with Asis.Elements;
with Asis.Text;
with Asis.Compilation_Units;
with Asis.Declarations;
with Asis.Expressions;
with Global_Info; use Global_Info;
package body Node_Trav is
use Asis;
-- to make all the literals from Element classification hierarchy
-- directly visible
-------------------------------------------
-- --
-- Here are the 2 procedures that are --
-- called in pre_procedure when we are --
-- in test_control mode. --
-- --
-------------------------------------------
procedure Pre_Test_Control
(Element : in Asis.Element;
Control : in out Asis.Traverse_Control;
State : in out Info_Node) is
begin
pragma Unreferenced (State);
case Asis.Elements.Element_Kind (Element) is
when A_Statement =>
case Asis.Elements.Statement_Kind (Element) is
when A_Return_Statement |
A_While_Loop_Statement =>
-- to check if children are left too ..
Control := Asis.Abandon_Siblings;
when A_For_Loop_Statement =>
Control := Asis.Abandon_Children;
when A_Raise_Statement =>
Control := Asis.Terminate_Immediately;
when others => null;
end case;
when others =>
null;
end case;
if Asis."/=" (Control, Asis.Continue) then
Put_Line ("Pre Control : " &
Asis.Traverse_Control'Image (Control));
end if;
end Pre_Test_Control;
procedure Post_Test_Control
(Element : in Asis.Element;
Control : in out Asis.Traverse_Control;
State : in out Info_Node) is
begin
pragma Unreferenced (State);
case Asis.Elements.Element_Kind (Element) is
when A_Statement =>
case Asis.Elements.Statement_Kind (Element) is
when A_Return_Statement |
A_While_Loop_Statement =>
Put_Line ("We shouldn't be in post A_Return_Statement "&
"or A_While_Loop_Statement");
when A_For_Loop_Statement =>
Put_Line ("We shouldn't be in post A_For_Loop_Statement");
when A_Raise_Statement =>
Put_Line ("We shouldn't be in post A_Raise_Statement");
when others => null;
end case;
when A_Path =>
case Asis.Elements.Path_Kind (Element) is
when An_Elsif_Path =>
Control := Asis.Abandon_Siblings;
when An_Else_Path =>
Control := Asis.Abandon_Children;
when A_Case_Path =>
Control := Asis.Terminate_Immediately;
when others =>
null;
end case;
when others =>
null;
end case;
if Asis."/=" (Control, Asis.Continue) then
Put_Line ("Post Control : " &
Asis.Traverse_Control'Image (Control));
end if;
end Post_Test_Control;
--------------------------------------------
-- --
-- Here is the pre procedure to provide --
-- to Traverse_Element to make a node --
-- display. --
-- --
--------------------------------------------
procedure Pre_Procedure
(Element : in Asis.Element;
Control : in out Asis.Traverse_Control;
State : in out Info_Node) is
function Indentation return String;
function Indentation return String is
Res : String (1 .. 2 * State.Indentation) := (others => '-');
begin
if Res'Length > 0 then
Res (Res'Last) := '>';
end if;
return Res;
end Indentation;
begin
if The_Mode = Node_And_Lines then
while Asis.Text.First_Line_Number (Element) >
State.Last_Commented_Line
loop
State.Last_Commented_Line := State.Last_Commented_Line + 1;
declare
List : Asis.Text.Line_List := Asis.Text.Lines
(Element,
State.Last_Commented_Line,
State.Last_Commented_Line);
begin
if List'Last - List'First + 1 > 0 then
declare
Comment : String := To_String (Asis.Text.Comment_Image
(List (List'First)));
begin
if Comment'Length /= 0 then
Put_Line (Comment);
end if;
end;
end if;
end;
end loop;
end if;
Put_Line (Indentation &
Element_Kinds'Image (Asis.Elements.Element_Kind (Element)));
case Asis.Elements.Element_Kind (Element) is
when A_Pragma => -- Asis.Elements
Put_Line (Indentation & " " &
Pragma_Kinds'Image (Asis.Elements.Pragma_Kind (Element))
& " ... " &
To_String (Asis.Elements.Pragma_Name_Image (Element)));
when A_Defining_Name => -- Asis.Declarations
Put_Line (Indentation & " " & Defining_Name_Kinds'Image
(Asis.Elements.Defining_Name_Kind (Element)) &
" ... " &
(To_String
(Asis.Declarations.Defining_Name_Image (Element))));
case Asis.Elements.Defining_Name_Kind (Element) is
when A_Defining_Operator_Symbol =>
Put_Line (Indentation & " " & Operator_Kinds'Image
(Asis.Elements.Operator_Kind (Element)));
when others => null;
end case;
when A_Declaration => -- Asis.Declarations
Put_Line (Indentation & " " & Declaration_Kinds'Image
(Asis.Elements.Declaration_Kind (Element)));
case Asis.Elements.Declaration_Kind (Element) is
when A_Private_Type_Declaration |
A_Private_Extension_Declaration |
A_Variable_Declaration |
A_Constant_Declaration |
A_Deferred_Constant_Declaration |
A_Discriminant_Specification |
A_Loop_Parameter_Specification |
A_Procedure_Declaration |
A_Function_Declaration |
A_Parameter_Specification =>
Put_Line (Indentation & " " & Trait_Kinds'Image
(Asis.Elements.Trait_Kind (Element)));
when A_Formal_Function_Declaration |
A_Formal_Procedure_Declaration =>
Put_Line
(Indentation & " " & Subprogram_Default_Kinds'Image
(Asis.Elements.Default_Kind (Element)));
when others =>
null;
end case;
case Asis.Elements.Declaration_Kind (Element) is
when A_Parameter_Specification |
A_Formal_Object_Declaration =>
Put_Line (Indentation & " " & Mode_Kinds'Image
(Asis.Elements.Mode_Kind (Element)));
when others =>
null;
end case;
when A_Definition => -- Asis.Definitions
Put_Line (Indentation & " " & Definition_Kinds'Image
(Asis.Elements.Definition_Kind (Element)));
case Asis.Elements.Definition_Kind (Element) is
when A_Type_Definition =>
Put_Line (Indentation & " " & Type_Kinds'Image
(Asis.Elements.Type_Kind (Element)));
case Asis.Elements.Type_Kind (Element) is
when An_Access_Type_Definition =>
Put_Line
(Indentation & " " & Access_Type_Kinds'Image
(Asis.Elements.Access_Type_Kind (Element)));
when A_Derived_Type_Definition |
A_Derived_Record_Extension_Definition |
A_Record_Type_Definition |
A_Tagged_Record_Type_Definition =>
Put_Line (Indentation & " " & Trait_Kinds'Image
(Asis.Elements.Trait_Kind (Element)));
when others => null;
end case;
when A_Constraint =>
Put_Line (Indentation & " " & Constraint_Kinds'Image
(Asis.Elements.Constraint_Kind (Element)));
when A_Formal_Type_Definition =>
Put_Line (Indentation & " " & Formal_Type_Kinds'Image
(Asis.Elements.Formal_Type_Kind (Element)));
case Asis.Elements.Formal_Type_Kind (Element) is
when A_Formal_Access_Type_Definition =>
Put_Line
(Indentation & " " & Access_Type_Kinds'Image
(Asis.Elements.Access_Type_Kind (Element)));
when A_Formal_Private_Type_Definition |
A_Formal_Tagged_Private_Type_Definition |
A_Formal_Derived_Type_Definition =>
Put_Line (Indentation & " " & Trait_Kinds'Image
(Asis.Elements.Trait_Kind (Element)));
when others => null;
end case;
when A_Discrete_Subtype_Definition |
A_Discrete_Range =>
Put_Line (Indentation & " " & Discrete_Range_Kinds'Image
(Asis.Elements.Discrete_Range_Kind (Element)));
when A_Component_Definition |
A_Private_Type_Definition |
A_Tagged_Private_Type_Definition |
A_Private_Extension_Definition =>
Put_Line (Indentation & " " & Trait_Kinds'Image
(Asis.Elements.Trait_Kind (Element)));
when others => null;
end case;
when An_Expression => -- Asis.Expressions
case Asis.Elements.Expression_Kind (Element) is
when An_Attribute_Reference =>
Put (Indentation & " " & Expression_Kinds'Image
(Asis.Elements.Expression_Kind (Element)));
Put_Line (" ... " & Attribute_Kinds'Image
(Asis.Elements.Attribute_Kind (Element)));
when An_Identifier |
An_Operator_Symbol |
A_Character_Literal |
An_Enumeration_Literal =>
Put (Indentation & " " & Expression_Kinds'Image
(Asis.Elements.Expression_Kind (Element)));
Put_Line (" ... " &
To_String (Asis.Expressions.Name_Image (Element)));
when An_Integer_Literal |
A_Real_Literal |
A_String_Literal =>
Put (Indentation & " " & Expression_Kinds'Image
(Asis.Elements.Expression_Kind (Element)));
Put_Line (" ... " &
To_String (Asis.Expressions.Value_Image (Element)));
when A_Function_Call =>
Put (Indentation & " " & Expression_Kinds'Image
(Asis.Elements.Expression_Kind (Element)));
if Asis.Expressions.Is_Prefix_Call (Element) then
Put_Line (" ... Prefixed");
else
Put_Line (" ... Infixed");
end if;
when others =>
Put_Line (Indentation & " " & Expression_Kinds'Image
(Asis.Elements.Expression_Kind (Element)));
end case;
when An_Association => -- Asis.Expressions
Put_Line (Indentation & " " & Association_Kinds'Image
(Asis.Elements.Association_Kind (Element)));
when A_Statement => -- Asis.Statements
Put_Line (Indentation & " " & Statement_Kinds'Image
(Asis.Elements.Statement_Kind (Element)));
when A_Path => -- Asis.Statements
Put_Line (Indentation & " " & Path_Kinds'Image
(Asis.Elements.Path_Kind (Element)));
when A_Clause => -- Asis.Clauses
Put_Line (Indentation & " " & Clause_Kinds'Image
(Asis.Elements.Clause_Kind (Element)));
case Asis.Elements.Clause_Kind (Element) is
when A_Representation_Clause =>
Put_Line
(Indentation & " " & Representation_Clause_Kinds'Image
(Asis.Elements.Representation_Clause_Kind (Element)));
when others =>
null;
end case;
when others => null;
end case;
if The_Mode = Node_And_Lines then
Put (Indentation & " From line" &
Asis.Text.Line_Number'Image
(Asis.Text.First_Line_Number (Element)) &
" to line" &
Asis.Text.Line_Number'Image
(Asis.Text.Last_Line_Number (Element)));
declare
The_Span : Asis.Text.Span :=
Asis.Text.Element_Span (Element);
begin
Put (" Span : (" &
Asis.Text.Line_Number'Image (The_Span.First_Line) &
"," &
Asis.Text.Character_Position'Image (The_Span.First_Column) &
"), (" &
Asis.Text.Line_Number'Image (The_Span.Last_Line) &
"," &
Asis.Text.Character_Position'Image (The_Span.Last_Column) &
")");
end;
declare
List : Asis.Text.Line_List := Asis.Text.Lines (Element);
N : Natural := List'Last - List'First + 1;
begin
Put (" (" & Asis.Text.Line_Number'Image (N) & " lines of lengths");
for I in List'First .. List'Last
loop
Put ("," &
Asis.Text.Character_Position'Image
(Asis.Text.Length (List (I))));
end loop;
Put_Line (")");
end;
end if;
if The_Mode = Test_Control then
Pre_Test_Control (Element, Control, State);
end if;
State.Indentation := State.Indentation + 1;
end Pre_Procedure;
procedure Post_Procedure
(Element : in Asis.Element;
Control : in out Asis.Traverse_Control;
State : in out Info_Node) is
begin
State.Indentation := State.Indentation - 1;
if The_Mode = Test_Control then
Post_Test_Control (Element, Control, State);
end if;
end Post_Procedure;
procedure Initiate_Node
(Unit : in Asis.Compilation_Unit;
Control : in out Asis.Traverse_Control;
State : in out Info_Node) is
begin
pragma Unreferenced (Control);
Put_Line ("Unit Kind : " &
Asis.Unit_Kinds'Image
(Asis.Compilation_Units.Unit_Kind (Unit)));
State.Indentation := 0;
end Initiate_Node;
procedure Terminate_Node
(Control : in out Asis.Traverse_Control;
State : in out Info_Node) is
begin
pragma Unreferenced (Control);
pragma Unreferenced (State);
null;
end Terminate_Node;
end Node_Trav;
syntax highlighted by Code2HTML, v. 0.9.1