File : asis-iterator.adb
------------------------------------------------------------------------------
-- --
-- ASIS-for-GNAT IMPLEMENTATION COMPONENTS --
-- --
-- A S I S . I T E R A T O R --
-- --
-- B o d y --
-- --
-- Copyright (c) 1995-1999, Free Software Foundation, Inc. --
-- --
-- ASIS-for-GNAT 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. ASIS-for-GNAT 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 ASIS-for-GNAT; see file --
-- COPYING. If not, write to the Free Software Foundation, 59 Temple Place --
-- - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- ASIS-for-GNAT was originally developed by the ASIS-for-GNAT team at the --
-- Software Engineering Laboratory of the Swiss Federal Institute of --
-- Technology (LGL-EPFL) in Lausanne, Switzerland, in cooperation with the --
-- Scientific Research Computer Center of Moscow State University (SRCC --
-- MSU), Russia, with funding partially provided by grants from the Swiss --
-- National Science Foundation and the Swiss Academy of Engineering --
-- Sciences. ASIS-for-GNAT is now maintained by Ada Core Technologies Inc --
-- (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Ada.Exceptions;
with Asis.Exceptions; use Asis.Exceptions;
with Asis.Errors; use Asis.Errors;
with Asis.Elements;
with A4G.Vcheck; use A4G.Vcheck;
with A4G.Queries; use A4G.Queries;
-----------------------------------------------------------------
-- --
-- Process_Children is the function that gets all the children --
-- and calls Recursive_Traversal on them. To get the children --
-- it uses a function that takes an element and returns all --
-- the queries that can obtain children from this element. --
-- (see asis_elements-queries.ads) --
-- --
-- This way, the generic body to instanciate doesn't contain --
-- the procedures that obtain the children, the code is not --
-- duplicated, and so we have a gain in performance (time & --
-- memory). --
-- --
-- Concerning the Control, all Pre and Post-conditions have --
-- been put at the begining and end of the procedures and --
-- blocks that deal with them. --
-- --
-- The (Control = Terminate_Immediatly) has been handled by --
-- returning from all the recursive calls ... --
-- --
-----------------------------------------------------------------
package body Asis.Iterator is
procedure Traverse_Element
(Element : in Asis.Element;
Control : in out Traverse_Control;
State : in out State_Information)
is
procedure Recursive_Traversal
(Element : in Asis.Element;
Control : in out Traverse_Control);
-- This procedure does the main job
procedure Traverse_Children
(Element : in Asis.Element;
Control : in out Traverse_Control);
-- Traverses children of a given construct
------------------------------------------------------
-- Pre-condition: any value of Control is possible --
------------------------------------------------------
procedure Traverse_Children
(Element : in Asis.Element;
Control : in out Traverse_Control)
is
-- The value of Control has been set by Pre_Operation
-- Child access is an array containing access to the functions
-- needed to access element's children
Child_Access : Query_Array := Appropriate_Queries (Element);
function Do_Return return Boolean;
-- Check and reset the Control value on return from the traverse.
-- the boolean returned says wether or not the program should
-- return
function Do_Return return Boolean is
begin
--------------------------------------------------------
-- Post-condition: Control = Continue --
-- or Control = Abandon_Siblings --
-- or Control = Terminate_Immediately --
--------------------------------------------------------
case Control is
when Terminate_Immediately =>
return True;
when Continue =>
return False;
when Abandon_Siblings =>
Control := Continue;
-- to continue the traversal of the parent
-- of the Each_Child (that is, Element) with
-- its Post_Operation
return True; -- to prevent traversal of Each_Child siblings
when Abandon_Children =>
-- this choice could never been chosen!!!
return False;
end case;
---------------------------------------------------------------
-- Post-Condition : Control = Continue (True or False) --
-- or Control = Terminate_Immediately (True) --
---------------------------------------------------------------
end Do_Return;
begin -- Traverse_Children
-- Validity Check has already been done
------------------------------------------
-- Pre-condition: Control = Continue --
------------------------------------------
-- Classify the Element using the various kinds queries.
-- Query for all children of the Element in left-to-right order.
-- Perform a depth-first traversal on each child.
-- The only possibility for Control is to be equal to Continue here!
-- If the current Element has no children, Control remains to be
-- equal to Continue
for Each_Query in Child_Access'Range loop
case Child_Access (Each_Query).Query_Kind is
when Bug =>
Raise_ASIS_Failed ("Asis.Iterator.Traverse_Children");
when Single_Element_Query =>
declare
Child : Asis.Element :=
Child_Access (Each_Query).Func_Simple (Element);
begin
if Asis.Elements.Element_Kind (Child) /=
Not_An_Element
then
Recursive_Traversal (Child, Control);
if Do_Return then
return;
end if;
end if;
end;
when Element_List_Query =>
declare
Child_List : Asis.Element_List :=
Child_Access (Each_Query).Func_List (Element);
begin
-- If the list is empty, it's ok ... nothing is processed
for Each_Element in Child_List'Range loop
Recursive_Traversal
(Child_List (Each_Element), Control);
if Do_Return then
return;
end if;
end loop;
end;
when Element_List_Query_With_Boolean =>
declare
Child_List : Asis.Element_List :=
Child_Access (Each_Query).Func_List_Boolean
(Element, Child_Access (Each_Query).Bool);
begin
-- If the list is empty, it's ok ... nothing is processed
for Each_Element in Child_List'Range loop
Recursive_Traversal
(Child_List (Each_Element), Control);
if Do_Return then
return;
end if;
end loop;
end;
end case;
end loop;
-------------------------------------------
-- Post-condition: Control = Continue --
-------------------------------------------
-- if Terminate_Immediately was set, we --
-- just do not entry this procedure ... --
-------------------------------------------
end Traverse_Children;
--------------------------------------------------------
-- Post-condition: any value of Control is possible, --
--------------------------------------------------------
-------------------------
-- Recursive_Traversal --
-------------------------
----------------------------------------
-- Pre-condition: Control = Continue --
----------------------------------------
procedure Recursive_Traversal
(Element : in Asis.Element;
Control : in out Traverse_Control) is
begin
----------------------------------------
-- Pre-condition: Control = Continue --
----------------------------------------
begin
Pre_Operation (Element, Control, State); -- Visit the Element.
exception
when The_Error : others => -- ???
Add_Call_Information (
Argument => Element,
Outer_Call => "Actual procedure for Pre_Operation " &
"raised the exception : " &
Ada.Exceptions.Exception_Name (The_Error));
Reset_Postponing;
raise;
end;
--------------------------------------------------------
-- Post-condition: any value of Control is possible --
--------------------------------------------------------
if Control = Continue then
Traverse_Children (Element, Control);
end if;
--------------------------------------------------------
-- Pre-condition: any value of Control is possible, --
--------------------------------------------------------
case Control is
when Terminate_Immediately =>
return;
when Continue =>
begin
-- Revisit the Element
Post_Operation (Element, Control, State);
exception
when The_Error : others => -- ????
Add_Call_Information (
Argument => Element,
Outer_Call =>
"Actual procedure for Post_Operation " &
"raised the exception : " &
Ada.Exceptions.Exception_Name (The_Error));
Reset_Postponing;
raise;
end;
-- reset the Control set by Post_Operation:
case Control is
when Terminate_Immediately =>
return;
when Continue =>
null;
when Abandon_Children =>
Control := Continue;
-- the current Element has no children to traverse
-- anymore!
when Abandon_Siblings =>
null;
end case;
when Abandon_Children =>
-- OK, we abandonned the children, now we go up and continue
Control := Continue;
when Abandon_Siblings =>
null;
end case;
---------------------------------------------------------
-- Post-condition: Control = Continue --
-- or Control = Abandon_Siblings --
-- or Control = Terminate_Immediately --
---------------------------------------------------------
end Recursive_Traversal;
---------------------------------------------------------
-- Post-condition: Control = Continue --
-- or Control = Abandon_Siblings --
-- or Control = Terminate_Immediately --
---------------------------------------------------------
---------------------------------
-- Traversal_Element Main body --
---------------------------------
begin
Check_Validity (Element, "Asis.Elements.Traverse_Element");
if Asis.Elements.Is_Nil (Element) then
Raise_ASIS_Inappropriate_Element
(Diagnosis => "Asis.Iterator.Traverse_Element");
elsif Control /= Continue then
return;
end if;
----------------------------------------
-- Pre-condition: Control = Continue --
----------------------------------------
Recursive_Traversal (Element => Element,
Control => Control);
exception
when ASIS_Inappropriate_Element =>
raise;
when ASIS_Inappropriate_Context |
ASIS_Inappropriate_Container |
ASIS_Inappropriate_Compilation_Unit |
ASIS_Inappropriate_Line |
ASIS_Inappropriate_Line_Number |
ASIS_Failed
=>
Add_Call_Information (
Argument => Element,
Outer_Call => "Asis.Iterator.Traverse_Element");
raise;
when Storage_Error =>
Raise_ASIS_Failed (
Argument => Element,
Diagnosis => "Asis.Iterator.Traverse_Element",
Stat => Asis.Errors.Storage_Error);
when others =>
Raise_ASIS_Failed (
Argument => Element,
Diagnosis => "Asis.Iterator.Traverse_Element");
end Traverse_Element;
end Asis.Iterator