Commit 980f94b7 by Hristian Kirtchev Committed by Pierre-Marie de Rodat

[Ada] New ignored Ghost code removal mechanism

This patch reimplements the mechanism which removes ignored Ghost code from the
tree.

The previous mechanism proved to be unreliable because it assumed that no new
scoping constructs would be created after some ignored Ghost code had already
notified its enclosing scoping constructs that they contain such code. The
assumption can be broken by having a call to an ignored Ghost procedure within
the extended return statement of a function. The procedure call would signal
the enclosing function that it contains ignored Ghost code, however the return
statement would introduce an extra block, effectively hiding the procedure call
from the ignored Ghost code elimination pass.

The new mechanism implemented in this patch forgoes directed tree pruning in
favor of storing the actual ignored Ghost code, and later directly eliminating
it from the tree.

For this approach to operate efficiently, only "top level" ignored Ghost
constructs are stored. The top level constructs are essentially nodes which can
appear within a declarative or statement list and be safely rewritten into null
statements. This ensures that only "root" ignored Ghost construct need to be
processed, as opposed to all ignored Ghost nodes within a subtree.

The approach has one drawback however. Due to the generation and analysis of
ignored Ghost code, a construct may be recorded multiple times (usually twice).
The mechanism simply deals with this artefact instead of employing expensive
solutions such as hash tables or a common flag shared by all nodes to eliminate
the duplicates.

------------
-- Source --
------------

--  main.adb

with Ada.Text_IO; use Ada.Text_IO;

procedure Main is
   procedure Ghost_Proc with Ghost;
   procedure Ghost_Proc is
   begin
      Put_Line ("ERROR: Ghost_Proc called");
   end Ghost_Proc;

   function Func return Integer is
   begin
      return Res : Integer := 123 do
         Ghost_Proc;
      end return;
   end Func;

   Val : Integer with Ghost;

begin
   Val := Func;
end Main;

----------------------------
-- Compilation and output --
----------------------------

$ gcc -c -gnatDG main.adb
$ grep -c "ghost" main.adb.dg
0

2018-07-17  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* alloc.ads: Update the allocation metrics of the ignored Ghost nodes
	table.
	* atree.adb: Add a soft link for a procedure which is invoked whenever
	an ignored Ghost node or entity is created.
	(Change_Node): Preserve relevant attributes which come from the Flags
	table.
	(Mark_New_Ghost_Node): Record a newly created ignored Ghost node or
	entity.
	(Rewrite): Preserve relevant attributes which come from the Flags
	table.
	(Set_Ignored_Ghost_Recording_Proc): New routine.
	* atree.ads: Define an access-to-suprogram type for a soft link which
	records a newly created ignored Ghost node or entity.
	(Set_Ignored_Ghost_Recording_Proc): New routine.
	* ghost.adb: Remove with and use clause for Lib.  Remove table
	Ignored_Ghost_Units.  Add new table Ignored_Ghost_Nodes.
	(Add_Ignored_Ghost_Unit): Removed.
	(Initialize): Initialize the table which stores ignored Ghost nodes.
	Set the soft link which allows Atree.Mark_New_Ghost_Node to record an
	ignored Ghost node.
	(Is_Ignored_Ghost_Unit): Use the ultimate original node when checking
	an eliminated ignored Ghost unit.
	(Lock): Release and lock the table which stores ignored Ghost nodes.
	(Mark_And_Set_Ghost_Assignment): Record rather than propagate ignored
	Ghost nodes.
	(Mark_And_Set_Ghost_Procedure_Call): Record rather than propagate
	ignored Ghost nodes.
	(Mark_Ghost_Clause): Record rather than propagate ignored Ghost nodes.
	(Mark_Ghost_Declaration_Or_Body): Record rather than propagate ignored
	Ghost nodes.
	(Mark_Ghost_Pragma): Record rather than propagate ignored Ghost nodes.
	(Propagate_Ignored_Ghost_Code): Removed.
	(Record_Ignored_Ghost_Node): New routine.
	(Remove_Ignored_Ghost_Code): Reimplemented.
	(Remove_Ignored_Ghost_Node): New routine.
	(Ultimate_Original_Node): New routine.
	* ghost.ads (Check_Ghost_Completion): Removed.
	* sem_ch8.adb (Analyze_Use_Package): Remove obsolete code. Mark a use
	package clause as ignored Ghost if applicable.
	* sem_util.adb (Is_Body_Or_Package_Declaration): Reimplemented.

From-SVN: r262775
parent e8427749
2018-07-17 Hristian Kirtchev <kirtchev@adacore.com>
* alloc.ads: Update the allocation metrics of the ignored Ghost nodes
table.
* atree.adb: Add a soft link for a procedure which is invoked whenever
an ignored Ghost node or entity is created.
(Change_Node): Preserve relevant attributes which come from the Flags
table.
(Mark_New_Ghost_Node): Record a newly created ignored Ghost node or
entity.
(Rewrite): Preserve relevant attributes which come from the Flags
table.
(Set_Ignored_Ghost_Recording_Proc): New routine.
* atree.ads: Define an access-to-suprogram type for a soft link which
records a newly created ignored Ghost node or entity.
(Set_Ignored_Ghost_Recording_Proc): New routine.
* ghost.adb: Remove with and use clause for Lib. Remove table
Ignored_Ghost_Units. Add new table Ignored_Ghost_Nodes.
(Add_Ignored_Ghost_Unit): Removed.
(Initialize): Initialize the table which stores ignored Ghost nodes.
Set the soft link which allows Atree.Mark_New_Ghost_Node to record an
ignored Ghost node.
(Is_Ignored_Ghost_Unit): Use the ultimate original node when checking
an eliminated ignored Ghost unit.
(Lock): Release and lock the table which stores ignored Ghost nodes.
(Mark_And_Set_Ghost_Assignment): Record rather than propagate ignored
Ghost nodes.
(Mark_And_Set_Ghost_Procedure_Call): Record rather than propagate
ignored Ghost nodes.
(Mark_Ghost_Clause): Record rather than propagate ignored Ghost nodes.
(Mark_Ghost_Declaration_Or_Body): Record rather than propagate ignored
Ghost nodes.
(Mark_Ghost_Pragma): Record rather than propagate ignored Ghost nodes.
(Propagate_Ignored_Ghost_Code): Removed.
(Record_Ignored_Ghost_Node): New routine.
(Remove_Ignored_Ghost_Code): Reimplemented.
(Remove_Ignored_Ghost_Node): New routine.
(Ultimate_Original_Node): New routine.
* ghost.ads (Check_Ghost_Completion): Removed.
* sem_ch8.adb (Analyze_Use_Package): Remove obsolete code. Mark a use
package clause as ignored Ghost if applicable.
* sem_util.adb (Is_Body_Or_Package_Declaration): Reimplemented.
2018-07-17 Javier Miranda <miranda@adacore.com>
* sem_ch5.adb (Has_Call_Using_Secondary_Stack): Moved to library level
......
......@@ -67,8 +67,8 @@ package Alloc is
In_Out_Warnings_Initial : constant := 100; -- Sem_Warn
In_Out_Warnings_Increment : constant := 100;
Ignored_Ghost_Units_Initial : constant := 20; -- Sem_Util
Ignored_Ghost_Units_Increment : constant := 50;
Ignored_Ghost_Nodes_Initial : constant := 100; -- Ghost
Ignored_Ghost_Nodes_Increment : constant := 100;
Inlined_Initial : constant := 100; -- Inline
Inlined_Increment : constant := 100;
......
......@@ -48,6 +48,10 @@ with GNAT.Heap_Sort_G;
package body Atree is
Ignored_Ghost_Recording_Proc : Ignored_Ghost_Record_Proc := null;
-- This soft link captures the procedure invoked during the creation of an
-- ignored Ghost node or entity.
Locked : Boolean := False;
-- Compiling with assertions enabled, node contents modifications are
-- permitted only when this switch is set to False; compiling without
......@@ -683,11 +687,20 @@ package body Atree is
-----------------
procedure Change_Node (N : Node_Id; New_Node_Kind : Node_Kind) is
Save_Sloc : constant Source_Ptr := Sloc (N);
-- Flags table attributes
Save_CA : constant Boolean := Flags.Table (N).Check_Actuals;
Save_Is_IGN : constant Boolean := Flags.Table (N).Is_Ignored_Ghost_Node;
-- Nodes table attributes
Save_CFS : constant Boolean := Nodes.Table (N).Comes_From_Source;
Save_In_List : constant Boolean := Nodes.Table (N).In_List;
Save_Link : constant Union_Id := Nodes.Table (N).Link;
Save_CFS : constant Boolean := Nodes.Table (N).Comes_From_Source;
Save_Posted : constant Boolean := Nodes.Table (N).Error_Posted;
Save_Sloc : constant Source_Ptr := Sloc (N);
Par_Count : Nat := 0;
begin
......@@ -704,6 +717,8 @@ package body Atree is
Nodes.Table (N).Error_Posted := Save_Posted;
Flags.Table (N) := Default_Flags;
Flags.Table (N).Check_Actuals := Save_CA;
Flags.Table (N).Is_Ignored_Ghost_Node := Save_Is_IGN;
if New_Node_Kind in N_Subexpr then
Set_Paren_Count (N, Par_Count);
......@@ -1606,6 +1621,13 @@ package body Atree is
end if;
Set_Is_Ignored_Ghost_Node (N);
-- Record the ignored Ghost node or entity in order to eliminate it
-- from the tree later.
if Ignored_Ghost_Recording_Proc /= null then
Ignored_Ghost_Recording_Proc.all (N);
end if;
end if;
end Mark_New_Ghost_Node;
......@@ -1629,8 +1651,8 @@ package body Atree is
if Source > Empty_Or_Error then
New_Id := Allocate_Initialize_Node (Source, Has_Extension (Source));
Nodes.Table (New_Id).Link := Empty_List_Or_Node;
Nodes.Table (New_Id).In_List := False;
Nodes.Table (New_Id).Link := Empty_List_Or_Node;
-- If the original is marked as a rewrite insertion, then unmark the
-- copy, since we inserted the original, not the copy.
......@@ -2218,16 +2240,24 @@ package body Atree is
-------------
procedure Rewrite (Old_Node, New_Node : Node_Id) is
Old_Error_P : constant Boolean := Nodes.Table (Old_Node).Error_Posted;
-- This field is always preserved in the new node
Old_Has_Aspects : constant Boolean := Nodes.Table (Old_Node).Has_Aspects;
-- This field is always preserved in the new node
-- Flags table attributes
Old_CA : constant Boolean := Flags.Table (Old_Node).Check_Actuals;
Old_Is_IGN : constant Boolean :=
Flags.Table (Old_Node).Is_Ignored_Ghost_Node;
-- Nodes table attributes
Old_Error_Posted : constant Boolean :=
Nodes.Table (Old_Node).Error_Posted;
Old_Has_Aspects : constant Boolean :=
Nodes.Table (Old_Node).Has_Aspects;
Old_Paren_Count : Nat;
Old_Must_Not_Freeze : Boolean;
-- These fields are preserved in the new node only if the new node
-- and the old node are both subexpression nodes.
Old_Paren_Count : Nat;
-- These fields are preserved in the new node only if the new node and
-- the old node are both subexpression nodes.
-- Note: it is a violation of abstraction levels for Must_Not_Freeze
-- to be referenced like this. ???
......@@ -2244,11 +2274,11 @@ package body Atree is
pragma Debug (New_Node_Debugging_Output (New_Node));
if Nkind (Old_Node) in N_Subexpr then
Old_Paren_Count := Paren_Count (Old_Node);
Old_Must_Not_Freeze := Must_Not_Freeze (Old_Node);
Old_Paren_Count := Paren_Count (Old_Node);
else
Old_Paren_Count := 0;
Old_Must_Not_Freeze := False;
Old_Paren_Count := 0;
end if;
-- Allocate a new node, to be used to preserve the original contents
......@@ -2274,9 +2304,12 @@ package body Atree is
-- Copy substitute node into place, preserving old fields as required
Copy_Node (Source => New_Node, Destination => Old_Node);
Nodes.Table (Old_Node).Error_Posted := Old_Error_P;
Nodes.Table (Old_Node).Error_Posted := Old_Error_Posted;
Nodes.Table (Old_Node).Has_Aspects := Old_Has_Aspects;
Flags.Table (Old_Node).Check_Actuals := Old_CA;
Flags.Table (Old_Node).Is_Ignored_Ghost_Node := Old_Is_IGN;
if Nkind (New_Node) in N_Subexpr then
Set_Paren_Count (Old_Node, Old_Paren_Count);
Set_Must_Not_Freeze (Old_Node, Old_Must_Not_Freeze);
......@@ -2369,6 +2402,18 @@ package body Atree is
Nodes.Table (N).Has_Aspects := Val;
end Set_Has_Aspects;
--------------------------------------
-- Set_Ignored_Ghost_Recording_Proc --
--------------------------------------
procedure Set_Ignored_Ghost_Recording_Proc
(Proc : Ignored_Ghost_Record_Proc)
is
begin
pragma Assert (Ignored_Ghost_Recording_Proc = null);
Ignored_Ghost_Recording_Proc := Proc;
end Set_Ignored_Ghost_Recording_Proc;
-------------------------------
-- Set_Is_Ignored_Ghost_Node --
-------------------------------
......
......@@ -570,6 +570,13 @@ package Atree is
-- are appropriately updated. This function is used only by Sinfo.CN to
-- change nodes into their corresponding entities.
type Ignored_Ghost_Record_Proc is access procedure (N : Node_Or_Entity_Id);
procedure Set_Ignored_Ghost_Recording_Proc
(Proc : Ignored_Ghost_Record_Proc);
-- Register a procedure that is invoked when an ignored Ghost node or
-- entity is created.
type Report_Proc is access procedure (Target : Node_Id; Source : Node_Id);
procedure Set_Reporting_Proc (Proc : Report_Proc);
......
......@@ -29,7 +29,6 @@ with Atree; use Atree;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
with Lib; use Lib;
with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
......@@ -50,18 +49,16 @@ package body Ghost is
-- Data strictures --
---------------------
-- The following table contains the N_Compilation_Unit node for a unit that
-- is either subject to pragma Ghost with policy Ignore or contains ignored
-- Ghost code. The table is used in the removal of ignored Ghost code from
-- units.
-- The following table contains all ignored Ghost nodes that must be
-- eliminated from the tree by routine Remove_Ignored_Ghost_Code.
package Ignored_Ghost_Units is new Table.Table (
package Ignored_Ghost_Nodes is new Table.Table (
Table_Component_Type => Node_Id,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => Alloc.Ignored_Ghost_Units_Initial,
Table_Increment => Alloc.Ignored_Ghost_Units_Increment,
Table_Name => "Ignored_Ghost_Units");
Table_Initial => Alloc.Ignored_Ghost_Nodes_Initial,
Table_Increment => Alloc.Ignored_Ghost_Nodes_Increment,
Table_Name => "Ignored_Ghost_Nodes");
-----------------------
-- Local subprograms --
......@@ -98,37 +95,9 @@ package body Ghost is
-- Convert a Ghost mode denoted by name Mode into its respective enumerated
-- value.
procedure Propagate_Ignored_Ghost_Code (N : Node_Id);
-- Signal all enclosing scopes that they now contain at least one ignored
-- Ghost node denoted by N. Add the compilation unit containing N to table
-- Ignored_Ghost_Units for post processing.
----------------------------
-- Add_Ignored_Ghost_Unit --
----------------------------
procedure Add_Ignored_Ghost_Unit (Unit : Node_Id) is
begin
pragma Assert (Nkind (Unit) = N_Compilation_Unit);
-- Avoid duplicates in the table as pruning the same unit more than once
-- is wasteful. Since ignored Ghost code tends to be grouped up, check
-- the contents of the table in reverse.
for Index in reverse Ignored_Ghost_Units.First ..
Ignored_Ghost_Units.Last
loop
-- If the unit is already present in the table, do not add it again
if Unit = Ignored_Ghost_Units.Table (Index) then
return;
end if;
end loop;
-- If we get here, then this is the first time the unit is being added
Ignored_Ghost_Units.Append (Unit);
end Add_Ignored_Ghost_Unit;
procedure Record_Ignored_Ghost_Node (N : Node_Or_Entity_Id);
-- Save ignored Ghost node or entity N in table Ignored_Ghost_Nodes for
-- later elimination.
----------------------------
-- Check_Ghost_Completion --
......@@ -913,7 +882,12 @@ package body Ghost is
procedure Initialize is
begin
Ignored_Ghost_Units.Init;
Ignored_Ghost_Nodes.Init;
-- Set the soft link which enables Atree.Mark_New_Ghost_Node to record
-- an ignored Ghost node or entity.
Set_Ignored_Ghost_Recording_Proc (Record_Ignored_Ghost_Node'Access);
end Initialize;
------------------------
......@@ -1030,6 +1004,28 @@ package body Ghost is
---------------------------
function Is_Ignored_Ghost_Unit (N : Node_Id) return Boolean is
function Ultimate_Original_Node (Nod : Node_Id) return Node_Id;
-- Obtain the original node of arbitrary node Nod following a potential
-- chain of rewritings.
----------------------------
-- Ultimate_Original_Node --
----------------------------
function Ultimate_Original_Node (Nod : Node_Id) return Node_Id is
Res : Node_Id;
begin
Res := Nod;
while Original_Node (Res) /= Res loop
Res := Original_Node (Res);
end loop;
return Res;
end Ultimate_Original_Node;
-- Start of processing for Is_Ignored_Ghost_Unit
begin
-- Inspect the original node of the unit in case removal of ignored
-- Ghost code has already taken place.
......@@ -1037,7 +1033,7 @@ package body Ghost is
return
Nkind (N) = N_Compilation_Unit
and then Is_Ignored_Ghost_Entity
(Defining_Entity (Original_Node (Unit (N))));
(Defining_Entity (Ultimate_Original_Node (Unit (N))));
end Is_Ignored_Ghost_Unit;
-------------------------
......@@ -1176,8 +1172,8 @@ package body Ghost is
procedure Lock is
begin
Ignored_Ghost_Units.Release;
Ignored_Ghost_Units.Locked := True;
Ignored_Ghost_Nodes.Release;
Ignored_Ghost_Nodes.Locked := True;
end Lock;
-----------------------------------
......@@ -1201,7 +1197,7 @@ package body Ghost is
Install_Ghost_Region (Ignore, N);
Set_Is_Ignored_Ghost_Node (N);
Propagate_Ignored_Ghost_Code (N);
Record_Ignored_Ghost_Node (N);
end if;
end if;
end Mark_And_Set_Ghost_Assignment;
......@@ -1472,11 +1468,39 @@ package body Ghost is
Install_Ghost_Region (Ignore, N);
Set_Is_Ignored_Ghost_Node (N);
Propagate_Ignored_Ghost_Code (N);
Record_Ignored_Ghost_Node (N);
end if;
end if;
end Mark_And_Set_Ghost_Procedure_Call;
-----------------------
-- Mark_Ghost_Clause --
-----------------------
procedure Mark_Ghost_Clause (N : Node_Id) is
Nam : Node_Id := Empty;
begin
if Nkind (N) = N_Use_Package_Clause then
Nam := Name (N);
elsif Nkind (N) = N_Use_Type_Clause then
Nam := Subtype_Mark (N);
elsif Nkind (N) = N_With_Clause then
Nam := Name (N);
end if;
if Present (Nam)
and then Is_Entity_Name (Nam)
and then Present (Entity (Nam))
and then Is_Ignored_Ghost_Entity (Entity (Nam))
then
Set_Is_Ignored_Ghost_Node (N);
Record_Ignored_Ghost_Node (N);
end if;
end Mark_Ghost_Clause;
------------------------------------
-- Mark_Ghost_Declaration_Or_Body --
------------------------------------
......@@ -1502,7 +1526,7 @@ package body Ghost is
Mark_Formals := True;
Set_Is_Ignored_Ghost_Entity (Id);
Set_Is_Ignored_Ghost_Node (N);
Propagate_Ignored_Ghost_Code (N);
Record_Ignored_Ghost_Node (N);
end if;
-- Mark all formal parameters when the related node denotes a subprogram
......@@ -1538,34 +1562,6 @@ package body Ghost is
end Mark_Ghost_Declaration_Or_Body;
-----------------------
-- Mark_Ghost_Clause --
-----------------------
procedure Mark_Ghost_Clause (N : Node_Id) is
Nam : Node_Id := Empty;
begin
if Nkind (N) = N_Use_Package_Clause then
Nam := Name (N);
elsif Nkind (N) = N_Use_Type_Clause then
Nam := Subtype_Mark (N);
elsif Nkind (N) = N_With_Clause then
Nam := Name (N);
end if;
if Present (Nam)
and then Is_Entity_Name (Nam)
and then Present (Entity (Nam))
and then Is_Ignored_Ghost_Entity (Entity (Nam))
then
Set_Is_Ignored_Ghost_Node (N);
Propagate_Ignored_Ghost_Code (N);
end if;
end Mark_Ghost_Clause;
-----------------------
-- Mark_Ghost_Pragma --
-----------------------
......@@ -1583,7 +1579,7 @@ package body Ghost is
elsif Is_Ignored_Ghost_Entity (Id) then
Set_Is_Ignored_Ghost_Pragma (N);
Set_Is_Ignored_Ghost_Node (N);
Propagate_Ignored_Ghost_Code (N);
Record_Ignored_Ghost_Node (N);
end if;
end Mark_Ghost_Pragma;
......@@ -1635,168 +1631,90 @@ package body Ghost is
end if;
end Name_To_Ghost_Mode;
----------------------------------
-- Propagate_Ignored_Ghost_Code --
----------------------------------
procedure Propagate_Ignored_Ghost_Code (N : Node_Id) is
Nod : Node_Id;
Scop : Entity_Id;
-------------------------------
-- Record_Ignored_Ghost_Node --
-------------------------------
procedure Record_Ignored_Ghost_Node (N : Node_Or_Entity_Id) is
begin
-- Traverse the parent chain looking for blocks, packages, and
-- subprograms or their respective bodies.
Nod := Parent (N);
while Present (Nod) loop
Scop := Empty;
if Nkind (Nod) = N_Block_Statement
and then Present (Identifier (Nod))
-- Save all "top level" ignored Ghost nodes which can be safely replaced
-- with a null statement. Note that there is need to save other kinds of
-- nodes because those will always be enclosed by some top level ignored
-- Ghost node.
if Is_Body (N)
or else Is_Declaration (N)
or else Nkind (N) in N_Generic_Instantiation
or else Nkind (N) in N_Push_Pop_xxx_Label
or else Nkind (N) in N_Raise_xxx_Error
or else Nkind (N) in N_Representation_Clause
or else Nkind_In (N, N_Assignment_Statement,
N_Call_Marker,
N_Freeze_Entity,
N_Freeze_Generic_Entity,
N_Itype_Reference,
N_Pragma,
N_Procedure_Call_Statement,
N_Use_Package_Clause,
N_Use_Type_Clause,
N_Variable_Reference_Marker,
N_With_Clause)
then
Scop := Entity (Identifier (Nod));
-- Only ignored Ghost nodes must be recorded in the table
elsif Nkind_In (Nod, N_Package_Body,
N_Package_Declaration,
N_Subprogram_Body,
N_Subprogram_Declaration)
then
Scop := Defining_Entity (Nod);
pragma Assert (Is_Ignored_Ghost_Node (N));
Ignored_Ghost_Nodes.Append (N);
end if;
-- The current node denotes a scoping construct
if Present (Scop) then
-- Stop the traversal when the scope already contains ignored
-- Ghost code as all enclosing scopes have already been marked.
if Contains_Ignored_Ghost_Code (Scop) then
exit;
-- Otherwise mark this scope and keep climbing
else
Set_Contains_Ignored_Ghost_Code (Scop);
end if;
end if;
Nod := Parent (Nod);
end loop;
-- The unit containing the ignored Ghost code must be post processed
-- before invoking the back end.
Add_Ignored_Ghost_Unit (Cunit (Get_Code_Unit (N)));
end Propagate_Ignored_Ghost_Code;
end Record_Ignored_Ghost_Node;
-------------------------------
-- Remove_Ignored_Ghost_Code --
-------------------------------
procedure Remove_Ignored_Ghost_Code is
procedure Prune_Tree (Root : Node_Id);
-- Remove all code marked as ignored Ghost from the tree of denoted by
-- Root.
----------------
-- Prune_Tree --
----------------
procedure Prune_Tree (Root : Node_Id) is
procedure Prune (N : Node_Id);
-- Remove a given node from the tree by rewriting it into null
procedure Remove_Ignored_Ghost_Node (N : Node_Id);
-- Eliminate ignored Ghost node N from the tree
function Prune_Node (N : Node_Id) return Traverse_Result;
-- Determine whether node N denotes an ignored Ghost construct. If
-- this is the case, rewrite N as a null statement. See the body for
-- special cases.
-----------
-- Prune --
-----------
procedure Prune (N : Node_Id) is
begin
-- Destroy any aspects that may be associated with the node
if Permits_Aspect_Specifications (N) and then Has_Aspects (N) then
Remove_Aspects (N);
end if;
Rewrite (N, Make_Null_Statement (Sloc (N)));
end Prune;
----------------
-- Prune_Node --
----------------
function Prune_Node (N : Node_Id) return Traverse_Result is
Id : Entity_Id;
-------------------------------
-- Remove_Ignored_Ghost_Node --
-------------------------------
procedure Remove_Ignored_Ghost_Node (N : Node_Id) is
begin
-- Do not prune compilation unit nodes because many mechanisms
-- depend on their presence. Note that context items are still
-- being processed.
if Nkind (N) = N_Compilation_Unit then
return OK;
-- The node is either declared as ignored Ghost or is a byproduct
-- of expansion. Destroy it and stop the traversal on this branch.
elsif Is_Ignored_Ghost_Node (N) then
Prune (N);
return Skip;
-- The generation and processing of ignored Ghost nodes may cause the
-- same node to be saved multiple times. Reducing the number of saves
-- to one involves costly solutions such as a hash table or the use
-- of a flag shared by all nodes. To solve this problem, the removal
-- machinery allows for multiple saves, but does not eliminate a node
-- which has already been eliminated.
if Nkind (N) = N_Null_Statement then
null;
-- Scoping constructs such as blocks, packages, subprograms and
-- bodies offer some flexibility with respect to pruning.
-- Otherwise the ignored Ghost node must be eliminated
elsif Nkind_In (N, N_Block_Statement,
N_Package_Body,
N_Package_Declaration,
N_Subprogram_Body,
N_Subprogram_Declaration)
then
if Nkind (N) = N_Block_Statement then
Id := Entity (Identifier (N));
else
Id := Defining_Entity (N);
end if;
-- Only ignored Ghost nodes must be eliminated from the tree
-- The scoping construct contains both living and ignored Ghost
-- code, let the traversal prune all relevant nodes.
pragma Assert (Is_Ignored_Ghost_Node (N));
if Contains_Ignored_Ghost_Code (Id) then
return OK;
-- Eliminate the node by rewriting it into null. Another option
-- is to remove it from the tree, however multiple corner cases
-- emerge which have be dealt individually.
-- Otherwise the construct contains only living code and should
-- not be pruned.
else
return Skip;
end if;
Rewrite (N, Make_Null_Statement (Sloc (N)));
-- Otherwise keep searching for ignored Ghost nodes
-- Eliminate any aspects hanging off the ignored Ghost node
else
return OK;
Remove_Aspects (N);
end if;
end Prune_Node;
procedure Prune_Nodes is new Traverse_Proc (Prune_Node);
-- Start of processing for Prune_Tree
begin
Prune_Nodes (Root);
end Prune_Tree;
end Remove_Ignored_Ghost_Node;
-- Start of processing for Remove_Ignored_Ghost_Code
begin
for Index in Ignored_Ghost_Units.First .. Ignored_Ghost_Units.Last loop
Prune_Tree (Ignored_Ghost_Units.Table (Index));
for Index in Ignored_Ghost_Nodes.First .. Ignored_Ghost_Nodes.Last loop
Remove_Ignored_Ghost_Node (Ignored_Ghost_Nodes.Table (Index));
end loop;
end Remove_Ignored_Ghost_Code;
......
......@@ -31,10 +31,6 @@ with Types; use Types;
package Ghost is
procedure Add_Ignored_Ghost_Unit (Unit : Node_Id);
-- Add a single ignored Ghost compilation unit to the internal table for
-- post processing.
procedure Check_Ghost_Completion
(Prev_Id : Entity_Id;
Compl_Id : Entity_Id);
......
......@@ -3782,8 +3782,6 @@ package body Sem_Ch8 is
-- Local variables
Ghost_Id : Entity_Id := Empty;
Living_Id : Entity_Id := Empty;
Pack : Entity_Id;
-- Start of processing for Analyze_Use_Package
......@@ -3870,22 +3868,9 @@ package body Sem_Ch8 is
end if;
Use_One_Package (N, Name (N));
-- Capture the first Ghost package and the first living package
if Is_Entity_Name (Name (N)) then
Pack := Entity (Name (N));
if Is_Ghost_Entity (Pack) then
if No (Ghost_Id) then
Ghost_Id := Pack;
end if;
elsif No (Living_Id) then
Living_Id := Pack;
end if;
end if;
end if;
Mark_Ghost_Clause (N);
end Analyze_Use_Package;
----------------------
......
......@@ -13401,12 +13401,7 @@ package body Sem_Util is
function Is_Body_Or_Package_Declaration (N : Node_Id) return Boolean is
begin
return Nkind_In (N, N_Entry_Body,
N_Package_Body,
N_Package_Declaration,
N_Protected_Body,
N_Subprogram_Body,
N_Task_Body);
return Is_Body (N) or else Nkind (N) = N_Package_Declaration;
end Is_Body_Or_Package_Declaration;
-----------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment