This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] New ignored Ghost code removal mechanism
- From: Pierre-Marie de Rodat <derodat at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Cc: Hristian Kirtchev <kirtchev at adacore dot com>
- Date: Tue, 17 Jul 2018 04:22:28 -0400
- Subject: [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
Tested on x86_64-pc-linux-gnu, committed on trunk
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.--- gcc/ada/alloc.ads
+++ gcc/ada/alloc.ads
@@ -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;
--- gcc/ada/atree.adb
+++ gcc/ada/atree.adb
@@ -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,12 +687,21 @@ 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;
- Par_Count : Nat := 0;
+ Save_Sloc : constant Source_Ptr := Sloc (N);
+
+ Par_Count : Nat := 0;
begin
if Nkind (N) in N_Subexpr then
@@ -703,7 +716,9 @@ package body Atree is
Nodes.Table (N).Nkind := New_Node_Kind;
Nodes.Table (N).Error_Posted := Save_Posted;
- Flags.Table (N) := Default_Flags;
+ 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 --
-------------------------------
--- gcc/ada/atree.ads
+++ gcc/ada/atree.ads
@@ -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);
--- gcc/ada/ghost.adb
+++ gcc/ada/ghost.adb
@@ -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))
- then
- Scop := Entity (Identifier (Nod));
-
- elsif Nkind_In (Nod, N_Package_Body,
- N_Package_Declaration,
- N_Subprogram_Body,
- N_Subprogram_Declaration)
- then
- Scop := Defining_Entity (Nod);
- 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.
+ -- 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
+ -- Only ignored Ghost nodes must be recorded in the table
- Add_Ignored_Ghost_Unit (Cunit (Get_Code_Unit (N)));
- end Propagate_Ignored_Ghost_Code;
+ pragma Assert (Is_Ignored_Ghost_Node (N));
+ Ignored_Ghost_Nodes.Append (N);
+ end if;
+ 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
-
- 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;
-
- begin
- -- Do not prune compilation unit nodes because many mechanisms
- -- depend on their presence. Note that context items are still
- -- being processed.
+ procedure Remove_Ignored_Ghost_Node (N : Node_Id);
+ -- Eliminate ignored Ghost node N from the tree
- if Nkind (N) = N_Compilation_Unit then
- return OK;
+ -------------------------------
+ -- Remove_Ignored_Ghost_Node --
+ -------------------------------
- -- 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;
-
- -- Scoping constructs such as blocks, packages, subprograms and
- -- bodies offer some flexibility with respect to pruning.
-
- 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;
-
- -- The scoping construct contains both living and ignored Ghost
- -- code, let the traversal prune all relevant nodes.
+ procedure Remove_Ignored_Ghost_Node (N : Node_Id) is
+ begin
+ -- 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 Contains_Ignored_Ghost_Code (Id) then
- return OK;
+ if Nkind (N) = N_Null_Statement then
+ null;
- -- Otherwise the construct contains only living code and should
- -- not be pruned.
+ -- Otherwise the ignored Ghost node must be eliminated
- else
- return Skip;
- end if;
+ else
+ -- Only ignored Ghost nodes must be eliminated from the tree
- -- Otherwise keep searching for ignored Ghost nodes
+ pragma Assert (Is_Ignored_Ghost_Node (N));
- else
- return OK;
- end if;
- end Prune_Node;
+ -- 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.
- procedure Prune_Nodes is new Traverse_Proc (Prune_Node);
+ Rewrite (N, Make_Null_Statement (Sloc (N)));
- -- Start of processing for Prune_Tree
+ -- Eliminate any aspects hanging off the ignored Ghost node
- begin
- Prune_Nodes (Root);
- end Prune_Tree;
+ Remove_Aspects (N);
+ end if;
+ 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;
--- gcc/ada/ghost.ads
+++ gcc/ada/ghost.ads
@@ -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);
--- gcc/ada/sem_ch8.adb
+++ gcc/ada/sem_ch8.adb
@@ -3782,9 +3782,7 @@ package body Sem_Ch8 is
-- Local variables
- Ghost_Id : Entity_Id := Empty;
- Living_Id : Entity_Id := Empty;
- Pack : Entity_Id;
+ 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;
----------------------
--- gcc/ada/sem_util.adb
+++ gcc/ada/sem_util.adb
@@ -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;
-----------------------