File : asis-clauses.adb


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                          A S I S . C L A U S E S                         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            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 Asis.Exceptions; use Asis.Exceptions;

with Asis.Set_Get;
use  Asis.Set_Get;

with A4G.Int_Knds; use A4G.Int_Knds;
with A4G.Mapping;  use A4G.Mapping;
with A4G.Vcheck;   use A4G.Vcheck;

with Types;    use Types;
with Sinfo;    use Sinfo;
with Nlists;   use Nlists;
with Snames;   use Snames;
with Atree;    use Atree;

package body Asis.Clauses is

   ------------------
   -- Clause_Names --
   ------------------

   function Clause_Names (Clause : Asis.Element) return Asis.Element_List is
      Arg_Kind     : Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node     : Node_Id;
      Result_List  : List_Id;
      Result_Len   : Natural := 1;
      Withed_Uname : Node_Id;
   begin
      Check_Validity (Clause, "Asis.Clauses.Clause_Names");

      if not (Arg_Kind = A_Use_Package_Clause or else
              Arg_Kind = A_Use_Type_Clause    or else
              Arg_Kind = A_With_Clause)
      then
         Raise_ASIS_Inappropriate_Element ("Asis.Clauses.Clause_Names");
      end if;

      Arg_Node := Node (Clause);

      if Arg_Kind = A_With_Clause then
         --  first, computing the number of names listed in the argument
         --  with clause
         while not Last_Name (Arg_Node) loop
            Result_Len   := Result_Len + 1;
            Arg_Node     := Next (Arg_Node);
         end loop;

         declare
            Result_List : Asis.Element_List (1 .. Result_Len);
         begin
            Arg_Node := Node (Clause);

            for I in 1 .. Result_Len loop
               Withed_Uname := Sinfo.Name (Arg_Node);

               Result_List (I) := Node_To_Element_New
                  (Starting_Element => Clause,
                   Node             => Withed_Uname);
               Arg_Node     := Next (Arg_Node);

            end loop;

            return Result_List;
         end;
      else
         if Nkind (Arg_Node) = N_Use_Package_Clause then
            Result_List := Names (Arg_Node);
         else
            Result_List := Subtype_Marks (Arg_Node);
         end if;

         return  N_To_E_List_New (List             => Result_List,
                                  Starting_Element => Clause);
      end if;

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Clause,
            Outer_Call => "Asis.Clauses.Clause_Names");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Clause,
            Diagnosis => "Asis.Clauses.Clause_Names");
   end Clause_Names;

   -------------------------------
   -- Component_Clause_Position --
   -------------------------------

   function Component_Clause_Position (Clause : in Asis.Component_Clause)
      return Asis.Expression
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Clause, "Asis.Clauses.Component_Clause_Position");

      if not (Arg_Kind = A_Component_Clause) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Clauses.Component_Clause_Position");
      end if;

      Arg_Node := Node (Clause);

      return Node_To_Element (Node    => Position (Arg_Node),
                              In_Unit => Encl_Unit  (Clause));

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Clause,
            Outer_Call => "Asis.Clauses.Component_Clause_Position");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Clause,
            Diagnosis => "Asis.Clauses.Component_Clause_Position");
   end Component_Clause_Position;

   ----------------------------
   -- Component_Clause_Range --
   ----------------------------

   function Component_Clause_Range
     (Clause : in Asis.Component_Clause)
      return Asis.Discrete_Range
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Clause, "Asis.Clauses.Component_Clause_Range");

      if not (Arg_Kind = A_Component_Clause) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Clauses.Component_Clause_Range");
      end if;

      Arg_Node := Node (Clause);

      return Node_To_Element
               (Node          => Arg_Node,
                Internal_Kind => A_Discrete_Simple_Expression_Range,
                In_Unit       => Encl_Unit  (Clause));

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Clause,
            Outer_Call => "Asis.Clauses.Component_Clause_Range");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Clause,
            Diagnosis => "Asis.Clauses.Component_Clause_Range");

   end Component_Clause_Range;

   -----------------------
   -- Component_Clauses --
   -----------------------

   function Component_Clauses
     (Clause          : in Asis.Representation_Clause;
      Include_Pragmas : in Boolean := False)
      return Asis.Component_Clause_List
   is
      Arg_Kind        : Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node        : Node_Id;
   begin

      Check_Validity (Clause, "Asis.Clauses.Component_Clauses");

      if not (Arg_Kind = A_Record_Representation_Clause) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Clauses.Component_Clauses");
      end if;

      Arg_Node := Node (Clause);

      if Include_Pragmas then

         return Node_To_Element_List
                  (List    => Component_Clauses (Arg_Node),
                   In_Unit => Encl_Unit (Clause));

      else
         return Node_To_Element_List
                  (List           => Component_Clauses (Arg_Node),
                   In_Unit        => Encl_Unit (Clause),
                   To_Be_Included => No_Pragma'Access);
      end if;

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Clause,
            Outer_Call => "Asis.Clauses.Component_Clauses",
            Bool_Par   => Include_Pragmas);
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument   => Clause,
            Diagnosis => "Asis.Clauses.Component_Clauses",
            Bool_Par   => Include_Pragmas);
   end Component_Clauses;

   ---------------------------
   -- Mod_Clause_Expression --
   ---------------------------

   function Mod_Clause_Expression (Clause : in Asis.Representation_Clause)
      return Asis.Expression
   is
      Arg_Kind        : Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node        : Node_Id;
      Mod_Clause_Node : Node_Id;
   begin

      Check_Validity (Clause, "Asis.Clauses.Mod_Clause_Expression");

      if not (Arg_Kind = A_Record_Representation_Clause) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Clauses.Mod_Clause_Expression");
      end if;

      Arg_Node := Node (Clause);

      Mod_Clause_Node := Mod_Clause (Arg_Node);

      if No (Mod_Clause_Node) then
         return Asis.Nil_Element;
      else
         return Node_To_Element (Node    => Sinfo.Expression (Mod_Clause_Node),
                                 In_Unit => Encl_Unit  (Clause));
      end if;

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Clause,
            Outer_Call => "Asis.Clauses.Mod_Clause_Expression");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Clause,
            Diagnosis => "Asis.Clauses.Mod_Clause_Expression");
   end Mod_Clause_Expression;

   --------------------------------------
   -- Representation_Clause_Expression --
   --------------------------------------

   function Representation_Clause_Expression
     (Clause : in Asis.Representation_Clause)
      return Asis.Expression
   is
      Arg_Kind    : Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node    : Node_Id;
      Result_Node : Node_Id;
      Result_Kind : Internal_Element_Kinds;
   begin

      Check_Validity (Clause,
                     "Asis.Clauses.Representation_Clause_Expression");

      if not (Arg_Kind = An_Attribute_Definition_Clause       or else
              Arg_Kind = An_Enumeration_Representation_Clause or else
              Arg_Kind = An_At_Clause)
      then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Clauses.Representation_Clause_Expression");
      end if;

      Arg_Node := Node (Clause);

      if Nkind (Arg_Node) = N_Enumeration_Representation_Clause then
         Result_Node := Array_Aggregate (Arg_Node);

         --  we cannot use the general Node_To_Element function here -
         --  it makes use the Entity field, but this field is not set
         --  for N_Aggregate node in this case!
         --  We can be sure, that Result_Node is of N_Aggregate here.

         if Present (Expressions (Result_Node)) then
               Result_Kind := A_Positional_Array_Aggregate;
         else
            Result_Kind := A_Named_Array_Aggregate;
         end if;

         return Node_To_Element (Node          => Result_Node,
                                 Internal_Kind => Result_Kind,
                                 In_Unit       => Encl_Unit  (Clause));
      else
         Result_Node := Sinfo.Expression (Arg_Node);
      end if;

      return Node_To_Element (Node    => Result_Node,
                              In_Unit => Encl_Unit  (Clause));

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Clause,
            Outer_Call => "Asis.Clauses.Representation_Clause_Expression");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Clause,
            Diagnosis => "Asis.Clauses.Representation_Clause_Expression");

   end Representation_Clause_Expression;

   --------------------------------
   -- Representation_Clause_Name --
   --------------------------------

   function Representation_Clause_Name
     (Clause : in Asis.Clause)
      return Asis.Name
   is
      Arg_Kind       : Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node       : Node_Id;
      Result_Node    : Node_Id;

      Result_Element : Element;
      Result_Kind    : Internal_Element_Kinds;
      Attr_Des       : Name_Id;
      --  needed for special processing of attribute definition clause
   begin

      Check_Validity (Clause, "Asis.Clauses.Representation_Clause_Name");

      if not (Arg_Kind = An_Attribute_Definition_Clause       or else
              Arg_Kind = An_Enumeration_Representation_Clause or else
              Arg_Kind = A_Record_Representation_Clause       or else
              Arg_Kind = An_At_Clause                         or else
              Arg_Kind = A_Component_Clause)
      then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Clauses.Representation_Clause_Name");
      end if;

      Arg_Node := Node (Clause);

      if Nkind (Arg_Node) = N_Attribute_Definition_Clause then
         --  for An_Attribute_Definition_Clause argument we have to return
         --  as the result the Element of An_Attribute_Reference kind.
         --  The tree does not contain the structures for attribute reference
         --  in this case (and it should not, because, according to RM 95,
         --  there is no attribute reference in the syntax structure of
         --  an attribute definition clause, so we have to "emulate"
         --  the result Elemet of An_Attribute_Reference kind on the base
         --  of the same node

         --  first, we have to define the exact kind of the "artificial"
         --  attribute reference to be returned
         Attr_Des := Chars (Arg_Node);

         case Attr_Des is
            when Name_Address =>
               Result_Kind := An_Address_Attribute;
            when Name_Alignment =>
               Result_Kind := An_Alignment_Attribute;
            when Name_Bit_Order =>
               Result_Kind := A_Bit_Order_Attribute;
            when Name_Component_Size =>
               Result_Kind := A_Component_Size_Attribute;
            when Name_External_Tag =>
               Result_Kind := An_External_Tag_Attribute;
            when Name_Input =>
               Result_Kind := An_Input_Attribute;
            when Name_Machine_Radix =>
               Result_Kind := A_Machine_Radix_Attribute;
            when Name_Output =>
               Result_Kind := An_Output_Attribute;
            when Name_Read =>
               Result_Kind := A_Read_Attribute;
            when Name_Size =>
               Result_Kind := A_Size_Attribute;
            when Name_Small =>
               Result_Kind := A_Small_Attribute;
            when Name_Storage_Size =>
               Result_Kind := A_Storage_Size_Attribute;
            when Name_Storage_Pool =>
               Result_Kind := A_Storage_Pool_Attribute;
            when Name_Write =>
               Result_Kind := A_Write_Attribute;
            when others =>
               --  "others" means Name_Object_Size and Name_Value_Size
               Result_Kind := An_Implementation_Defined_Attribute;
         end case;

         Result_Element := Clause;
         Set_Int_Kind (Result_Element, Result_Kind);

         return Result_Element;

      elsif Nkind (Arg_Node) = N_Component_Clause then
         Result_Node := Component_Name (Arg_Node);
      else
         Result_Node := Sinfo.Identifier (Arg_Node);
      end if;

      return Node_To_Element (Node    => Result_Node,
                               In_Unit => Encl_Unit  (Clause));

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Clause,
            Outer_Call => "Asis.Clauses.Representation_Clause_Name");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Clause,
            Diagnosis => "Asis.Clauses.Representation_Clause_Name");
   end Representation_Clause_Name;

end Asis.Clauses