------------------------------------------------------------------------------
--                                                                          --
--                          GNATCHECK COMPONENTS                            --
--                                                                          --
--               G N A T C H E C K . G L O B A L _ S T A T E                --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                     Copyright (C) 2005-2006, AdaCore                     --
--                                                                          --
-- GNATCHECK  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.  GNATCHECK  is  distributed in the hope that it will be useful, --
-- but  WITHOUT  ANY  WARRANTY;   without  even  the  implied  warranty  of --
-- MERCHANTABILITY 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,  51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.                                       --
--                                                                          --
-- GNATCHECK is maintained by AdaCore (http://www.adacore.com).             --
--                                                                          --
------------------------------------------------------------------------------

--  This package defines the data structures describing the components of the
--  global state of the set of sources being checked needed to check the global
--  rules

with Ada.Containers.Ordered_Sets;

with System;               use System;

with Asis;                 use Asis;

with Table;

with ASIS_UL.Source_Table; use ASIS_UL.Source_Table;
with ASIS_UL.Strings;      use ASIS_UL.Strings;

package Gnatcheck.Global_State is

   --  The general design decision taken for representing the global structure
   --  is to keep the data structure as minimal as possible, resolving locally
   --  all the cases that can be resolved locally.

   --  At the moment we definitely need a full call graph to be represented as
   --  (a part of) the global structure. It is needed to check at least the
   --  following rules:
   --  - function should not have a side effect;
   --  - at most one task can call a given protected entry;
   --  - consistency of priority setting for ceiling priority inheritance
   --  - direct and indirect recursion is not allowed

   --  We also need to represent the global-local relationships between
   --  callable entities (for side effect rule).

   --  The representation of the global structure is passed on the following
   --  notions:

   --  Callable Entity - an entity that can be called by some other entity
   --  Caller          - an entity that can call some Callable Entity
   --  Scope           - statically enclosed (bodies of) callable entities

   --  The term "entity" is used  here in a little bit more general sense
   --  comparing with what is defined in RM95. For example, for two different
   --  objects of the same protected type:
   --
   --     protected type P is
   --        entry E;
   --        ...
   --     end P;
   --
   --     A, B : P;
   --
   --  we have two different callable entities - A.E and B.E, but these
   --  entities do not have declarations in the Ada sense.

   -----------------------------------------------------------------
   -- Flags to turn ON and OFF components of the global structure --
   -----------------------------------------------------------------

   Buld_Call_Graph : Boolean := False;

   ---------------------
   -- Auxiliary types --
   ---------------------

   type GS_Node_Id is new Integer range 0 .. Integer'Last;
   --  Index of the nodes representing the global state

   No_GS_Node    : constant GS_Node_Id := GS_Node_Id'First;
   First_GS_Node : constant GS_Node_Id := No_GS_Node + 1;

   Environment_Task_Node : GS_Node_Id;
   --  Node representing the environment task

   function Present (N : GS_Node_Id) return Boolean;
   --  Checks if N is within the range of the currently represented nodes

   function No (N : GS_Node_Id) return Boolean;
   --  Checks if N is not in the range of the currently represented nodes

   function Last_Node return GS_Node_Id;
   --  Returtns the last node stored in the call graph.

   ----------------
   -- Node kinds --
   ----------------

   type GS_Node_Kinds is
     (Not_A_Node, --  A null node
      Environment_Task,
      A_Procedure,
      A_Function,
      A_Procedure_Instantiation,
      A_Function_Instantiation,
      A_Protected_Definition, --  is needed to keep and maintain priority info
      A_Task_Object,
      A_Task_Definition,
      A_Task_Entry,
      A_Protected_Procedure,
      A_Protected_Function,
      A_Protected_Entry,
      A_Protected_Procedure_Body,
      A_Protected_Function_Body,
      A_Protected_Entry_Body,
      A_Library_Package,
      A_library_Package_Instantiation,
      An_Extended_Library_Package_Instantiation);

   --  A global structure is a set of Nodes and various links between them.
   --  Each non-null node can be a caller. Each non-null node except
   --  A_Library_Package can be called by another node. All the calls issued
   --  from elaboration of global declarations and from the statement sequences
   --  of the bodies of library packages are considered as calls from the
   --  corresponding A_Library_Package node. Only library packages can be
   --  caller nodes, any call issued by any local package is considered as a
   --  call of the node corresponding to the immediately enclosing entity.
   --  A_Library_Package nodes also include library level package
   --  instantiations (???).

   --  In Ada a task is not a callable object. A task entry can be called, but
   --  the task as a whole entity - cannot. But from the point of view of
   --  side effect investigation, if some subprogram activates a task as a
   --  part of its execution, and if this task changes a global object, then
   --  call to this subprogram also should be considered as changing that
   --  global object, and this subprogram does have a side effect even if it
   --  does not change any global object in its own code.

   --  If we have more then one object of the same task or protected type, then
   --  the same entries of protected operations of different object are
   --  considered and represented as different callable entities.

   function GS_Node_Kind (N : GS_Node_Id) return GS_Node_Kinds;
   --  Returns the kind of its argument. Returns Not_A_Node in case if No (N).

   type Renaming_Kinds is
     (Not_A_Renamimg,
      Renaming_As_Body,
      Renaming_As_Declaration,
      Enum_Literal_Renaming,
      Pass_Actual_Subprogram);
   --  ???

   function GS_Node_Renaming_Kind (N : GS_Node_Id) return Renaming_Kinds;
   --  Returns the renaming kind of its argument. Returns Not_A_Renamimg in
   --  case N does not represent a renaming.

   procedure Set_GS_Node_Renaming_Kind
     (N   : GS_Node_Id;
      Val : Renaming_Kinds);
   --  Sets the renaming_Kind for the node

   procedure Set_Renaming_Node
    (Renaming_Node : GS_Node_Id;
     Renaming_El   : Asis.Element);
   --  Set the properies of the node that represents a renaming from the
   --  corresponding renaming element.

   -------------------------------------
   -- Common Node processing routines --
   -------------------------------------

   procedure Register_Entity
     (El               : Asis.Element;
      Fix_Protected_Op : Boolean := False);
   --  Checks if the entity corresponding to the argument Element is already
   --  stored. If it is not, creates and stores the corresponding node.
   --  For protected operation entities, we need a reference to the
   --  corresponding protected operations to define the operation priority.
   --  We can set safely this reference only when we traverse the code.
   --  If Fix_Protected_Op parameter is ON, we set this reference if El
   --  represents a protected operation.

   function Register_Entity
     (El               : Asis.Element;
      Fix_Protected_Op : Boolean := False)
      return             GS_Node_Id;
   --  Returns the node Id for the node representing the argument Element.
   --  If this node does not exist, creates it. The meaning of Fix_Protected_Op
   --  parameter is the same as for the procedure Register_Entity

   function Find_Node
     (El           : Asis.Element;
      Needed_Kind  : GS_Node_Kinds := Not_A_Node;
      Protected_Op : GS_Node_Id    := No_GS_Node)
      return         GS_Node_Id;
   --  Looks for the node corresponding to the given Element in the Global
   --  Structure nodes table. Returns No_GS_Node if there is no such node.
   --  The Protected_Op parameter is used when we are looking for a protected
   --  operation node. It should be set to point to the corresponding
   --  A_Protected_..._Body node, otherwise it shoud de set to No_GS_Node. (The
   --  problem with protected operation nodes is that more then node of this
   --  kind may be based on the same element (the declaration of a protected
   --  object), so the only way to make the difference between them is to use
   --  this declaration element together with the reference to the
   --  corresponding protected operation in the protected definition. See also
   --  Is_Equal function in the body of this package.
   --  Needed_Kind parameter is used in the same way as for Corresponding_Node
   --  function

   function Corresponding_Node
     (El          : Asis.Element;
      Needed_Kind : GS_Node_Kinds := Not_A_Node)
      return        GS_Node_Id;
   --  Returns the node representing the entity corresponding to the given
   --  Element in the Global Structure. If the node does not exist, it is
   --  allocated as a part of processing the call to this function and
   --  returned as a result. This function assumes that Corresponding_Element
   --  has been already applied to its argument.
   --  The parameter Needed_Kind is used to make the difference between
   --  different nodes created on the base of the same ASIS Element. At the
   --  moment we know only one such situation - in case of a task declataion
   --  with null task definition (that is, 'task T;') we have to create both
   --  A_Task_Object and the corresponding A_Task_Definition nodes on the base
   --  of this declaration Element. So, if Needed_Kind is not Not_A_Node, this
   --  function looks for or cteates a node of the specificed kind, if this
   --  parameter is set to Not_A_Node, it is just ignored.

   function Corresponding_Protected_Op_Node
     (Protected_Obj : Asis.Element;
      Protected_Op  : GS_Node_Id)
      return GS_Node_Id;
   --  This is the special version of Corresponding_Node that can retrieve (and
   --  allocate, if needed) the node corresponding to a specific protected
   --  operation. A caller is responsible to call this routine only under the
   --  right conditions: Protected_Obj should be either a single protected
   --  declaration or a defining name of a protected object (???), and
   --  Protected_Op should point to the node representing the body of the
   --  protected operation of the corresponding protected type.

   ---------------
   -- Call Sets --
   ---------------

   --  The global structure keeps the information about calls. Each node points
   --  to the set of entities it calls directly, to the set of entities that
   --  directly call this node, to the set of all entities it calls directly
   --  or indirectlt and to the set of all the entities that directly or
   --  indirectly call this entity.

   package Call_Lists is new Ada.Containers.Ordered_Sets
     (Element_Type => GS_Node_Id);
   --  This package defines ordered sets containers used to represent sets of
   --  calls accosiated with a given node.  A call set is a set of nodes that
   --  are called by (or that call).
   --  the given node

   use type Call_Lists.Set;
   use type Call_Lists.Cursor;

   type Call_Set_Kinds is
     (Calls,
      Callers);
   --  Used to mark sets of calls/callers of interest for the operations
   --  working on call links

   procedure Store_Arc (Called_Entity : Asis.Element);
   --  Supposing that the argument is an Element that can be stored as a node
   --  of the Call Graph (that is, Corresponding_Element has already been
   --  applied to it), stores the arc from the current scope to the node
   --  corresponding to this element. Each arc is stored only once. This
   --  includes adding a new record both in list of calling and called
   --  entities.

   procedure Store_Arc (Called_Node : GS_Node_Id);
   --  Stores all the links corresponding the call to Called_Node from the
   --  current scope

   procedure Store_Task_Creation_Arc (El : Asis.Element);
   --  For a construct that creates a task, this procedure registers the
   --  corresponding task entity storing for it the link to the corresponding
   --  body, and stores the arc representing the "call" of this task entity
   --  issued by the current scope

   -----------------------------------------------
   -- Calls that can not be detected statically --
   -----------------------------------------------

   function Contains_Dispatching_Call (N : GS_Node_Id) return Boolean;
   --  Returns True if the entity represented by N issues a dispatching call,
   --  and False othervise

   procedure Set_Contains_Dispatching_Call (N : GS_Node_Id);
   --  Stores the fact that N issues a dynamic call

   function Contains_Dynamic_Call (N : GS_Node_Id) return Boolean;
   --  Returns True if the entity represented by N issues a dynamic call, and
   --  False othervise

   procedure Set_Contains_Dynamic_Call (N : GS_Node_Id);
   --  Stores the fact that N issues a dynamic call

   type Call_Special_Cases is
     (Not_A_Special_Case,
      A_Discpatchning_Call,
      A_Call_Through_Acccess_Value,
      Unknown);
   --  This type enumerates the special cases when we do have a call, but we
   --  cannot detect the calling entity because of some reason

   ------------
   -- Scopes --
   ------------

   --  Callable entities are statically enclosed in one another. (What about
   --  entries and protected operations???). Each callable entity points to its
   --  enclosed scope. Each entity points to the list of (immediately)
   --  enclosed entities.

   subtype Scope_Id is GS_Node_Id;
   No_Scope  : constant Scope_Id := Scope_Id'First;

   subtype Scope_Levels is Integer range -1 .. Integer'Last;
   --  ???

   Unknown_Scope_Level : constant Scope_Levels := -1;
   Global_Scope_Level  : constant Scope_Levels := 0;
   --  ???

   ------------------
   --  Scope Stack --
   ------------------

   --  During the source traversal we are maintaining a stack of enclosing
   --  scopes. Any call visited during the traversal is the call issued by the
   --  entity from the top of the stack
   --  (What about calls of protected operations???)

   function Is_Scope (N : GS_Node_Id) return Boolean;
   --  Checks if N represents a scope

   procedure Set_Is_Scope (N : GS_Node_Id);
   --  Marks the argumnent node as being a scope.

   function Is_Global_Scope (Scope : Scope_Id) return Boolean;
   --  Checks if the argument represemts a global scope (that is, a library
   --  package or a library package instantiation). (A global scope has a zero
   --  scope level). Returns True for No_Scope_Ind (this corresponds to the
   --  situation when we are outside any library unit). Returns False if the
   --  argument is not a scope.

   function Is_Local_Scope (N : GS_Node_Id) return Boolean;
   --  Checks if the argument represents a global (or local) scope.  Returns
   --  False if the argument is not a scope.

   procedure Set_Current_Scope (Scope : GS_Node_Id);
   procedure Set_Current_Scope (Scope : Asis.Element);
   --  Puts its argument on the top of the current scope stack. For the latter
   --  function, the Corresponding_Node for the Scope Element is computed

   function Current_Scope return Scope_Id;
   --  Returns the top entity from the stack. Returns No_Scope_Ind if the stack
   --  is empty

   procedure Remove_Current_Scope;
   --  Pops the top entity. Raises Scope_Stack_Error if the stack is empty

   function Scope_Level (Scope : Scope_Id) return Scope_Levels;
   --  Returns the nesting level of the argument
   procedure Set_Scope_Level (N : Scope_Id; Val : Scope_Levels);
   --  Sets the scope level of the argument node to Val

   Scope_Stack_Error : exception;

   ----------------------
   -- Enclosing Scopes --
   ----------------------

   function Enclosing_Scope (N : GS_Node_Id) return Scope_Id;
   --  Returns the statically enclosed scope. Returns No_GS_Node if the
   --  argument corresponds to a library-level program unit

   procedure Set_Enclosing_Scope
     (N : GS_Node_Id;
      S : Scope_Id := Current_Scope);
   --  Sets S as enclosing scope for N

   function First_Enclosed_Scope (N : GS_Node_Id) return Scope_Id;
   --  Returns the first scope from the list of immediately enclosed scopes.
   --  Returns No_GS_Node if there is no enclosed scopes.
   --  ???

   function Next_Scope (S : Scope_Id) return Scope_Id;
   --  Returns the next scope declared on the same level in the same enclosing
   --  scope. Returns No_GS_Node if there is no such scope.
   --  ???

   ----------------
   -- Priorities --
   ----------------

   --  A node may have a priority (see RM95, Annex D). To represent the
   --  priority values, we use subtype System.Any_Priority

   function Node_Priority (N : GS_Node_Id) return Any_Priority;
   --  Returns the priority of the node

   procedure Set_Priority (N : GS_Node_Id; Val : Any_Priority);
   --  Sets the priority value for the node. Also sets ON the flag indicating
   --  that the priority is defined for the node.

   function Has_Dynamic_Priority (N : GS_Node_Id) return Boolean;
   --  Tells if the priority of the argument node can not be determined
   --  statically

   procedure Set_Dynamic_Priority (N : GS_Node_Id);
   --  Sets for N that the corresponding entity has dynamically defined
   --  priority

   function Priority_Defined (N : GS_Node_Id) return Boolean;
   --  Checks if we have defined the priority of the argument node

   -----------------
   -- Side Effect --
   -----------------

   --  See the discussion concerning the side effect in No_Side_Effect_Function
   --  section of Gnatcheck.Rules.Default. Should we have all the documentation
   --  of side effect here?

   type Side_Effect_Statuses is
     (Unknown,
      --  Nothing is known about the side effect of the given entity

      No_Side_Effect,
      --  The entity is side-effect free

      Call_To_Missing_Body,
      --  We have a call to something, but the body of the called entity is
      --  not available. In such a situation, we take an overpessimistic
      --  approach and consider such a call as adding a side effect

      Local_Side_Effect,
      --  The entity can change only those global for the given entity objects
      --  that are local to some enclosing non-global entity

--      Unresolved_Call,
      --  We have a call to some (statically determinable and, therefore,
      --  known) entity, but we do not know if this entity is side-effect free,
      --  and if not - what kind of side effect it can introduce
      --  ??? do we need this as a Side_Effect_Statuses value or as a separate
      --  ??? boolean flag?

      Potentially_Global_Side_Effect,
      --  The code of the entity contains an update of an access value or of
      --  an object pointed by an access value, or a call we cannot detect
      --  the called entity for (it may be a dispatching call or a call through
      --  an access-to-subprogram value), or a call to an entity that has
      --  Potentially_Global_Side_Effect

      Global_Side_Effect);
      --  It is definitely known that a given entity does have a side effect.

   function Side_Effect_Status (Scope : Scope_Id) return Side_Effect_Statuses;
   --  Returns the current side effect status of its argument. If the
   --  argument is of A_Library_Package, returns Unknown. ???

   procedure Set_Side_Effect_Status
     (Of_Scope : Scope_Id;
      To       : Side_Effect_Statuses;
      At_SLOC  : String_Loc := Nil_String_Loc);
   --  ???

   --  A side effect status may be changed during the analysis. We start
   --  from No_Side_Effect, and we change the status from better to worse as
   --  soon as we find a reason for it. As soon as we get to
   --  Global_Side_Effect, we stop doing any side-effect-specific analysis
   --  for the given entity.

   --  ??? Potentially_Global_Side_Effect vs Local_Side_Effect???

   function Side_Effect_Defined (Of_Scope : Scope_Id) return Boolean;
   --  Checks if the side effect status for its argument is completely
   --  defined and cannot be changed

   procedure Set_Side_Effect_Defined
     (Of_Scope : Scope_Id;
      Val      : Boolean := True);
   --  ????

   function Call_To_Unknown_SE (Scope : Scope_Id) return Boolean;
   procedure Set_Call_To_Unknown_SE
     (Scope : Scope_Id;
      Val   : Boolean := True);
   --  ????

   type Side_Effect_Causes is
     (No_Side_Effec_Cause,
      --  We do not have any side effect
      Unknown,
      --  We do not know exactly why an entity has a side effect

      Update_Global_Object,
      --  An entity updates a global object that is global for it

      Call_To_Side_Effect_Entity,
      --  An entity calls another entity that does have a side effect

      Update_An_Accessed_Object,
      --  An entity updates some object pointed by an access value,

      Dispatching_Call,
      --  An entity issues a dispatching call

      Dynamic_Call);
      --  An entity issues a call for that the called entity cannot be
      --  determined statically

   function Side_Effect_Cause (N : GS_Node_Id) return Side_Effect_Causes;
   --  Returns the reason why the argument does have a side effect

   function Side_Effect_Cause_Loc (N : GS_Node_Id) return String_Loc;
   --  Returns the source coordinates of the construct that causes the
   --  worst defined side effect for the given entity.

   --  In case if an entity has Local_Side_Effect, it is important to know
   --  up to what level of nested scopes this side effect can cause the
   --  enclosing scopes to have a side effect because of calling this
   --  entity

   --  Consider:
   --
   --     function F1 return Integer is
   --         A, B : Integer;
   --         ...
   --         function F2 return Integer is
   --             Var : Integer;
   --             function F3  return Integer is
   --             begin
   --                A := 13;
   --                ...
   --             end F3;
   --        begin --  F2
   --           ...
   --           Var := F3;
   --        end F2;
   --     begin
   --        B := F2;
   --        ...
   --     end F1;

   --  In this example F3 and F2 have a side-effect, but F1 does not

   function Local_Side_Effect_Level
     (Of_Scope : Scope_Id)
      return     Scope_Levels;
   --  If N has Local_Side_Effect, this function returns the upper enclosing
   --  scope that may be affected by this side-effect (for the example above
   --  the node corresponding to F2 is returned). Otherwise returns
   --  No_GS_Node
   --  ???

   procedure Set_Local_Side_Effect_Level
     (Of_Scope : Scope_Id;
      To_Level : Scope_Levels);
   --  ???

   procedure Define_Side_Effect
     (Element              : Asis.Element;
      New_SE_Status        : out Side_Effect_Statuses;
      Is_Unresolved_Call   : out Boolean;
      Change_Data_At_Level : out Scope_Levels);
   --  This procedure tries to define the side effect caused by El.

   procedure Correct_Side_Effect_Status
     (For_Node  : GS_Node_Id;
      From_Node : GS_Node_Id);
   --  This procedure checks if From_Node has more serious side effect then
   --  For_Node, and if it is, sets the side effect of For_Node from side
   --  effect of From_Node (it is supposed that For_Node calls From_Node).
   --  This correction takes place even if Call_To_Unknown_SE (From_Node),
   --  in this case Call_To_Unknown_SE is set on also for For_Node. Note,
   --  that in case if Global_Side_Effect is set for For_Node then for this
   --  node Call_To_Unknown_SE is set OFF and Side_Effect_Defined is set on.
   --  Note also, that at the moment this routine does not set the SLOC of
   --  the construct causing the side effect for For_Node, instead, if it
   --  changes the side effect status for it, it sets the SLOC of the side
   --  effect clause to Nil_String_Loc

   ----------------------
   -- Other Attributes --
   ----------------------

   function Is_RTL_Node (N : GS_Node_Id) return Boolean;
   --  Checks if the argument node represents an entity from some RTL unit

   function Enclosed_Source (N : GS_Node_Id) return SF_Id;
   --  Returns the ID of the source file the node has been extracted in.
   --  Returns No_SF_Id if No (N)

   function Location (N : GS_Node_Id) return String_Loc;
   --  Returns the SLOC of teh node/

   function Is_Subprogram (N : GS_Node_Id) return Boolean;
   --  Checks if the argument node represents a subprogram

   --  Many entities have or may have a spec and a body. To add an entity to
   --  the global stricture, we need a spec. Because we can process an
   --  arbitrary set of sources, there may be situations when bodies are not
   --  given for some entities.

   function Body_Analyzed (N : GS_Node_Id) return Boolean;
   --  Returns True if the body has been analyzed for the argument entity, and
   --  False otherwise

   procedure Set_Body_Analyzed (N : GS_Node_Id; Val : Boolean);
   --  Sets the Body_Analyzed attribute for the node N to Val

   function Renamed_Entity      (N : GS_Node_Id) return GS_Node_Id;
   procedure Set_Renamed_Entity (For_Node : GS_Node_Id; Val : GS_Node_Id);
   --  ???

   function Complete_Information_Extraction (N : GS_Node_Id) return Boolean;
   --  Returns True if all the possible information has been extracted and
   --  stored for the argument entity during the ASIS traversal, and False
   --  otherwise.

   function Get_Task_Definition (For_Task : GS_Node_Id) return GS_Node_Id;
   --  Returns the reference to the corresponding task definition for the
   --  argument task object node.

   procedure Set_Task_Definition (T : GS_Node_Id; T_Def : GS_Node_Id);
   --  For a task object, sets the reference to the task definition

   function Get_Protected_Op (For_Task : GS_Node_Id) return GS_Node_Id;
   --  Returns the reference to the executable body of the protected operation
   --  for the argument representing a protected operation belonging to a
   --  specific protected object.

   function Enclosing_Protected_Definition
     (For_PO : GS_Node_Id)
      return   GS_Node_Id;
   --  Returns the reference to enclosing protected definition for a node
   --  representing the protected operation body

   -------------------
   -- Special Cases --
   -------------------

   --  bodies for protected entries and operations

   --  "bodies" for task entries

   --  inherited subprograms

   --  controlled objects

   --  access to subprograms

   --  dispatching calls

   --  subunits?

   --  unchecked conversions and deallocations?

   --  anonymous access types

   ---------------------------------------
   -- Initialization and debug routines --
   ---------------------------------------

   procedure Initialize;
   --  Initializes the data structures needed to represent the global state.

   procedure Print_Global_Structure;
   --  Prints into Stderr the debug image of the global structure

   procedure Print_Node
     (N                    : GS_Node_Id;
      Extended_Debug_Image : Boolean := False);
   --  Prints into Stderr the debug image of the global structure node. If
   --  Extended_Debug_Image is set ON, the debug image contains much more
   --  information

   procedure Print_Node_List (L : Call_Lists.Set; Ident : Natural := 0);
   --  Prints into Stderr the debug images of the argument Node list

--  private

   ---------------------
   -- Data Structures --
   ---------------------

   ----------------------------------
   -- Global Structure Nodes Table --
   ----------------------------------

   type GS_Node_Record is record

      Node_Kind : GS_Node_Kinds;

      SF : SF_Id;
      --  Source file the given node belongs to.
      --  Why do we need this??? For the hash function only?

      SLOC : String_Loc;
      --  The full string location of the node (in case of generic
      --  instantiations includes the full istantiation chain)

      Enclosing_Scope : Scope_Id;
      --  ?????

      Is_Scope : Boolean;
      --  This field is not set correctly!

      Scope_Level : Scope_Levels;

      Local_Side_Effect_Level : Scope_Levels;
      --  In case if the given entity has local side effect, stores the level
      --  of the outermost scope where this entity can change data objects

      SE_Status : Side_Effect_Statuses;
      --  Side effect status currently defined for the entity, is set for
      --  Is_Scope entities only

      SE_SLOC : String_Loc;
      --  Is used to store the sloc of th econstruc casusing the most serious
      --  side effect. Is used for Is_Scope entities only.

      Side_Effect_Defined : Boolean;
      --  Flag indicating if for the given Is_Scope entity its side effect
      --  status is completely defined and cannot be changed

      Call_To_Unknown_SE : Boolean;
      --  This flag indicates if the given entity has at least one call to an
      --  entity to which the side effect status is unknown at the moment

      Node_Priority : Any_Priority;
      --  Priority of the node

      Has_Dynamic_Priority : Boolean;
      --  Flag indicating if the node has dynamically defined priority

      Priority_Defined : Boolean;
      --  Flag indicating if we have already defined the priority situation for
      --  the node

      Body_Analyzed : Boolean;
      --  Indicates if the body of the callable entity has been analyzed

      Calls_Chain : Call_Lists.Set;
      --  A set of calls issued by the given node (that is - a set of nodes
      --  that are DIRECTLY called by the given node)

      Callers_Chain : Call_Lists.Set;
      --  A set of nodes that DIRECTLY call the given node

      Hash_Link : GS_Node_Id;
      --  Link to the next entry in the node table for the same hash code.

      Node_Field_1 : GS_Node_Id;
      --  Some link to some other node, the meaning and usage depends on the
      --  node kind

      --  ??? Detailed documentation is needed!!!

      --  For A_Protected_Procedure, A_Protected_Function and
      --  A_Protected_Entry nodes, it points to the corresponding
      --  A_Protected_..._Body node.

      --  For A_Procedure and A_Function node, in case if the corresponding
      --  subprogram is completed by a renaming-as-body, it points to the node
      --  corresponding to the renamed subprogram

      --  For A_Protected_..._Body node points to the corresponding
      --  A_Protected_Definition

      Contains_Dispatching_Call : Boolean;
      --  This flag is ON if the node issues a dynamic call and OFF otherwise

      Contains_Dynamic_Call : Boolean;
      --  This flag is ON if the node issues a dynamic call and OFF otherwise

      Renaming_Kind : Renaming_Kinds;
      --  ???

      Is_Dynamic : Boolean;
      --  ???

      Is_Used : Boolean;
      --  Flag indicating if the given entity is used in the analyzed set of
      --  sources.
      --  ??? What about tasking stuff?
      --  At the moment this flag is set ON for all the library level
      --  subprograms if the corresponding ASIS Compilation_Unit
      --  Can_Be_Main_Program

      Is_RTL_Node : Boolean;
      --  Indicates if the node corresponds to the entity from RTL Unit

   end record;

   type GS_Node_Record_Access is access GS_Node_Record;

   subtype Existing_GS_Node_Id is GS_Node_Id
     range First_GS_Node .. GS_Node_Id'Last;

   package GS_Nodes is

      --  gnatcheck global structure was initially implemented on the base of
      --  the GNAT Table package. When moving the gnatcheck node table onto
      --  the vector container abstraction (that is very similar to the GNAT
      --  Table abstraction) we tried to minimize disturbing of the workable
      --  code, so we tried to mimic the Table-based behavior of the underlying
      --  container structure.

      function Table (N : GS_Node_Id) return GS_Node_Record_Access;
      --  Mimics the notation Instantce_Name.Table (N) in the instantiation of
      --  the GNAT Table package. Returns the Node with the index N from
      --  GS_Nodes_Table (see the body of the package). Raises Constraint_Error
      --  if a node with this index does not exsist.

      procedure Append (New_Node : GS_Node_Record);
      --  Mimics the Append procedure from the instantiation of the GNAT Table
      --  package. Adds New_Node as the new element to GS_Nodes_Table

      function Last return GS_Node_Id;
      --  Mimics the Last function from the instantiation of the GNAT Table
      --  package. Returns the index of the last element stored in
      --  GS_Nodes_Table.

      --------------------------------------
      -- Node attribite update procedures --
      --------------------------------------

      --  We can mimic GS_Nodes.Table (N) notation for reading the (content of
      --  the) nodes, but we can not do this for updating the information
      --  stored in the nodes. So we need an update routines for this

      procedure Set_Body_Analyzed      (N : GS_Node_Id; Val : Boolean);
      procedure Set_Call_To_Unknown_SE (N : GS_Node_Id; Val : Boolean);

      procedure Set_Enclosing_Protected_Definition
        (N   : GS_Node_Id;
         Val : GS_Node_Id);

      procedure Set_Enclosing_Scope
        (N   : GS_Node_Id;
         Val : Scope_Id := Current_Scope);

      procedure Set_GS_Node_Renaming_Kind
        (N   : GS_Node_Id;
         Val : Renaming_Kinds);

      procedure Set_Hash_Link (N : GS_Node_Id; Val : GS_Node_Id);

      procedure Set_Local_Side_Effect_Level
        (N   : Scope_Id;
         Val : Scope_Levels);

      procedure Set_Priority       (N : GS_Node_Id; Val : Any_Priority);
      procedure Set_Protected_Op   (N : GS_Node_Id; Val : GS_Node_Id);
      procedure Set_Renamed_Entity (N : GS_Node_Id; Val : GS_Node_Id);
      procedure Set_Scope_Level    (N : GS_Node_Id; Val : Scope_Levels);

      procedure Set_Side_Effect_Defined
        (N   : Scope_Id;
         Val : Boolean := True);

      procedure Set_Side_Effect_Status
        (Of_Scope : Scope_Id;
         To       : Side_Effect_Statuses;
         At_SLOC  : String_Loc := Nil_String_Loc);

      procedure Set_Task_Definition (N : GS_Node_Id; Val : GS_Node_Id);

      procedure Set_Contains_Dispatching_Call (N : GS_Node_Id);
      procedure Set_Contains_Dynamic_Call     (N : GS_Node_Id);
      procedure Set_Dynamic_Priority          (N : GS_Node_Id);
      procedure Set_Is_Used                   (N : GS_Node_Id);
      procedure Set_Is_Scope                  (N : GS_Node_Id);
      procedure Set_Priority_Defined          (N : GS_Node_Id);
      --  Always set the corresponding field of N to True.

      --------------------------------------
      --  Node call set update procedures --
      --------------------------------------

      procedure Add_Call_Set
        (To_Node    : GS_Node_Id;
         Target_Set : Call_Set_Kinds;
         From_Node  : GS_Node_Id;
         Source_Set : Call_Set_Kinds);
      --  Adds the Source_Set from  From_Node to Target_Set of To_Node. "Adds"
      --  means the Union operation of Ordered_Sets container

      procedure Add_Node_To_List
        (To_Node     :     GS_Node_Id;
         Node_To_Add :     GS_Node_Id;
         Set_To_Add  :     Call_Set_Kinds;
         Inserted    : out Boolean);
      --  Tries to add Node_To_Add to the set Set_To_Add of To_Node. Sets
      --  Inserted ON is the node has been inserted (that is, it was not in the
      --  target list before the call)

   end GS_Nodes;

   function Last_Node return GS_Node_Id renames GS_Nodes.Last;

   -----------------------------------
   -- Call graph transitive closure --
   -----------------------------------

   --  Initially the call graph is created as a result of the ASIS analysis of
   --  the argument units and it is represented as an array of nodes (see
   --  package GS_Nodes), and for each node we have a set of all the direct
   --  calls and direct callers.
   --  ??? Do we really need callers??? Callers are just columns in
   --  connectivity matrix!

   --  For some global rules we need a set of all (direct and indirect) calls
   --  of the given node, or a set of all the nodes that calls the given node,
   --  directly or indirectly. To get these sets, we create the call graph
   --  connectivity matrix from the sets of direct calls and then perform the
   --  transitive closure of this matrix. As a result, rows of the matrix
   --  represent all the calls for the node that is the index of a row, and
   --  columns - all the caller.

   type Matrix_Array is array
     (GS_Node_Id range <>, GS_Node_Id range <>) of Boolean;

   type Access_Matrix_Array is access Matrix_Array;

   Matrix : Access_Matrix_Array;
   --  This is the connectivity matrix of the call graph. Note that it gets
   --  value only *after* performing the transitive closure!

   procedure Print_All_Callers (N : Existing_GS_Node_Id);
   procedure Print_All_Calls   (N : Existing_GS_Node_Id);
   --  These procedures ptint into Stdout the debug output of the set of all
   --  the calls/callers. Note, that they can be called only AFTER making the
   --  transitive closure of Matrix!

   function Is_Recursive_Node (N : GS_Node_Id) return Boolean;
   --  Check if N calls itself (directly or indirectly). It is an error to call
   --  this function if No (N), or if the transitive clousure of the global
   --  structure has not been performed yet.

   function Calls (N1, N2 : GS_Node_Id) return Boolean;
   --  Checks if N1 calls N2, directly or indirectly.

   procedure Build_Recursive_Chain
     (For_Node      :     GS_Node_Id;
      Recursive_Set : out Call_Lists.Set);
   --  Provided that N is a recursive node, starting from this node creates in
   --  Recursive_Set a set of of nodes that recursively call each other.
   --  This procedure is supposed to be called after performing the transitive
   --  closure of the call graph
   --  ??? Should this pocedure be moved into package interface?

   ------------------------
   --  Call set iterator --
   ------------------------

   --  The following routines implement the iterator for traversing sets
   --  of all calls/callers. This iterator can only be used after performing
   --  the closure of the call graph connectivity matrix.2

   procedure Reset_Itrerator
     (For_Node : Existing_GS_Node_Id;
      Call_Set : Call_Set_Kinds);
   --  Resets the iterator for For_Node. Call_Set parameter indicates which
   --  link (all calls or all callers) will be iterated.

   function Done return Boolean;
   --  Should be called only after a call to Reset_Itrerator, returns True if
   --  the iterator has been advanced past the last element in the set

   function Next_Node return GS_Node_Id;
   --  Advances the iterator to the next component in the set. Returns
   --  No_GS_Node if Done returns True.

   ------------------
   --  Scope Stack --
   ------------------

   subtype Scope_Ind_Type is Natural;

   Envir_Scope_Ind : constant Scope_Ind_Type := Scope_Ind_Type'First;
   Top_Scope_Ind   : constant Scope_Ind_Type := Envir_Scope_Ind + 1;
   --  ???

   package Current_Scopes is new Table.Table
     (Table_Component_Type => Scope_Id,
      Table_Index_Type     => Scope_Ind_Type,
      Table_Low_Bound      => Envir_Scope_Ind,
      Table_Initial        => 50,
      Table_Increment      => 100,
      Table_Name           => "current scope table");

   Environment_Task_Node_Rec : constant GS_Node_Record :=
     (Node_Kind                 => Environment_Task,
      SF                        => No_SF_Id,
      SLOC                      => Nil_String_Loc,
      Enclosing_Scope           => No_Scope,                       --  ????
      Is_Scope                  => True,
      Scope_Level               => Global_Scope_Level,
      Local_Side_Effect_Level   => Global_Scope_Level,
      SE_Status                 => No_Side_Effect,
      SE_SLOC                   => Nil_String_Loc,
      Side_Effect_Defined       => True,
      Call_To_Unknown_SE        => False,
      Node_Priority             => Default_Priority,
      Has_Dynamic_Priority      => False,
      Priority_Defined          => True,
      Body_Analyzed             => True,
      Calls_Chain               => Call_Lists.Empty_Set,
      Callers_Chain             => Call_Lists.Empty_Set,
      Hash_Link                 => No_GS_Node,
      Node_Field_1              => No_GS_Node,
      Contains_Dispatching_Call => False,
      Contains_Dynamic_Call     => False,
      Renaming_Kind             => Not_A_Renamimg,
      Is_Dynamic                => False,
      Is_Used                   => True,
      Is_RTL_Node               => False);

end Gnatcheck.Global_State;
