------------------------------------------------------------------------------
--                                                                          --
--                           GNATELIM COMPONENTS                            --
--                                                                          --
--                       G N A T E L I M . N O D E S                        --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--            Copyright (C) 1998-2003 Ada Core Technologies, Inc.           --
--                                                                          --
-- GNATELIM  is  free software;  you can  redistribute it and/or  modify it --
-- under the 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  MERCHANTABI- --
-- LITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public Li- --
-- cense 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.                                              --
--                                                                          --
-- The original version  of  Gnatelim  was developed by  Alain  Le  Guennec --
-- It is now maintained by Ada Core Technologies Inc  (http://www.gnat.com) --
--                                                                          --
------------------------------------------------------------------------------

--  This package provides the storage and retrieval system for the nodes of
--  a program that are of interest to Gnatelim

with GNAT.Table;
with Asis;

package Gnatelim.Nodes is

   -----------
   -- Nodes --
   -----------

   type Node_Key is record
      File      : String_Loc;
      SLOC      : Source_Loc;
      Scope     : Natural;
   end record;
   --  Node_Key is the set of data that uniquely identifies the Node.
   --  Source:line:col satisfies this criterion
   --  For an instatiated generic, unique key would be file:pos of a generic
   --  construct that corresponds to this node plus a sequence file:pos
   --  of generic instantiations. The chain of instantiations is accessed
   --  through Scope pointer (holding zero if it is not an instance), which
   --  points to an instantiation node in the nodes table

   Empty_Key : constant Node_Key := ((0, 0), (0, 0), 0);

   type Node_Kinds is (Empty, A_Package, A_Package_Instance, A_Task,
                       A_Subprogram, A_Subprogram_Instance, Other);

   type Node is record
      Kind        : Node_Kinds := Empty;
      Parent_Link : Node_Key   := Empty_Key;
      TOC_Head    : Natural    := 0;
      Name        : String_Loc := Empty_String;

      Homonym_Id  : String_Loc := Empty_String;
      --  This field is used to distinguish homonyms. By default, the source
      --  location is used. Another approach is to use paramenetr profiles

      Flags       : Flag_Array := Empty_Flags;
      Key         : Node_Key   := Empty_Key;
   end record;
   --  Node is conceptually every construct of interest to gnatelim.
   --  These are containers of both declarations of further scopes and
   --  threads of control that can transfer control to other scopes.
   --  The list of all such transfers of control are accessed through
   --  TOC_Head link and they are stored in a global table of transfers of
   --  control that is described below.

   Empty_Node : constant Node := (Empty, Empty_Key, 0, Empty_String,
                                  Empty_String, Empty_Flags, Empty_Key);

   FLAG_USED     : constant := 1;
   FLAG_ANALYZED : constant := 2;
   --  These flags are used during transitive closure computation

   FLAG_NEVER_ELIMINATE : constant := 3;
   --  Is set ON if the given node should never generate Eliminate pragma.
   --  At the moment it is set for:
   --  - renaming declarations
   --  - subprograms completed by renaming-as-body

   procedure Register_Node (N : Node; Create : Boolean := False);
   --  Registers the given node in the node table. If Create is True, new
   --  element is created and exception is raised if such node already exists.
   --  If Create is False, existing element is updated and exception is raised
   --  if such node doesn't yet exist

   function Retrieve_Node (Key : Node_Key) return Node;
   --  Returns a node associated with a given key

   function Corresponding_Node (Element : Asis.Element) return Natural;
   --  Returns the index of the entry for the Node that corresponds to this
   --  Element. If Corresponding_Element of Element has not been registered
   --  before, 0 is returned.

   function Corresponding_Node (Element : Asis.Element) return Node;
   --  Returns the Node_Key structure that corresponds to this Element
   --  NOTE: If the expected result had not been registered before,
   --  an Empty_Key is returned.

   function Node_Kind (E : Asis.Element) return Node_Kinds;
   --  Returns the kind of the node based on the kind of the element it
   --  represents

   generic
      with function Action (N : Node) return Boolean;
   procedure Iterate;
   --  Iterates over all registered nodes, applying user-defined action to
   --  each. Function Action should return False if it wants iterator to
   --  terminate prematurely, or True otherwise

   procedure Transitive_Closure;
   --  Performs transitive closure on all registered nodes, i.e. propagates
   --  the "used" state transitively to all affected subprograms

   --------------------------
   -- Transfers of Control --
   --------------------------

   --  This section describes types and subprograms that store all transfers
   --  of control to other scopes made within a specific scope

   type TOC_Node is record
      Node : Node_Key;
      Next : Natural;
   end record;

   package TOC_Table is new GNAT.Table
     (Table_Component_Type => TOC_Node,
      Table_Index_Type     => Natural,
      Table_Low_Bound      => 1,
      Table_Initial        => 10_000,
      Table_Increment      => 10_000);
   --  The Scope_Node container

   TOCs : TOC_Table.Table_Ptr renames TOC_Table.Table;

   function Last_TOC return Integer renames TOC_Table.Last;

   function Enter_TOC (TOC : TOC_Node) return Natural;
   --  Stores TOC node in a table, returning position of a new entry

   ----------------------
   -- Debug procedures --
   ----------------------

   procedure Print_Node_Table;
   procedure Print_TOC_Table;
   --  These procedures outputs the content of the corresponding tables. At the
   --  moment they are not called in the gnatelim code at all, the idea is
   --  to have them ready to add the corresponding calls in the code in case
   --  if a real need to analyze the content of these tables is found during
   --  gnatelim debugging. (A natural usage of these procedures is to call
   --  them in Gnatelim.Driver just before and just after making the transitive
   --  clousure. You may also call them from the debugger). The format of the
   --  output is far from being pretty.

end Gnatelim.Nodes;
