File : asis-set_get.ads


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                          A S I S . S E T _ G E T                         --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--            Copyright (c) 1995-1999, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-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 --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY 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 ASIS-for-GNAT; see file     --
-- COPYING. If not, write to the Free Software Foundation,  59 Temple Place --
-- - Suite 330,  Boston, MA 02111-1307, USA.                                --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  Ada Core Technologies Inc --
-- (http://www.gnat.com).                                                   --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Calendar;       use Ada.Calendar;
--  ???  do we really need Ada.Calendar and the Time_Stamp function for
--  ???  compilation units here???

with Asis.Extensions;    use Asis.Extensions;

package Asis.Set_Get is
--  !!!??? This file is '-gnatg-compilable', but both its content and its
--  !!!???  documentation need revising

--  This package contains the interface routines for setting and getting
--  the values of the internal components of the main ASIS abstractions -
--  Context, Compilation_Unit and Element. All the operations for getting
--  components are defined as functions, but the operations for obtaining
--  the tree nodes from an Element value may change the tree being accessed,
--  which should be considered as the side effect.

--  THE DOCUMENTATION IS INCOMPLETE!!!!!

   -------------
   -- CONTEXT --
   -------------

   -------------------------------------
   -- Id <-> ASIS Context conversions --
   -------------------------------------

   function Get_Cont_Id (C  : Context)    return Context_Id;
   function Get_Cont    (Id : Context_Id) return Context;

   procedure Set_Cont   (C  : out Context; Id : Context_Id);
   --  Assigns the value of Id to the Id fields of a given variable C
   --  of the Asis Context type

   pragma Inline (Get_Cont_Id);
   pragma Inline (Get_Cont);

   --------------------------------
   -- Getting Context Attributes --
   --------------------------------

   function Valid (C : Context) return Boolean;
   --  checks if its argument is an opened (=valid) Context
   --  DO WE REALLY NEED THIS FUNCTION??

----------------------
-- COMPILATION_UNIT --
----------------------

   ----------------------------------------------
   -- Id <-> ASIS Compilation Unit conversions --
   ----------------------------------------------

   function Get_Unit_Id   (C_U : Compilation_Unit) return Unit_Id;

   function Get_Comp_Unit
     (U  : Unit_Id;
      C  : Context_Id)
      return Compilation_Unit;
   --  this function creates the new value of the Compilation_Unit
   --  type; note, that it also sets the field Obtained as equal to
   --  the current OS time

   function Get_Comp_Unit_List
     (U_List : Unit_Id_List;
      C      : Context_Id)
      return Compilation_Unit_List;
   --  Creates the ASIS Compilation Unit List from the list of unit Ids

   pragma Inline (Get_Unit_Id);
   pragma Inline (Get_Comp_Unit);

   -----------------------------------------
   -- Getting Compilation Unit Attributes --
   -----------------------------------------

   function Not_Nil (C_U : Compilation_Unit) return Boolean;
   --  Check if C_U /= Nil_Compilation_Unit (the name "Exists" is already
   --  busy in ASIS

   function Nil (C_U : Compilation_Unit) return Boolean;
   --  Check if C_U = Nil_Compilation_Unit

   function Is_Standard (C_U : Compilation_Unit) return Boolean;
   --  Check if C_U represents the predefined package Standard

   function Kind             (C_U : Compilation_Unit) return Asis.Unit_Kinds;
   function Class            (C_U : Compilation_Unit) return Unit_Classes;
   function Origin           (C_U : Compilation_Unit) return Unit_Origins;
   function Is_Main_Unit     (C_U : Compilation_Unit) return Boolean;
   function Top              (C_U : Compilation_Unit) return Node_Id;
   function Is_Body_Required (C_U : Compilation_Unit) return Boolean;
   function Unit_Name        (C_U : Compilation_Unit) return String;
   function Encl_Cont        (C_U : Compilation_Unit) return Context;
   function Encl_Cont_Id     (C_U : Compilation_Unit) return Context_Id;
   function Source_File      (C_U : Compilation_Unit) return String;
   function Ref_File         (C_U : Compilation_Unit) return String;
   function Context_Info     (C_U : Compilation_Unit) return String;
   function Time_Stamp       (C_U : Compilation_Unit) return Time;
   function Source_Status    (C_U : Compilation_Unit)
      return Source_File_Statuses;
   function Main_Tree        (C_U : Compilation_Unit) return Tree_Id;

   -------------------
   -- Miscellaneous --
   -------------------

   function "=" (Left, Right : Compilation_Unit) return Boolean;
   --  This function "re-implements" the equivalent-to-predefined
   --  compare operation for Compilation_Unit. It should never be used in
   --  any ASIS application code.

   function Valid (C_U : Compilation_Unit) return Boolean;
   --  checks, if the argument is valid, that is, if its enclosing
   --  Context is opened

   procedure Reset_Main_Tree (C_U : Compilation_Unit);
   --  If C_U is a main unit in some tree, this procedure resets
   --  this tree, otherwise it does nothing. This procedure does not
   --  reset the context, it should be done by a caller.

   pragma Inline (Not_Nil);
   pragma Inline (Nil);
   pragma Inline (Is_Standard);
   pragma Inline (Kind);
   pragma Inline (Class);
   pragma Inline (Origin);
   pragma Inline (Is_Main_Unit);
   pragma Inline (Top);
   pragma Inline (Is_Body_Required);
   pragma Inline (Unit_Name);
   pragma Inline (Encl_Cont);
   pragma Inline (Encl_Cont_Id);
   pragma Inline (Valid);

   --  THIS "INLINE" LIST IS INCOMPLETE!!!

-------------
-- ELEMENT --
-------------

   function "=" (Left, Right : Element) return Boolean;
   --  This function "re-implements" the equivalent-to-predefined
   --  compare operation for Elements. It should never be used in
   --  any ASIS application code.

   ---------
   -- Get --
   ---------

   function Node               (E : Element) return Node_Id;
   function R_Node             (E : Element) return Node_Id;
   function Node_Field_1       (E : Element) return Node_Id;
   function Node_Value         (E : Element) return Node_Id;
   function R_Node_Value       (E : Element) return Node_Id;
   function Node_Field_1_Value (E : Element) return Node_Id;
   --  Node, R_Node and Node_Field_1 reset the tree when returning
   --  the node value in a way that the returned node will be the
   --  proper node value for the tree being accessed by ASIS,
   --  whereas Node_Value, R_Node_Value and Node_Field_1_Value
   --  just return the node value without changing the currently
   --  accessed tree

   function Encl_Unit         (E : Element) return Compilation_Unit;
   function Encl_Unit_Id      (E : Element) return Unit_Id;
   function Encl_Cont         (E : Element) return Context;
   function Encl_Cont_Id      (E : Element) return Context_Id;
   function Kind              (E : Element) return Asis.Element_Kinds;
   function Int_Kind          (E : Element) return Internal_Element_Kinds;
   function Is_From_Implicit  (E : Element) return Boolean;
   function Is_From_Inherited (E : Element) return Boolean;
   function Is_From_Instance  (E : Element) return Boolean;
   function Special_Case      (E : Element) return Special_Cases;
   function Encl_Tree         (E : Element) return Tree_Id;
   function Rel_Sloc          (E : Element) return Source_Ptr;
   function Character_Code    (E : Element) return Char_Code;
   function Obtained          (E : Element) return ASIS_OS_Time;

   function Location      (E : Asis.Element) return Source_Ptr;
   --  this function returns not relative (as Rel_Sloc does), but
   --  "absolute" location of the source position corresponding
   --  to the Node on which E is based. This function is
   --  "tree-swapping-safe"

   function Valid             (E : Element) return Boolean;
   --  checks, if the argument is valid, that is, if the enclosing
   --  Context of its enclosing Unit is opened

   function Is_Stat_Expr (E : Element) return Boolean;  --  ???
   --  needed for temporary fix for "+" (1, 2) problem

   pragma Inline (Node);
   pragma Inline (R_Node);
   pragma Inline (Encl_Unit);
   pragma Inline (Encl_Unit_Id);
   pragma Inline (Encl_Cont);
   pragma Inline (Encl_Cont_Id);
   pragma Inline (Kind);
   pragma Inline (Int_Kind);
   pragma Inline (Is_From_Implicit);
   pragma Inline (Is_From_Inherited);
   pragma Inline (Is_From_Instance);
   pragma Inline (Special_Case);
   pragma Inline (Encl_Tree);
   pragma Inline (Rel_Sloc);
   pragma Inline (Valid);

   ---------
   -- Set --
   ---------

   procedure Set_Node
      (E : in out Element; N : in Node_Id);
   procedure Set_Node_Field_1
      (E : in out Element; N : in Node_Id);
   procedure Set_Int_Kind
      (E : in out Element; K : in Internal_Element_Kinds);
   procedure Set_From_Implicit
      (E : in out Element; I : in Boolean := True);
   procedure Set_From_Inherited
      (E : in out Element; I : in Boolean := True);
   procedure Set_From_Instance
      (E : in out Element; I : in Boolean := True);
   procedure Set_Special_Case
      (E : in out Element; S : in Special_Cases);
   procedure Set_Character_Code
      (E : in out Element; C : in Char_Code);

   function Set_Element
     (Node         : Node_Id;
      R_Node       : Node_Id;
      Node_Field_1 : Node_Id;
      Encl_Unit    : Compilation_Unit;
      --  contains Ids for both Enclosing Compilation Unit and Enclosing
      --  Context
      Int_Kind  : Internal_Element_Kinds;
      Implicit  : Boolean;
      Inherited : Boolean;
      Instance  : Boolean;
      Spec_Case : Special_Cases;
      Stat_Expr : Boolean)
      return Element;
   --  Constructs and returns the ASIS Element value on the base of
   --  Element attributes
   --  Note, that it should not be any parameter passed for the
   --  Enclosing_Tree field, because this field should be set equal
   --  to the Id of the tree being currently accessed!
   --  Note also, that it should not be any parameter passed for the
   --  Rel_Scr field, because this field should be computed as the
   --  difference between the source location of the node upon
   --  the given element is to be built (that is, passed as the
   --  actual for the Node parameter, and the top node of the
   --  Element's enclosing Unit.
   --
   --  It is supposed, that this function is called as the part of the
   --  constructing of the new element during processing some ASIS
   --  query, so the actuals for Node, R_Node and the current setting of
   --  the top node for the Unit pointed by Encl_Unit are consistent.
   --  See also A4G.Mapping (body).

   -----------------------------------------------------------
   -- Special processing for Elements representing root and --
   -- universal numeric types in ASIS                       --
   -----------------------------------------------------------

   function Set_Root_Type_Declaration
     (Int_Kind : Internal_Element_Kinds;
      Cont     : Context_Id)
      return Element;
   --  Constructs and returns the ASIS Element representing the declaration
   --  of a root or universal numeric type. If an actual for Int_Kind does
   --  not belong to Internal_Root_Type_Kinds, Nil_Element is returned.
   --  Otherwise the child element of the result returned by the
   --  Type_Declaration_View function should be of Int_Kind kind.
   --  Every opened Context contains exactly one Element representing
   --  the declaration of a given root or universal numeric type.
   --  These elements (as well as their child elements) have no Node to
   --  be based upon (they simply do not need such a Node), they are
   --  implicit declarations located in the predefined Standard package.

   function Is_Root_Num_Type (Declaration : Asis.Declaration) return Boolean;
   --  Checks if Declaration is A_Type_Declaration Element representing
   --   the declaration of a root or universal numeric type.

   function Root_Type_Definition
     (Declaration : Asis.Declaration)
      return Asis.Definition;
   --  Transforms A_Type_Declaration Element representing the declaration
   --  of a root or universal numeric type into the corresponding type
   --  definition (being of Root_Type_Kinds). This function does not
   --  check if its argument really represents the declaration of a root
   --  or universal numeric type

end Asis.Set_Get