[Ada] Revise Storage_Model_Support operations to do checks and take objects and types
The functions in subpackage Storage_Model_Support (apart from the Has_*_Aspect functions) are revised to have assertions that will fail when passed a parameter that doesn't specify the appropriate aspect (either aspect Storage_Model_Type or Designated_Storage_Model), instead of returning Empty for bad arguments. Also, various of the functions now allow either a type with aspect Storage_Model_Type or an object of such a type. gcc/ada/ * sem_util.ads (Storage_Model_Support): Revise comments on most operations within this nested package to reflect that they can now be passed either a type that has aspect Storage_Model_Type or an object of such a type. Change the names of the relevant formals to SM_Obj_Or_Type. Also, add more precise semantic descriptions in some cases, and declare the subprograms in a more logical order. * sem_util.adb (Storage_Model_Support.Storage_Model_Object): Add an assertion that the type must specify aspect Designated_Storage_Model, rather than returning Empty when it doesn't specify that aspect. (Storage_Model_Support.Storage_Model_Type): Add an assertion that formal must be an object whose type specifies aspect Storage_Model_Type, rather than returning Empty for when it doesn't have such a type (and test Has_Storage_Model_Type_Aspect rather than Find_Value_Of_Aspect). (Storage_Model_Support.Get_Storage_Model_Type_Entity): Allow both objects and types, and add an assertion that the type (or the type of the object) has a value for aspect Storage_Model_Type.
This commit is contained in:
Gary Dismukes
Pierre-Marie de Rodat
parent
ae745a0de3
commit
21f8b41051
@ -32302,47 +32302,6 @@ package body Sem_Util is
|
||||
|
||||
package body Storage_Model_Support is
|
||||
|
||||
-----------------------------------
|
||||
-- Get_Storage_Model_Type_Entity --
|
||||
-----------------------------------
|
||||
|
||||
function Get_Storage_Model_Type_Entity
|
||||
(Typ : Entity_Id;
|
||||
Nam : Name_Id) return Entity_Id
|
||||
is
|
||||
pragma Assert
|
||||
(Is_Type (Typ)
|
||||
and then
|
||||
Nam in Name_Address_Type
|
||||
| Name_Null_Address
|
||||
| Name_Allocate
|
||||
| Name_Deallocate
|
||||
| Name_Copy_From
|
||||
| Name_Copy_To
|
||||
| Name_Storage_Size);
|
||||
|
||||
SMT_Aspect_Value : constant Node_Id :=
|
||||
Find_Value_Of_Aspect (Typ, Aspect_Storage_Model_Type);
|
||||
Assoc : Node_Id;
|
||||
|
||||
begin
|
||||
if No (SMT_Aspect_Value) then
|
||||
return Empty;
|
||||
|
||||
else
|
||||
Assoc := First (Component_Associations (SMT_Aspect_Value));
|
||||
while Present (Assoc) loop
|
||||
if Chars (First (Choices (Assoc))) = Nam then
|
||||
return Entity (Expression (Assoc));
|
||||
end if;
|
||||
|
||||
Next (Assoc);
|
||||
end loop;
|
||||
|
||||
return Empty;
|
||||
end if;
|
||||
end Get_Storage_Model_Type_Entity;
|
||||
|
||||
-----------------------------------------
|
||||
-- Has_Designated_Storage_Model_Aspect --
|
||||
-----------------------------------------
|
||||
@ -32370,13 +32329,11 @@ package body Sem_Util is
|
||||
|
||||
function Storage_Model_Object (Typ : Entity_Id) return Entity_Id is
|
||||
begin
|
||||
if Has_Designated_Storage_Model_Aspect (Typ) then
|
||||
return
|
||||
Entity
|
||||
(Find_Value_Of_Aspect (Typ, Aspect_Designated_Storage_Model));
|
||||
else
|
||||
return Empty;
|
||||
end if;
|
||||
pragma Assert (Has_Designated_Storage_Model_Aspect (Typ));
|
||||
|
||||
return
|
||||
Entity
|
||||
(Find_Value_Of_Aspect (Typ, Aspect_Designated_Storage_Model));
|
||||
end Storage_Model_Object;
|
||||
|
||||
------------------------
|
||||
@ -32385,76 +32342,132 @@ package body Sem_Util is
|
||||
|
||||
function Storage_Model_Type (Obj : Entity_Id) return Entity_Id is
|
||||
begin
|
||||
if Present
|
||||
(Find_Value_Of_Aspect (Etype (Obj), Aspect_Storage_Model_Type))
|
||||
then
|
||||
return Etype (Obj);
|
||||
else
|
||||
return Empty;
|
||||
end if;
|
||||
pragma Assert (Has_Storage_Model_Type_Aspect (Etype (Obj)));
|
||||
|
||||
return Etype (Obj);
|
||||
end Storage_Model_Type;
|
||||
|
||||
-----------------------------------
|
||||
-- Get_Storage_Model_Type_Entity --
|
||||
-----------------------------------
|
||||
|
||||
function Get_Storage_Model_Type_Entity
|
||||
(SM_Obj_Or_Type : Entity_Id;
|
||||
Nam : Name_Id) return Entity_Id
|
||||
is
|
||||
Typ : constant Entity_Id := (if Is_Object (SM_Obj_Or_Type) then
|
||||
Storage_Model_Type (SM_Obj_Or_Type)
|
||||
else
|
||||
SM_Obj_Or_Type);
|
||||
pragma Assert
|
||||
(Is_Type (Typ)
|
||||
and then
|
||||
Nam in Name_Address_Type
|
||||
| Name_Null_Address
|
||||
| Name_Allocate
|
||||
| Name_Deallocate
|
||||
| Name_Copy_From
|
||||
| Name_Copy_To
|
||||
| Name_Storage_Size);
|
||||
|
||||
Assoc : Node_Id;
|
||||
SMT_Aspect_Value : constant Node_Id :=
|
||||
Find_Value_Of_Aspect (Typ, Aspect_Storage_Model_Type);
|
||||
|
||||
begin
|
||||
pragma Assert (Present (SMT_Aspect_Value));
|
||||
|
||||
Assoc := First (Component_Associations (SMT_Aspect_Value));
|
||||
while Present (Assoc) loop
|
||||
if Chars (First (Choices (Assoc))) = Nam then
|
||||
return Entity (Expression (Assoc));
|
||||
end if;
|
||||
|
||||
Next (Assoc);
|
||||
end loop;
|
||||
|
||||
return Empty;
|
||||
end Get_Storage_Model_Type_Entity;
|
||||
|
||||
--------------------------------
|
||||
-- Storage_Model_Address_Type --
|
||||
--------------------------------
|
||||
|
||||
function Storage_Model_Address_Type (Typ : Entity_Id) return Entity_Id is
|
||||
function Storage_Model_Address_Type
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id
|
||||
is
|
||||
begin
|
||||
return Get_Storage_Model_Type_Entity (Typ, Name_Address_Type);
|
||||
return
|
||||
Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Address_Type);
|
||||
end Storage_Model_Address_Type;
|
||||
|
||||
--------------------------------
|
||||
-- Storage_Model_Null_Address --
|
||||
--------------------------------
|
||||
|
||||
function Storage_Model_Null_Address (Typ : Entity_Id) return Entity_Id is
|
||||
function Storage_Model_Null_Address
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id
|
||||
is
|
||||
begin
|
||||
return Get_Storage_Model_Type_Entity (Typ, Name_Null_Address);
|
||||
return
|
||||
Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Null_Address);
|
||||
end Storage_Model_Null_Address;
|
||||
|
||||
----------------------------
|
||||
-- Storage_Model_Allocate --
|
||||
----------------------------
|
||||
|
||||
function Storage_Model_Allocate (Typ : Entity_Id) return Entity_Id is
|
||||
function Storage_Model_Allocate
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id
|
||||
is
|
||||
begin
|
||||
return Get_Storage_Model_Type_Entity (Typ, Name_Allocate);
|
||||
return Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Allocate);
|
||||
end Storage_Model_Allocate;
|
||||
|
||||
------------------------------
|
||||
-- Storage_Model_Deallocate --
|
||||
------------------------------
|
||||
|
||||
function Storage_Model_Deallocate (Typ : Entity_Id) return Entity_Id is
|
||||
function Storage_Model_Deallocate
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id
|
||||
is
|
||||
begin
|
||||
return Get_Storage_Model_Type_Entity (Typ, Name_Deallocate);
|
||||
return
|
||||
Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Deallocate);
|
||||
end Storage_Model_Deallocate;
|
||||
|
||||
-----------------------------
|
||||
-- Storage_Model_Copy_From --
|
||||
-----------------------------
|
||||
|
||||
function Storage_Model_Copy_From (Typ : Entity_Id) return Entity_Id is
|
||||
function Storage_Model_Copy_From
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id
|
||||
is
|
||||
begin
|
||||
return Get_Storage_Model_Type_Entity (Typ, Name_Copy_From);
|
||||
return Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Copy_From);
|
||||
end Storage_Model_Copy_From;
|
||||
|
||||
---------------------------
|
||||
-- Storage_Model_Copy_To --
|
||||
---------------------------
|
||||
|
||||
function Storage_Model_Copy_To (Typ : Entity_Id) return Entity_Id is
|
||||
function Storage_Model_Copy_To
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id
|
||||
is
|
||||
begin
|
||||
return Get_Storage_Model_Type_Entity (Typ, Name_Copy_To);
|
||||
return Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Copy_To);
|
||||
end Storage_Model_Copy_To;
|
||||
|
||||
--------------------------------
|
||||
-- Storage_Model_Storage_Size --
|
||||
--------------------------------
|
||||
|
||||
function Storage_Model_Storage_Size (Typ : Entity_Id) return Entity_Id is
|
||||
function Storage_Model_Storage_Size
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id
|
||||
is
|
||||
begin
|
||||
return Get_Storage_Model_Type_Entity (Typ, Name_Storage_Size);
|
||||
return
|
||||
Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Storage_Size);
|
||||
end Storage_Model_Storage_Size;
|
||||
|
||||
end Storage_Model_Support;
|
||||
|
||||
@ -3591,68 +3591,78 @@ package Sem_Util is
|
||||
-- for the Storage_Model feature. These functions provide an interface
|
||||
-- that the compiler (in particular back-end phases such as gigi and
|
||||
-- GNAT-LLVM) can use to easily obtain entities and operations that
|
||||
-- are specified for types in the aspects Storage_Model_Type and
|
||||
-- are specified for types that have aspects Storage_Model_Type or
|
||||
-- Designated_Storage_Model.
|
||||
|
||||
function Get_Storage_Model_Type_Entity
|
||||
(Typ : Entity_Id;
|
||||
Nam : Name_Id) return Entity_Id;
|
||||
-- Given type Typ with aspect Storage_Model_Type, returns the Entity_Id
|
||||
-- corresponding to the entity associated with Nam in the aspect. If the
|
||||
-- type does not specify the aspect, or such an entity is not present,
|
||||
-- then returns Empty. (Note: This function is modeled on function
|
||||
-- Get_Iterable_Type_Primitive.)
|
||||
function Has_Storage_Model_Type_Aspect (Typ : Entity_Id) return Boolean;
|
||||
-- Returns True iff Typ specifies aspect Storage_Model_Type
|
||||
|
||||
function Has_Designated_Storage_Model_Aspect
|
||||
(Typ : Entity_Id) return Boolean;
|
||||
-- Returns True iff Typ specifies aspect Designated_Storage_Model
|
||||
|
||||
function Has_Storage_Model_Type_Aspect (Typ : Entity_Id) return Boolean;
|
||||
-- Returns True iff Typ specifies aspect Storage_Model_Type
|
||||
|
||||
function Storage_Model_Object (Typ : Entity_Id) return Entity_Id;
|
||||
-- Given an access type with aspect Designated_Storage_Model, returns
|
||||
-- the storage-model object associated with that type; returns Empty
|
||||
-- if there is no associated object.
|
||||
-- Given an access type Typ with aspect Designated_Storage_Model,
|
||||
-- returns the storage-model object associated with that type.
|
||||
-- The object Entity_Ids returned by this function can be passed
|
||||
-- other functions declared in this interface to retrieve operations
|
||||
-- associated with Storage_Model_Type aspect of the object's type.
|
||||
|
||||
function Storage_Model_Type (Obj : Entity_Id) return Entity_Id;
|
||||
-- Given an object Obj of a type specifying aspect Storage_Model_Type,
|
||||
-- returns that type; otherwise returns Empty.
|
||||
-- returns that type.
|
||||
|
||||
function Storage_Model_Address_Type (Typ : Entity_Id) return Entity_Id;
|
||||
-- Given a type Typ that specifies aspect Storage_Model_Type, returns
|
||||
-- the type specified for the Address_Type choice in that aspect;
|
||||
-- returns Empty if the aspect or the type isn't specified.
|
||||
function Get_Storage_Model_Type_Entity
|
||||
(SM_Obj_Or_Type : Entity_Id;
|
||||
Nam : Name_Id) return Entity_Id;
|
||||
-- Given a type with aspect Storage_Model_Type or an object of such a
|
||||
-- type, and Nam denoting the name of one of the argument kinds allowed
|
||||
-- for that aspect, returns the Entity_Id corresponding to the entity
|
||||
-- associated with Nam in the aspect. If such an entity is not present,
|
||||
-- then returns Empty. (Note: This function is modeled on function
|
||||
-- Get_Iterable_Type_Primitive.)
|
||||
|
||||
function Storage_Model_Null_Address (Typ : Entity_Id) return Entity_Id;
|
||||
-- Given a type Typ that specifies aspect Storage_Model_Type, returns
|
||||
-- constant specified for Null_Address choice in that aspect; returns
|
||||
-- Empty if the aspect or the constant object isn't specified.
|
||||
function Storage_Model_Address_Type
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id;
|
||||
-- Given a type with aspect Storage_Model_Type or an object of such a
|
||||
-- type, returns the type specified for the Address_Type choice in that
|
||||
-- aspect; returns Empty if the type isn't specified.
|
||||
|
||||
function Storage_Model_Allocate (Typ : Entity_Id) return Entity_Id;
|
||||
-- Given a type Typ that specifies aspect Storage_Model_Type, returns
|
||||
-- procedure specified for the Allocate choice in that aspect; returns
|
||||
-- Empty if the aspect or the procedure isn't specified.
|
||||
function Storage_Model_Null_Address
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id;
|
||||
-- Given a type with aspect Storage_Model_Type or an object of such a
|
||||
-- type, returns the constant specified for the Null_Address choice in
|
||||
-- that aspect; returns Empty if the constant object isn't specified.
|
||||
|
||||
function Storage_Model_Deallocate (Typ : Entity_Id) return Entity_Id;
|
||||
-- Given a type Typ that specifies aspect Storage_Model_Type, returns
|
||||
-- procedure specified for the Deallocate choice in that aspect; returns
|
||||
-- Empty if the aspect or the procedure isn't specified.
|
||||
function Storage_Model_Allocate
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id;
|
||||
-- Given a type with aspect Storage_Model_Type or an object of such a
|
||||
-- type, returns the procedure specified for the Allocate choice in that
|
||||
-- aspect; returns Empty if the procedure isn't specified.
|
||||
|
||||
function Storage_Model_Copy_From (Typ : Entity_Id) return Entity_Id;
|
||||
-- Given a type Typ that specifies aspect Storage_Model_Type, returns
|
||||
-- procedure specified for the Copy_From choice in that aspect; returns
|
||||
-- Empty if the aspect or the procedure isn't specified.
|
||||
function Storage_Model_Deallocate
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id;
|
||||
-- Given a type with aspect Storage_Model_Type or an object of such a
|
||||
-- type, returns the procedure specified for the Deallocate choice in
|
||||
-- that aspect; returns Empty if the procedure isn't specified.
|
||||
|
||||
function Storage_Model_Copy_To (Typ : Entity_Id) return Entity_Id;
|
||||
-- Given a type Typ that specifies aspect Storage_Model_Type, returns
|
||||
-- procedure specified for the Copy_To choice in that aspect; returns
|
||||
-- Empty if the aspect or the procedure isn't specified.
|
||||
function Storage_Model_Copy_From
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id;
|
||||
-- Given a type with aspect Storage_Model_Type or an object of such a
|
||||
-- type, returns the procedure specified for the Copy_From choice in
|
||||
-- that aspect; returns Empty if the procedure isn't specified.
|
||||
|
||||
function Storage_Model_Storage_Size (Typ : Entity_Id) return Entity_Id;
|
||||
-- Given a type Typ that specifies aspect Storage_Model_Type, returns
|
||||
-- function specified for Storage_Size choice in that aspect; returns
|
||||
-- Empty if the aspect or the procedure isn't specified.
|
||||
function Storage_Model_Copy_To
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id;
|
||||
-- Given a type with aspect Storage_Model_Type or an object of such a
|
||||
-- type, returns the procedure specified for the Copy_To choice in that
|
||||
-- aspect; returns Empty if the procedure isn't specified.
|
||||
|
||||
function Storage_Model_Storage_Size
|
||||
(SM_Obj_Or_Type : Entity_Id) return Entity_Id;
|
||||
-- Given a type with aspect Storage_Model_Type or an object of such a
|
||||
-- type, returns the function specified for the Storage_Size choice in
|
||||
-- that aspect; returns Empty if the procedure isn't specified.
|
||||
|
||||
end Storage_Model_Support;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user