------------------------------------------------------------------------------
-- --
-- GNATELIM COMPONENTS --
-- --
-- G N A T E L I M . E N T I T I E S --
-- --
-- B o d y --
-- --
-- $Revision: 1.22 $
-- --
-- Copyright (c) 1997-2000, Free Software Foundation, Inc. --
-- --
-- Gnatelim 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. Gnatelim is distributed in the hope that it will be useful, --
-- 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. --
-- --
-- Gnatelim is distributed as a part of the ASIS implementation for GNAT --
-- (ASIS-for-GNAT). --
-- --
-- Gnatelim was originally developed by Alain Le Guennec --
-- --
-- Gnatelim is now maintained by Ada Core Technologies Inc --
-- (http://www.gnat.com). --
------------------------------------------------------------------------------
with Ada.Unchecked_Conversion;
with Interfaces; use Interfaces;
with GNATELIM.Errors; use GNATELIM.Errors;
with Table;
with GNAT.HTable;
with Asis.Elements; use Asis.Elements;
with Asis.Declarations; use Asis.Declarations;
with Asis.Expressions; use Asis.Expressions;
with Asis.Exceptions; use Asis.Exceptions;
use Asis;
with Ada.Characters.Handling; use Ada.Characters.Handling;
package body GNATELIM.Entities is
type Access_Wide_String is access all Wide_String;
-- Starting with 3.10, the generic package is Standard.Table.Table.
package List_Of_Used_Entities is new Standard.Table.Table
(Table_Component_Type => Entity_Id,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 50,
Table_Name => "List of used entities");
type Boolean_Flags is array (Flag_Range) of Boolean;
-- For entities properties.
type Static_Links is array (Link_Range) of Entity_Id;
-- To link entities with other entities.
type Entity is record
Element : Asis.Element;
-- This Element is always explicit (no "artificial constructs".)
Name : Access_Wide_String;
-- Defining name of the entity.
Used_Entities : List_Of_Used_Entities.Saved_Table;
-- List of entities used by transitivity
-- when Entity is itself Used.
-- We use the Save and Restore capabilities of the Table package
-- to obtain a per-entity list of Used_Entities.
Flags : Boolean_Flags;
-- Properties of entities:
--
-- Used : Boolean;
-- Set to True if Entity can't be eliminated.
--
-- Analyzed : Boolean;
-- Used to avoid loops in call-graph cycles
-- when doing transitive analysis.
Links : Static_Links;
-- Static links for various uses:
--
-- Instance : Entity_Id;
-- Since ASIS can't traverse generic-body expansions,
-- we need to denote a given instance of an entity
-- by using the Element in the template wrt to the right Instance.
-- An Instance is an Entity corresponding to A_Generic_Instantiation.
-- No_Entity is used for Entities that are not part of instance.
--
-- Scope : Entity_Id;
-- Scope containing the Entity.
--
-- Homonym : Entity_Id;
-- To keep track of overloaded subprograms.
--
-- Some links are also used for HTables.
end record;
-- Keeps information about a given entity.
-- Starting with 3.10, the generic package is Standard.Table.Table.
package Entity_Table is new Standard.Table.Table
(Table_Component_Type => Entity,
Table_Index_Type => Entity_Id,
Table_Low_Bound => No_Entity,
Table_Initial => 100,
Table_Increment => 50,
Table_Name => "Entity table");
-------------------------
-- Local subprograms --
-------------------------
function Entities_Used_By (Id : Entity_Id) return Entity_Id_List;
-- Returns all Entities used by Id Entity.
procedure Perform_Transitive_Closure (Id : Entity_Id);
-- ??? Documentation!!!
function Corresponding_Name_Definition
(Name : Asis.Element)
return Asis.Defining_Name;
-- ??? Documentation!!!
function Get_Name
(Entity : Entity_Id)
return Access_Wide_String;
-- ??? Documentation!!!
procedure Set_Name (Id : Entity_Id; Name : Access_Wide_String);
-- ??? Documentation!!!
procedure Set_Element (Id : Entity_Id; Element : Asis.Element);
-- ??? Documentation!!!
--------------------
-- Boolean_Flag --
--------------------
package body Boolean_Flag is
-- Keep track of the flag-slot that is allocated for this instance.
Flag_Used : constant Flag_Range := Nb_Allocated_Flags + 1;
procedure Set_Flag (Id : Entity_Id; Flag : Boolean) is
begin
pragma Assert (Id in Entity_Table.First .. Entity_Table.Last);
Entity_Table.Table (Id).Flags (Flag_Used) := Flag;
end Set_Flag;
function Get_Flag (Id : Entity_Id) return Boolean is
begin
pragma Assert (Id in Entity_Table.First .. Entity_Table.Last);
return Entity_Table.Table (Id).Flags (Flag_Used);
end Get_Flag;
begin
Nb_Allocated_Flags := Nb_Allocated_Flags + 1;
end Boolean_Flag;
-------------------
-- Static_Link --
-------------------
package body Static_Link is
-- Keep track of the link-slot that is allocated for this instance.
Link_Used : constant Link_Range := Nb_Allocated_Links + 1;
procedure Set_Link (Id : Entity_Id; Next : Entity_Id) is
begin
pragma Assert (Id in Entity_Table.First .. Entity_Table.Last);
Entity_Table.Table (Id).Links (Link_Used) := Next;
end Set_Link;
function Get_Link (Id : Entity_Id) return Entity_Id is
begin
pragma Assert (Id in Entity_Table.First .. Entity_Table.Last);
return Entity_Table.Table (Id).Links (Link_Used);
end Get_Link;
begin
Nb_Allocated_Links := Nb_Allocated_Links + 1;
end Static_Link;
-------------------
-- Set_Element --
-------------------
procedure Set_Element (Id : Entity_Id; Element : Asis.Element) is
begin
Entity_Table.Table (Id).Element := Element;
end Set_Element;
-------------------
-- Get_Element --
-------------------
function Get_Element (Entity : Entity_Id)
return Asis.Element
is
begin
return Entity_Table.Table (Entity).Element;
end Get_Element;
----------------
-- Set_Name --
----------------
procedure Set_Name (Id : Entity_Id; Name : Access_Wide_String) is
begin
Entity_Table.Table (Id).Name := Name;
end Set_Name;
----------------
-- Get_Name --
----------------
function Get_Name (Entity : Entity_Id)
return Access_Wide_String
is
begin
return Entity_Table.Table (Entity).Name;
end Get_Name;
----------------
-- Get_Name --
----------------
function Get_Name (Entity : Entity_Id)
return Wide_String
is
begin
return Get_Name (Entity).all;
end Get_Name;
--------------------
-- Mastery flag --
--------------------
package Mastery_Flag is new Boolean_Flag;
procedure Note_Mastery (Id : Entity_Id; Used : Boolean := True)
renames Mastery_Flag.Set_Flag;
function Is_A_Master (Entity : Entity_Id) return Boolean
renames Mastery_Flag.Get_Flag;
---------------------
-- Instance flag --
---------------------
package Instance_Flag is new Boolean_Flag;
procedure Note_Instance (Id : Entity_Id; Used : Boolean := True)
renames Instance_Flag.Set_Flag;
function Is_An_Instance (Entity : Entity_Id) return Boolean
renames Instance_Flag.Get_Flag;
-----------------
-- Used flag --
-----------------
package Used_Flag is new Boolean_Flag;
procedure Note_Use (Id : Entity_Id; Used : Boolean := True)
renames Used_Flag.Set_Flag;
function Is_Used (Entity : Entity_Id) return Boolean
renames Used_Flag.Get_Flag;
---------------------
-- Analyzed flag --
---------------------
package Analyzed_Flag is new Boolean_Flag;
procedure Note_Analysis (Id : Entity_Id; Used : Boolean := True)
renames Analyzed_Flag.Set_Flag;
function Is_Analyzed (Id : Entity_Id) return Boolean
renames Analyzed_Flag.Get_Flag;
---------------------
-- Instance link --
---------------------
package Instance_Link is new Static_Link;
procedure Set_Instance (Id : Entity_Id; Instance : Entity_Id)
renames Instance_Link.Set_Link;
function Get_Instance (Entity : Entity_Id) return Entity_Id
renames Instance_Link.Get_Link;
------------------
-- Scope link --
------------------
package Scope_Link is new Static_Link;
procedure Set_Scope (Id : Entity_Id; Scope : Entity_Id)
renames Scope_Link.Set_Link;
function Get_Scope (Entity : Entity_Id) return Entity_Id
renames Scope_Link.Get_Link;
--------------------
-- Homonym link --
--------------------
package Homonym_Link is new Static_Link;
procedure Set_Homonym (Id : Entity_Id; Homonym : Entity_Id)
renames Homonym_Link.Set_Link;
function Next_Homonym (Entity : Entity_Id) return Entity_Id
renames Homonym_Link.Get_Link;
function First_Homonym (Name : Wide_String;
Scope : Entity_Id)
return Entity_Id;
-- Returns the first Entity in Scope named Name.
--------------------------------
-- Hash Tables declarations --
--------------------------------
type Hash_Range1 is range 0 .. 2**16 - 1;
-- Used to index the Entity_Information in hash-tables.
-- A given Entity is uniquely denoted by an Element + an Instance.
type Key1 is record
Element : Asis.Element;
Instance : Entity_Id;
end record;
function Get_Key (Entity : Entity_Id) return Key1;
function Is_Equal (K1, K2 : Key1) return Boolean;
function Hash (K : Key1) return Hash_Range1;
package Link1 is new Static_Link;
package Entity_HTable1 is new GNAT.HTable.Static_HTable
(Header_Num => Hash_Range1,
Element => Entity,
Elmt_Ptr => Entity_Id,
Null_Ptr => No_Entity,
Set_Next => Link1.Set_Link,
Next => Link1.Get_Link,
Key => Key1,
Get_Key => Get_Key,
Hash => Hash,
Equal => Is_Equal);
type Hash_Range2 is range 0 .. 2**8 - 2;
-- Used to index the Entity_Information in hash-tables.
-- IMPORTANT: the range must not be wider than 255,
-- otherwise instances of GNAT.HTable.Hash do not work !
-- This is clearly an hidden requirement (fixed in 3.11)
-- A set of homonyms is uniquely denoted by a Name + a Scope.
type Key2 is record
Name : Access_Wide_String;
Scope : Entity_Id;
end record;
function Get_Key (Entity : Entity_Id) return Key2;
function Is_Equal (K1, K2 : Key2) return Boolean;
function Hash (K : Key2) return Hash_Range2;
package Link2 is new Static_Link;
package Entity_HTable2 is new GNAT.HTable.Static_HTable
(Header_Num => Hash_Range2,
Element => Entity,
Elmt_Ptr => Entity_Id,
Null_Ptr => No_Entity,
Set_Next => Link2.Set_Link,
Next => Link2.Get_Link,
Key => Key2,
Get_Key => Get_Key,
Hash => Hash,
Equal => Is_Equal);
---------------
-- Get_Key --
---------------
function Get_Key (Entity : Entity_Id) return Key1 is
begin
return Key1 '(Element => Get_Element (Entity),
Instance => Get_Instance (Entity));
end Get_Key;
----------------
-- Is_Equal --
----------------
function Is_Equal (K1, K2 : Key1) return Boolean is
begin
return K1.Instance = K2.Instance
and then Asis.Elements.Is_Identical (K1.Element, K2.Element);
end Is_Equal;
------------
-- Hash --
------------
function Hash (K : Key1) return Hash_Range1 is
function To_Unsigned_32 is new
Ada.Unchecked_Conversion
(Source => Asis.ASIS_Integer,
Target => Unsigned_32);
function To_ASIS_Integer is new
Ada.Unchecked_Conversion
(Source => Unsigned_32,
Target => Asis.ASIS_Integer);
ASIS_Hash : Asis.ASIS_Integer;
Unsigned_32_Hash : Unsigned_32;
begin
ASIS_Hash := Asis.Elements.Hash (K.Element);
Unsigned_32_Hash := To_Unsigned_32 (ASIS_Hash);
Unsigned_32_Hash := Unsigned_32_Hash xor
Rotate_Right (Unsigned_32_Hash, 16);
ASIS_Hash := To_ASIS_Integer (Unsigned_32_Hash);
return Hash_Range1 (ASIS_Hash mod Positive (Hash_Range1'Last
- Hash_Range1'First + 1)
+ Integer (Hash_Range1'First));
end Hash;
---------------
-- Get_Key --
---------------
function Get_Key (Entity : Entity_Id) return Key2 is
begin
return Key2 '(Name => Get_Name (Entity),
Scope => Get_Scope (Entity));
end Get_Key;
----------------
-- Is_Equal --
----------------
function Is_Equal (K1, K2 : Key2) return Boolean is
N1 : Wide_String := K1.Name.all;
N2 : Wide_String := K2.Name.all;
begin
return K1.Scope = K2.Scope
-- and then K1.Name.all = K2.Name.all;
and then N1 = N2;
end Is_Equal;
------------
-- Hash --
------------
function Hash is new GNAT.HTable.Hash (Hash_Range2);
-- A generic hashing function working on String keys.
-- Hash_Range2 must not be wider than 255 (GNAT.HTable bug) !
function Hash (K : Key2) return Hash_Range2 is
begin
return Hash (To_String (K.Name.all));
end Hash;
------------------------
-- Entities_Used_By --
------------------------
function Entities_Used_By (Id : Entity_Id) return Entity_Id_List is
begin
List_Of_Used_Entities.Restore (Entity_Table.Table (Id).Used_Entities);
declare
Results : Entity_Id_List := Entity_Id_List
(List_Of_Used_Entities.Table
(List_Of_Used_Entities.First .. List_Of_Used_Entities.Last));
begin
Entity_Table.Table (Id).Used_Entities := List_Of_Used_Entities.Save;
return Results;
end;
end Entities_Used_By;
----------------------------------
-- Perform_Transitive_Closure --
----------------------------------
procedure Perform_Transitive_Closure (Id : Entity_Id) is
begin
if not Is_Analyzed (Id) then
Note_Analysis (Id);
declare
Used_Entities : Entity_Id_List := Entities_Used_By (Id);
begin
for E in Used_Entities'Range loop
Note_Use (Used_Entities (E));
Perform_Transitive_Closure (Used_Entities (E));
end loop;
end;
-- Since we can't yet distinguish between homonyms,
-- we also mark all its homonyms as used.
declare
Homonym : Entity_Id := First_Homonym (Id);
begin
while Present (Homonym) loop
Note_Use (Homonym);
Perform_Transitive_Closure (Homonym);
Homonym := Next_Homonym (Homonym);
end loop;
end;
end if;
end Perform_Transitive_Closure;
-------------------------------------
-- Corresponding_Name_Definition --
-------------------------------------
function Corresponding_Name_Definition (Name : Asis.Element)
return Asis.Defining_Name
is
Tmp_Name : Asis.Expression;
Defining_Name : Asis.Defining_Name;
begin
case Element_Kind (Name) is
when An_Expression =>
Tmp_Name := Name;
Unwind_Selection :
loop
case Expression_Kind (Tmp_Name) is
when A_Selected_Component =>
Tmp_Name := Asis.Expressions.Selector (Tmp_Name);
when An_Identifier | An_Operator_Symbol =>
exit Unwind_Selection;
when others =>
return Asis.Nil_Element;
end case;
end loop Unwind_Selection;
begin
Defining_Name :=
Asis.Expressions.Corresponding_Name_Definition (Tmp_Name);
-- This query may return Nil_Element for reference
-- to implicit entities (eg. inherited/instance.)
-- It may also raise Asis_Inappropriate_Element,
-- if the Tmp_Name does not denote a declaration
-- as it happens for certain pragma arguments.
exception
when ASIS_Inappropriate_Element =>
Defining_Name := Nil_Element;
end;
if Is_Nil (Defining_Name) then
Warning ("Corresponding_Name_Definition not found !!!");
return Asis.Nil_Element;
elsif Is_Part_Of_Implicit (Defining_Name) then
return Asis.Nil_Element;
else
return Defining_Name;
end if;
when A_Defining_Name =>
return Name;
when others =>
return Asis.Nil_Element;
end case;
end Corresponding_Name_Definition;
----------
-- No --
----------
function No (Entity : Entity_Id) return Boolean is
begin
return Entity = No_Entity;
end No;
---------------
-- Present --
---------------
function Present (Entity : Entity_Id) return Boolean is
begin
return Entity /= No_Entity;
end Present;
------------------
-- New_Entity --
------------------
function New_Entity (Element : Asis.Element;
Instance : Entity_Id;
Name : Wide_String;
Scope : Entity_Id)
return Entity_Id is
Element_Declaration : Asis.Declaration;
New_Entity_Id : Entity_Id;
Homonym : Entity_Id;
begin
if Present (Entity_HTable1.Get (Key1 '(Element => Element,
Instance => Instance)))
then
raise Already_Registered;
end if;
if Element_Kind (Element) = A_Defining_Name then
Element_Declaration := Enclosing_Element (Element);
else
Element_Declaration := Asis.Nil_Element;
end if;
-- Register the entity in the entity table.
Entity_Table.Increment_Last;
New_Entity_Id := Entity_Table.Last;
List_Of_Used_Entities.Init;
Entity_Table.Table (New_Entity_Id).Used_Entities :=
List_Of_Used_Entities.Save;
Set_Element (New_Entity_Id, Element);
Set_Instance (New_Entity_Id, Instance);
Set_Scope (New_Entity_Id, Scope);
Link1.Set_Link (New_Entity_Id, No_Entity);
Link2.Set_Link (New_Entity_Id, No_Entity);
case Declaration_Kind (Element_Declaration) is
when A_Procedure_Declaration
| A_Procedure_Body_Declaration
| A_Procedure_Body_Stub
| A_Procedure_Instantiation
| A_Function_Declaration
| A_Function_Body_Declaration
| A_Function_Body_Stub
| A_Function_Instantiation
=>
Note_Mastery (New_Entity_Id, True);
when others =>
Note_Mastery (New_Entity_Id, False);
end case;
Note_Instance (New_Entity_Id,
Declaration_Kind (Element_Declaration)
in A_Generic_Instantiation);
Note_Use (New_Entity_Id, False);
Note_Analysis (New_Entity_Id, False);
-- Management of names for overloaded subprograms.
Homonym := First_Homonym (Name, Scope);
if No (Homonym) then
-- We allocate a new Wide_String for this name,
-- and register it in the homonym-hash-table.
Set_Name (New_Entity_Id, new Wide_String '(Name));
Set_Homonym (New_Entity_Id, No_Entity);
Entity_HTable2.Set (New_Entity_Id);
else
-- We reuse the same access string as for the first homonym,
-- and then hook the new entity to the homonym list.
if Name /= Get_Name (Homonym) then
Error ("gnatelim: pb with homonym management: "
& Name & "/=" & Get_Name (Homonym) & " .");
end if;
Set_Name (New_Entity_Id, Get_Name (Homonym));
Set_Homonym (New_Entity_Id, Next_Homonym (Homonym));
Set_Homonym (Homonym, New_Entity_Id);
end if;
-- Finally, register the new entity in the hash table.
Entity_HTable1.Set (New_Entity_Id);
return New_Entity_Id;
end New_Entity;
---------------------------------
-- Corresponding_Declaration --
---------------------------------
function Corresponding_Declaration (Entity : Entity_Id)
return Asis.Declaration is
Element : Asis.Element;
begin
Element := Get_Element (Entity);
if Element_Kind (Element) = A_Defining_Name then
return Enclosing_Element (Element);
else
return Asis.Nil_Element;
end if;
end Corresponding_Declaration;
---------------------
-- First_Homonym --
---------------------
function First_Homonym (Name : Wide_String;
Scope : Entity_Id)
return Entity_Id
is
New_Name : aliased Wide_String := Name;
begin
return Entity_HTable2.Get (Key2 '(Name => New_Name'Unchecked_Access,
Scope => Scope));
-- Unchecked access is safe since no reference is kept by Get.
end First_Homonym;
function First_Homonym (Entity : Entity_Id) return Entity_Id is
begin
return Entity_HTable2.Get (Key2 '(Name => Get_Name (Entity),
Scope => Get_Scope (Entity)));
end First_Homonym;
----------------------------
-- Corresponding_Entity --
----------------------------
function Corresponding_Entity (Element : Asis.Element;
Instance : Entity_Id)
return Entity_Id
is
Entity : Entity_Id;
begin
if Element_Kind (Element) = An_Expression then
return Corresponding_Entity
(Element =>
GNATELIM.Entities.Corresponding_Name_Definition (Element),
Instance => Instance);
elsif Element_Kind (Element) = A_Declaration then
if Is_Part_Of_Inherited (Element) then
-- We have an implicitly inherited subprogram declaration.
-- The only thing we can do with the current ASIS-for-GNAT
-- is to go back to the explicit declaration.
-- Anyway, getting the explicit is the right thing to do,
-- since there is no specific body in the object file
-- for inherited subprograms; they share the explicit body.
return Corresponding_Entity
(Element =>
Asis.Declarations.Corresponding_Declaration (Element),
Instance => Instance);
elsif Declaration_Kind (Element) in
A_Procedure_Instantiation .. A_Function_Instantiation
then
-- We have an instantiation of a subprogram declaration.
-- We must go to the instantiated declaration.
return Corresponding_Entity
(Element =>
Asis.Declarations.Corresponding_Declaration (Element),
Instance => Instance);
else
-- Asis.Declarations.Names fails on inherited declarations.
return Corresponding_Entity (
Element => Asis.Declarations.Names (Element) (1),
Instance => Instance);
end if;
elsif Element_Kind (Element) /= A_Defining_Name then
-- There's nothing we can do.
return No_Entity;
-- From now on, we can safely assume we have A_Defining_Name.
elsif Is_Part_Of_Inherited (Element) then
-- We have an implicitly inherited subprogram defining_name.
-- Let's go back to the explicit declaration.
-- Going back to explicit is only possible on _declarations_
-- not on defining_names. Enclosing_Element must be used.
return Corresponding_Entity
(Element => Asis.Declarations.Corresponding_Declaration
(Enclosing_Element (Element)),
Instance => Instance);
else
-- Here we have an explicit (ie. traversable) defining name,
-- with the corresponding enclosing instance.
Entity := Entity_HTable1.Get (Key1 '(Element => Element,
Instance => Instance));
if Present (Entity) then
-- The Entity is in the current scope.
return Entity;
elsif No (Instance) then
-- The Entity was not found in the current Instance,
-- and the current Instance is not part of instance.
-- Nothing else can be done.
return No_Entity;
else
-- The Entity is not defined in the current Instance.
-- Let's look in the instance containing the template.
declare
-- Here we rely on the Template being the first
-- entity used by the instance.
-- This is dirty: to be encapsulated.
Used_By_Instance : Entity_Id_List :=
Entities_Used_By (Instance);
Template : Entity_Id;
begin
if Used_By_Instance'Length > 0 then
Template := Used_By_Instance (Used_By_Instance'First);
return Corresponding_Entity
(Element => Element,
Instance => Get_Instance (Template));
else
return No_Entity;
end if;
end;
end if;
end if;
end Corresponding_Entity;
----------------------
-- Renamed_Entity --
----------------------
function Renamed_Entity (Renaming : Entity_Id) return Entity_Id is
begin
return Corresponding_Entity
(Element => Asis.Declarations.Renamed_Entity
(Corresponding_Declaration (Renaming)),
Instance => Get_Instance (Renaming));
end Renamed_Entity;
------------------------
-- Unwind_Renamings --
------------------------
function Unwind_Renamings (Entity : Entity_Id) return Entity_Id is
Renamed : Entity_Id := Entity;
begin
while Declaration_Kind (Corresponding_Declaration (Renamed))
in A_Renaming_Declaration
loop
Renamed := Renamed_Entity (Renamed);
end loop;
return Renamed;
end Unwind_Renamings;
----------------
-- Note_Use --
----------------
procedure Note_Use (Entity : Entity_Id;
Used_By : Entity_Id) is
begin
if No (Entity) then
-- A No_Entity. Ignored. (???)
null;
elsif No (Used_By) then
-- Either we could not determine the Master,
-- or we want to force an inconditional use.
-- In both case, we mark the Entity as used.
Note_Use (Entity);
else
pragma Assert (Used_By in Entity_Table.First .. Entity_Table.Last);
List_Of_Used_Entities.Restore
(Entity_Table.Table (Used_By).Used_Entities);
List_Of_Used_Entities.Increment_Last;
List_Of_Used_Entities.Table (List_Of_Used_Entities.Last) := Entity;
Entity_Table.Table (Used_By).Used_Entities :=
List_Of_Used_Entities.Save;
end if;
end Note_Use;
----------------------------------
-- Perform_Transitive_Closure --
----------------------------------
procedure Perform_Transitive_Closure is
begin
for Id in Entity_Table.First .. Entity_Table.Last loop
if Is_Used (Id) then
Perform_Transitive_Closure (Id);
end if;
end loop;
end Perform_Transitive_Closure;
---------------
-- Iterate --
---------------
procedure Iterate is
Continue : Boolean := True;
begin
for Id in Entity_Id range Entity_Table.First .. Entity_Table.Last loop
Action (Id, Continue);
exit when not Continue;
end loop;
end Iterate;
begin
-- Register the No_Entity in the entity table.
Entity_Table.Increment_Last;
List_Of_Used_Entities.Init;
Entity_Table.Table (No_Entity).Used_Entities :=
List_Of_Used_Entities.Save;
Set_Element (No_Entity, Asis.Nil_Element);
Set_Instance (No_Entity, No_Entity);
Set_Scope (No_Entity, No_Entity);
Set_Name (No_Entity, new Wide_String '(""));
Set_Homonym (No_Entity, No_Entity);
Link1.Set_Link (No_Entity, No_Entity);
Link2.Set_Link (No_Entity, No_Entity);
Note_Mastery (No_Entity, True); -- Environment task.
Note_Instance (No_Entity, True);
Note_Use (No_Entity, False);
Note_Analysis (No_Entity, False);
Entity_HTable1.Reset;
Entity_HTable2.Reset;
-- VERY important when actual for Elmt_Ptr is not an access type !
end GNATELIM.Entities;
syntax highlighted by Code2HTML, v. 0.9.1