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