Patchwork [Ada] Avoid dependency of package Atree on package Scil_ll

login
register
mail settings
Submitter Arnaud Charlet
Date June 23, 2010, 6:51 a.m.
Message ID <20100623065130.GA23360@adacore.com>
Download mbox | patch
Permalink /patch/56596/
State New
Headers show

Comments

Arnaud Charlet - June 23, 2010, 6:51 a.m.
This patch does not affect the functionality of the compiler. Done
to avoid compilation dependency of package Atree on the new package
Scil_ll.

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-06-23  Javier Miranda  <miranda@adacore.com>

	* atree.ads (Set_Reporting_Proc): New subprogram.
	* atree.adb: Remove dependency on packages Opt and SCIL_LL.
	(Allocate_Initialize_Node, Replace, Rewrite): Replace direct calls
	to routines of package Scil_ll by indirect call to the registered
	subprogram.
	(Set_Reporting_Proc): New subprogram. Used to register a subprogram
	that is invoked when a node is allocated, replaced or rewritten.
	* scil_ll.adb (Copy_SCIL_Node): New routine that takes care of copying
	the SCIL node. Used as argument for Set_Reporting_Proc.
	(Initialize): Register Copy_SCIL_Node as the reporting routine that
	is invoked by atree.

Patch

Index: atree.adb
===================================================================
--- atree.adb	(revision 161244)
+++ atree.adb	(working copy)
@@ -38,14 +38,15 @@  pragma Style_Checks (All_Checks);
 
 with Debug;   use Debug;
 with Nlists;  use Nlists;
-with Opt;     use Opt;
 with Output;  use Output;
 with Sinput;  use Sinput;
-with SCIL_LL; use SCIL_LL;
 with Tree_IO; use Tree_IO;
 
 package body Atree is
 
+   Reporting_Proc : Report_Proc := null;
+   --  Record argument to last call to Set_Reporting_Proc
+
    ---------------
    -- Debugging --
    ---------------
@@ -534,10 +535,10 @@  package body Atree is
       Orig_Nodes.Set_Last (Nodes.Last);
       Allocate_List_Tables (Nodes.Last);
 
-      --  Update the SCIL_Node field (if available)
+      --  Invoke the reporting procedure (if available)
 
-      if Generate_SCIL then
-         Set_SCIL_Node (New_Id, Get_SCIL_Node (Src));
+      if Reporting_Proc /= null then
+         Reporting_Proc.all (Target => New_Id, Source => Src);
       end if;
 
       return New_Id;
@@ -925,6 +926,16 @@  package body Atree is
       return Ekind_In (Ekind (E), V1, V2, V3, V4, V5, V6);
    end Ekind_In;
 
+   ------------------------
+   -- Set_Reporting_Proc --
+   ------------------------
+
+   procedure Set_Reporting_Proc (P : Report_Proc) is
+   begin
+      pragma Assert (Reporting_Proc = null);
+      Reporting_Proc := P;
+   end Set_Reporting_Proc;
+
    ------------------
    -- Error_Posted --
    ------------------
@@ -1580,10 +1591,10 @@  package body Atree is
 
       Orig_Nodes.Table (Old_Node) := Old_Node;
 
-      --  Update the SCIL_Node field (if available)
+      --  Invoke the reporting procedure (if available)
 
-      if Generate_SCIL then
-         Set_SCIL_Node (Old_Node, Get_SCIL_Node (New_Node));
+      if Reporting_Proc /= null then
+         Reporting_Proc.all (Target => Old_Node, Source => New_Node);
       end if;
    end Replace;
 
@@ -1644,10 +1655,10 @@  package body Atree is
 
       Fix_Parents (Ref_Node => New_Node, Fix_Node => Old_Node);
 
-      --  Update the SCIL_Node field (if available)
+      --  Invoke the reporting procedure (if available)
 
-      if Generate_SCIL then
-         Set_SCIL_Node (Old_Node, Get_SCIL_Node (New_Node));
+      if Reporting_Proc /= null then
+         Reporting_Proc.all (Target => Old_Node, Source => New_Node);
       end if;
    end Rewrite;
 
Index: atree.ads
===================================================================
--- atree.ads	(revision 161073)
+++ atree.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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 Soft- --
@@ -461,6 +461,12 @@  package Atree is
    --  function is used only by Sinfo.CN to change nodes into their
    --  corresponding entities.
 
+   type Report_Proc is access procedure (Target : Node_Id; Source : Node_Id);
+
+   procedure Set_Reporting_Proc (P : Report_Proc);
+   --  Register a procedure that is invoked when a node is allocated, replaced
+   --  or rewritten.
+
    type Traverse_Result is (Abandon, OK, OK_Orig, Skip);
    --  This is the type of the result returned by the Process function passed
    --  to Traverse_Func and Traverse_Proc. See below for details.
Index: scil_ll.adb
===================================================================
--- scil_ll.adb	(revision 161244)
+++ scil_ll.adb	(working copy)
@@ -37,6 +37,10 @@  with Table;
 
 package body SCIL_LL is
 
+   procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id);
+   --  Copy the SCIL field from Source to Target (it is used as the argument
+   --  for a call to Set_Reporting_Proc in package atree).
+
    function SCIL_Nodes_Table_Size return Pos;
    --  Used to initialize the table of SCIL nodes because we do not want
    --  to consume memory for this table if it is not required.
@@ -64,6 +68,15 @@  package body SCIL_LL is
    --  This table records the value of attribute SCIL_Node of all the
    --  tree nodes.
 
+   --------------------
+   -- Copy_SCIL_Node --
+   --------------------
+
+   procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id) is
+   begin
+      Set_SCIL_Node (Target, Get_SCIL_Node (Source));
+   end Copy_SCIL_Node;
+
    ----------------
    -- Initialize --
    ----------------
@@ -71,6 +84,7 @@  package body SCIL_LL is
    procedure Initialize is
    begin
       SCIL_Nodes.Init;
+      Set_Reporting_Proc (Copy_SCIL_Node'Access);
    end Initialize;
 
    -------------------