knows the lower bound of unconstrained array formals when the formal's
subtype has index ranges with static fixed lower bounds.
+* Prefixed-view notation for calls to primitive subprograms of untagged types
+
+ Since Ada 2005, calls to primitive subprograms of a tagged type that
+ have a "prefixed view" (see RM 4.1.3(9.2)) have been allowed to be
+ written using the form of a selected_component, with the first actual
+ parameter given as the prefix and the name of the subprogram as a
+ selector. This prefixed-view notation for calls is extended so as to
+ also allow such syntax for calls to primitive subprograms of untagged
+ types. The primitives of an untagged type T that have a prefixed view
+ are those where the first formal parameter of the subprogram either
+ is of type T or is an anonymous access parameter whose designated type
+ is T. For a type that has a component that happens to have the same
+ simple name as one of the type's primitive subprograms, where the
+ component is visible at the point of a selected_component using that
+ name, preference is given to the component in a selected_component
+ (as is currently the case for tagged types with such component names).
+
.. _Pragma-Extensions_Visible:
Pragma Extensions_Visible
-- Direct_Primitive_Operations
-- Defined in tagged types and subtypes (including synchronized types),
--- in tagged private types and in tagged incomplete types. Element list
--- of entities for primitive operations of the tagged type. Not defined
--- in untagged types. In order to follow the C++ ABI, entities of
--- primitives that come from source must be stored in this list in the
--- order of their occurrence in the sources. For incomplete types the
--- list is always empty.
--- When expansion is disabled the corresponding record type of a
--- synchronized type is not constructed. In that case, such types
+-- in tagged private types, and in tagged incomplete types. However, when
+-- Extensions_Allowed is True (-gnatX), also defined for untagged types
+-- (for support of the extension feature of prefixed calls for untagged
+-- types). This field is an element list of entities for primitive
+-- operations of the type. For incomplete types the list is always empty.
+-- In order to follow the C++ ABI, entities of primitives that come from
+-- source must be stored in this list in the order of their occurrence in
+-- the sources. When expansion is disabled, the corresponding record type
+-- of a synchronized type is not constructed. In that case, such types
-- carry this attribute directly.
-- Directly_Designated_Type
Sm (Contract, Node_Id),
Sm (Current_Use_Clause, Node_Id),
Sm (Derived_Type_Link, Node_Id),
+ Sm (Direct_Primitive_Operations, Elist_Id),
Sm (Predicates_Ignored, Flag),
Sm (Esize, Uint),
Sm (Finalize_Storage_Only, Flag, Base_Type_Only),
Ab (Signed_Integer_Kind, Integer_Kind,
(Sm (First_Entity, Node_Id)));
- Cc (E_Signed_Integer_Type, Signed_Integer_Kind,
+ Cc (E_Signed_Integer_Type, Signed_Integer_Kind);
-- Signed integer type, used for the anonymous base type of the
-- integer subtype created by an integer type declaration.
- (Sm (Direct_Primitive_Operations, Elist_Id,
- Pre => "Is_Tagged_Type (N)")));
Cc (E_Signed_Integer_Subtype, Signed_Integer_Kind);
-- Signed integer subtype, created by either an integer subtype or
Sm (No_Strict_Aliasing, Flag, Base_Type_Only),
Sm (Storage_Size_Variable, Node_Id, Impl_Base_Type_Only)));
- Cc (E_Access_Type, Access_Kind,
+ Cc (E_Access_Type, Access_Kind);
-- An access type created by an access type declaration with no all
-- keyword present. Note that the predefined type Any_Access, which
-- has E_Access_Type Ekind, is used to label NULL in the upwards pass
-- of type analysis, to be replaced by the true access type in the
-- downwards resolution pass.
- (Sm (Direct_Primitive_Operations, Elist_Id,
- Pre => "Is_Tagged_Type (N)")));
Cc (E_Access_Subtype, Access_Kind);
-- An access subtype created by a subtype declaration for any access
-- An array subtype, created by an explicit array subtype declaration,
-- or the use of an anonymous array subtype.
(Sm (Predicated_Parent, Node_Id),
- Sm (Direct_Primitive_Operations, Elist_Id,
- Pre => "Is_Tagged_Type (N)"),
Sm (First_Entity, Node_Id),
Sm (Static_Real_Or_String_Predicate, Node_Id)));
Ab (Class_Wide_Kind, Aggregate_Kind,
(Sm (C_Pass_By_Copy, Flag, Impl_Base_Type_Only),
- Sm (Direct_Primitive_Operations, Elist_Id,
- Pre => "Is_Tagged_Type (N)"),
Sm (Equivalent_Type, Node_Id),
Sm (First_Entity, Node_Id),
Sm (Has_Complex_Representation, Flag, Impl_Base_Type_Only),
Sm (C_Pass_By_Copy, Flag, Impl_Base_Type_Only),
Sm (Corresponding_Concurrent_Type, Node_Id),
Sm (Corresponding_Remote_Type, Node_Id),
- Sm (Direct_Primitive_Operations, Elist_Id,
- Pre => "Is_Tagged_Type (N)"),
Sm (Dispatch_Table_Wrappers, Elist_Id, Impl_Base_Type_Only),
Sm (First_Entity, Node_Id),
Sm (Has_Complex_Representation, Flag, Impl_Base_Type_Only),
Sm (Cloned_Subtype, Node_Id),
Sm (Corresponding_Remote_Type, Node_Id),
Sm (Predicated_Parent, Node_Id),
- Sm (Direct_Primitive_Operations, Elist_Id,
- Pre => "Is_Tagged_Type (N)"),
Sm (Dispatch_Table_Wrappers, Elist_Id, Impl_Base_Type_Only),
Sm (First_Entity, Node_Id),
Sm (Has_Complex_Representation, Flag, Impl_Base_Type_Only),
Sm (C_Pass_By_Copy, Flag, Impl_Base_Type_Only),
Sm (Component_Alignment, Component_Alignment_Kind, Base_Type_Only),
Sm (Corresponding_Remote_Type, Node_Id),
- Sm (Direct_Primitive_Operations, Elist_Id,
- Pre => "Is_Tagged_Type (N)"),
Sm (Has_Complex_Representation, Flag, Impl_Base_Type_Only),
Sm (Has_Pragma_Pack, Flag, Impl_Base_Type_Only),
Sm (Has_Record_Rep_Clause, Flag, Impl_Base_Type_Only),
Sm (Component_Alignment, Component_Alignment_Kind, Base_Type_Only),
Sm (Corresponding_Remote_Type, Node_Id),
Sm (Predicated_Parent, Node_Id),
- Sm (Direct_Primitive_Operations, Elist_Id,
- Pre => "Is_Tagged_Type (N)"),
Sm (Has_Complex_Representation, Flag, Impl_Base_Type_Only),
Sm (Has_Pragma_Pack, Flag, Impl_Base_Type_Only),
Sm (Has_Record_Rep_Clause, Flag, Impl_Base_Type_Only),
Cc (E_Private_Type, Private_Kind,
-- A private type, created by a private type declaration that has
-- neither the keyword limited nor the keyword tagged.
- (Sm (Direct_Primitive_Operations, Elist_Id,
- Pre => "Is_Tagged_Type (N)"),
- Sm (Scalar_Range, Node_Id),
+ (Sm (Scalar_Range, Node_Id),
Sm (Scope_Depth_Value, Uint)));
Cc (E_Private_Subtype, Private_Kind,
-- A subtype of a private type, created by a subtype declaration used
-- to declare a subtype of a private type.
- (Sm (Direct_Primitive_Operations, Elist_Id,
- Pre => "Is_Tagged_Type (N)"),
- Sm (Scope_Depth_Value, Uint)));
+ (Sm (Scope_Depth_Value, Uint)));
Cc (E_Limited_Private_Type, Private_Kind,
-- A limited private type, created by a private type declaration that
(Sm (Scope_Depth_Value, Uint)));
Ab (Incomplete_Kind, Incomplete_Or_Private_Kind,
- (Sm (Direct_Primitive_Operations, Elist_Id,
- Pre => "Is_Tagged_Type (N)"),
- Sm (Non_Limited_View, Node_Id)));
+ (Sm (Non_Limited_View, Node_Id)));
Cc (E_Incomplete_Type, Incomplete_Kind,
-- An incomplete type, created by an incomplete type declaration
Ab (Concurrent_Kind, Composite_Kind,
(Sm (Corresponding_Record_Type, Node_Id),
- Sm (Direct_Primitive_Operations, Elist_Id,
- Pre => "Is_Tagged_Type (N)"),
Sm (First_Entity, Node_Id),
Sm (First_Private_Entity, Node_Id),
Sm (Last_Entity, Node_Id),
improve the efficiency of indexing operations, since the compiler statically
knows the lower bound of unconstrained array formals when the formal’s
subtype has index ranges with static fixed lower bounds.
+
+@item
+Prefixed-view notation for calls to primitive subprograms of untagged types
+
+Since Ada 2005, calls to primitive subprograms of a tagged type that
+have a “prefixed view” (see RM 4.1.3(9.2)) have been allowed to be
+written using the form of a selected_component, with the first actual
+parameter given as the prefix and the name of the subprogram as a
+selector. This prefixed-view notation for calls is extended so as to
+also allow such syntax for calls to primitive subprograms of untagged
+types. The primitives of an untagged type T that have a prefixed view
+are those where the first formal parameter of the subprogram either
+is of type T or is an anonymous access parameter whose designated type
+is T. For a type that has a component that happens to have the same
+simple name as one of the type’s primitive subprograms, where the
+component is visible at the point of a selected_component using that
+name, preference is given to the component in a selected_component
+(as is currently the case for tagged types with such component names).
@end itemize
@node Pragma Extensions_Visible,Pragma External,Pragma Extensions_Allowed,Implementation Defined Pragmas
return;
end if;
+ -- Set the primitives list of the full type and its base type when
+ -- needed. T may be E_Void in cases of earlier errors, and in that
+ -- case we bypass this.
+
+ if Ekind (T) /= E_Void
+ and then not Present (Direct_Primitive_Operations (T))
+ then
+ if Etype (T) = T then
+ Set_Direct_Primitive_Operations (T, New_Elmt_List);
+
+ -- If Etype of T is the base type (as opposed to a parent type) and
+ -- already has an associated list of primitive operations, then set
+ -- T's primitive list to the base type's list. Otherwise, create a
+ -- new empty primitives list and share the list between T and its
+ -- base type. The lists need to be shared in common between the two.
+
+ elsif Etype (T) = Base_Type (T) then
+
+ if not Present (Direct_Primitive_Operations (Base_Type (T))) then
+ Set_Direct_Primitive_Operations
+ (Base_Type (T), New_Elmt_List);
+ end if;
+
+ Set_Direct_Primitive_Operations
+ (T, Direct_Primitive_Operations (Base_Type (T)));
+
+ -- Case where the Etype is a parent type, so we need a new primitives
+ -- list for T.
+
+ else
+ Set_Direct_Primitive_Operations (T, New_Elmt_List);
+ end if;
+ end if;
+
-- Some common processing for all types
Set_Depends_On_Private (T, Has_Private_Component (T));
Inherit_Predicate_Flags (Id, T);
end if;
+ -- When prefixed calls are enabled for untagged types, the subtype
+ -- shares the primitive operations of its base type.
+
+ if Extensions_Allowed then
+ Set_Direct_Primitive_Operations
+ (Id, Direct_Primitive_Operations (Base_Type (T)));
+ end if;
+
if Etype (Id) = Any_Type then
goto Leave;
end if;
end;
end if;
+ -- When prefixed-call syntax is allowed for untagged types, initialize
+ -- the list of primitive operations to an empty list.
+
+ if Extensions_Allowed and then not Is_Tagged then
+ Set_Direct_Primitive_Operations (Derived_Type, New_Elmt_List);
+ end if;
+
-- Set fields for tagged types
if Is_Tagged then
return;
end if;
+ -- If not already set, initialize the derived type's list of primitive
+ -- operations to an empty element list.
+
+ if not Present (Direct_Primitive_Operations (Derived_Type)) then
+ Set_Direct_Primitive_Operations (Derived_Type, New_Elmt_List);
+
+ -- If Etype of the derived type is the base type (as opposed to
+ -- a parent type) and doesn't have an associated list of primitive
+ -- operations, then set the base type's primitive list to the
+ -- derived type's list. The lists need to be shared in common
+ -- between the two.
+
+ if Etype (Derived_Type) = Base_Type (Derived_Type)
+ and then
+ not Present (Direct_Primitive_Operations (Etype (Derived_Type)))
+ then
+ Set_Direct_Primitive_Operations
+ (Etype (Derived_Type),
+ Direct_Primitive_Operations (Derived_Type));
+ end if;
+ end if;
+
-- Set delayed freeze and then derive subprograms, we need to do this
-- in this order so that derived subprograms inherit the derived freeze
-- if necessary.
end loop;
end;
- -- If the private view was tagged, copy the new primitive operations
- -- from the private view to the full view.
+ declare
+ Disp_Typ : Entity_Id;
+ Full_List : Elist_Id;
+ Prim : Entity_Id;
+ Prim_Elmt : Elmt_Id;
+ Priv_List : Elist_Id;
+
+ function Contains
+ (E : Entity_Id;
+ L : Elist_Id) return Boolean;
+ -- Determine whether list L contains element E
+
+ --------------
+ -- Contains --
+ --------------
+
+ function Contains
+ (E : Entity_Id;
+ L : Elist_Id) return Boolean
+ is
+ List_Elmt : Elmt_Id;
- if Is_Tagged_Type (Full_T) then
- declare
- Disp_Typ : Entity_Id;
- Full_List : Elist_Id;
- Prim : Entity_Id;
- Prim_Elmt : Elmt_Id;
- Priv_List : Elist_Id;
-
- function Contains
- (E : Entity_Id;
- L : Elist_Id) return Boolean;
- -- Determine whether list L contains element E
-
- --------------
- -- Contains --
- --------------
-
- function Contains
- (E : Entity_Id;
- L : Elist_Id) return Boolean
- is
- List_Elmt : Elmt_Id;
+ begin
+ List_Elmt := First_Elmt (L);
+ while Present (List_Elmt) loop
+ if Node (List_Elmt) = E then
+ return True;
+ end if;
- begin
- List_Elmt := First_Elmt (L);
- while Present (List_Elmt) loop
- if Node (List_Elmt) = E then
- return True;
- end if;
+ Next_Elmt (List_Elmt);
+ end loop;
- Next_Elmt (List_Elmt);
- end loop;
+ return False;
+ end Contains;
- return False;
- end Contains;
+ -- Start of processing
- -- Start of processing
+ begin
+ -- If the private view was tagged, copy the new primitive operations
+ -- from the private view to the full view.
- begin
+ if Is_Tagged_Type (Full_T) then
if Is_Tagged_Type (Priv_T) then
Priv_List := Primitive_Operations (Priv_T);
Prim_Elmt := First_Elmt (Priv_List);
Propagate_Concurrent_Flags (Class_Wide_Type (Priv_T), Full_T);
end if;
- end;
- end if;
+
+ -- For untagged types, copy the primitives across from the private
+ -- view to the full view (when extensions are allowed), for support
+ -- of prefixed calls (when extensions are enabled).
+
+ elsif Extensions_Allowed then
+ Priv_List := Primitive_Operations (Priv_T);
+ Prim_Elmt := First_Elmt (Priv_List);
+
+ Full_List := Primitive_Operations (Full_T);
+ while Present (Prim_Elmt) loop
+ Prim := Node (Prim_Elmt);
+ Append_Elmt (Prim, Full_List);
+ Next_Elmt (Prim_Elmt);
+ end loop;
+ end if;
+ end;
-- Ada 2005 AI 161: Check preelaborable initialization consistency
-- Ada 2005 (AI05-0030): In the case of dispatching requeue, the
-- selected component should resolve to a name.
+ -- Extension feature: Also support calls with prefixed views for
+ -- untagged record types.
+
if Ada_Version >= Ada_2005
- and then Is_Tagged_Type (Prefix_Type)
+ and then (Is_Tagged_Type (Prefix_Type) or else Extensions_Allowed)
and then not Is_Concurrent_Type (Prefix_Type)
then
if Nkind (Parent (N)) = N_Generic_Association
Next_Entity (Comp);
end loop;
+ -- Extension feature: Also support calls with prefixed views for
+ -- untagged private types.
+
+ if Extensions_Allowed then
+ if Try_Object_Operation (N) then
+ return;
+ end if;
+ end if;
+
elsif Is_Concurrent_Type (Prefix_Type) then
-- Find visible operation with given name. For a protected type,
Set_Is_Overloaded (N, Is_Overloaded (Sel));
+ -- Extension feature: Also support calls with prefixed views for
+ -- untagged types.
+
+ elsif Extensions_Allowed
+ and then Try_Object_Operation (N)
+ then
+ return;
+
else
-- Invalid prefix
-- type, this is not a prefixed call. Restore the previous type as
-- the current one is not a legal candidate.
- if not Is_Tagged_Type (Obj_Type)
+ -- Extension feature: Calls with prefixed views are also supported
+ -- for untagged types, so skip the early return when extensions are
+ -- enabled.
+
+ if (not Is_Tagged_Type (Obj_Type) and then not Extensions_Allowed)
or else Is_Incomplete_Type (Obj_Type)
then
Obj_Type := Prev_Obj_Type;
Try_Primitive_Operation
(Call_Node => New_Call_Node,
Node_To_Replace => Node_To_Replace);
+
+ -- Extension feature: In the case where the prefix is of an
+ -- access type, and a primitive wasn't found for the designated
+ -- type, then if the access type has primitives we attempt a
+ -- prefixed call using one of its primitives. (It seems that
+ -- this isn't quite right to give preference to the designated
+ -- type in the case where both the access and designated types
+ -- have homographic prefixed-view operations that could result
+ -- in an ambiguity, but handling properly may be tricky. ???)
+
+ if Extensions_Allowed
+ and then not Prim_Result
+ and then Is_Named_Access_Type (Prev_Obj_Type)
+ and then Present (Direct_Primitive_Operations (Prev_Obj_Type))
+ then
+ -- Temporarily reset Obj_Type to the original access type
+
+ Obj_Type := Prev_Obj_Type;
+
+ Prim_Result :=
+ Try_Primitive_Operation
+ (Call_Node => New_Call_Node,
+ Node_To_Replace => Node_To_Replace);
+
+ -- Restore Obj_Type to the designated type (is this really
+ -- necessary, or should it only be done when Prim_Result is
+ -- still False?).
+
+ Obj_Type := Designated_Type (Obj_Type);
+ end if;
end if;
-- Check if there is a class-wide subprogram covering the
-- be the corresponding record of a synchronized type.
return Obj_Type = Typ
- or else Base_Type (Obj_Type) = Typ
+ or else Base_Type (Obj_Type) = Base_Type (Typ)
or else Corr_Type = Typ
-- Object may be of a derived type whose parent has unknown
F_Typ : Entity_Id;
B_Typ : Entity_Id;
+ procedure Add_Or_Replace_Untagged_Primitive (Typ : Entity_Id);
+ -- Either add the new subprogram to the list of primitives for
+ -- untagged type Typ, or if it overrides a primitive of Typ, then
+ -- replace the overridden primitive in Typ's primitives list with
+ -- the new subprogram.
+
function Visible_Part_Type (T : Entity_Id) return Boolean;
-- Returns true if T is declared in the visible part of the current
-- package scope; otherwise returns false. Assumes that T is declared
-- in a private part, then it must override a function declared in
-- the visible part.
+ ---------------------------------------
+ -- Add_Or_Replace_Untagged_Primitive --
+ ---------------------------------------
+
+ procedure Add_Or_Replace_Untagged_Primitive (Typ : Entity_Id) is
+ Replaced_Overridden_Subp : Boolean := False;
+
+ begin
+ pragma Assert (not Is_Tagged_Type (Typ));
+
+ -- Anonymous access types don't have a primitives list. Normally
+ -- such types wouldn't make it here, but the case of anonymous
+ -- access-to-subprogram types can.
+
+ if not Is_Anonymous_Access_Type (Typ) then
+
+ -- If S overrides a subprogram that's a primitive of
+ -- the formal's type, then replace the overridden
+ -- subprogram with the new subprogram in the type's
+ -- list of primitives.
+
+ if Is_Overriding then
+ pragma Assert (Present (Overridden_Subp)
+ and then Overridden_Subp = E); -- Added for now
+
+ declare
+ Prim_Ops : constant Elist_Id :=
+ Primitive_Operations (Typ);
+ Elmt : Elmt_Id;
+ begin
+ if Present (Prim_Ops) then
+ Elmt := First_Elmt (Prim_Ops);
+
+ while Present (Elmt)
+ and then Node (Elmt) /= Overridden_Subp
+ loop
+ Next_Elmt (Elmt);
+ end loop;
+
+ if Present (Elmt) then
+ Replace_Elmt (Elmt, S);
+ Replaced_Overridden_Subp := True;
+ end if;
+ end if;
+ end;
+ end if;
+
+ -- If the new subprogram did not override an operation
+ -- of the formal's type, then add it to the primitives
+ -- list of the type.
+
+ if not Replaced_Overridden_Subp then
+ Append_Unique_Elmt (S, Primitive_Operations (Typ));
+ end if;
+ end if;
+ end Add_Or_Replace_Untagged_Primitive;
+
------------------------------
-- Check_Private_Overriding --
------------------------------
Is_Primitive := False;
if not Comes_From_Source (S) then
- null;
+
+ -- Add an inherited primitive for an untagged derived type to
+ -- Derived_Type's list of primitives. Tagged primitives are dealt
+ -- with in Check_Dispatching_Operation.
+
+ if Present (Derived_Type)
+ and then Extensions_Allowed
+ and then not Is_Tagged_Type (Derived_Type)
+ then
+ Append_Unique_Elmt (S, Primitive_Operations (Derived_Type));
+ end if;
-- If subprogram is at library level, it is not primitive operation
Is_Primitive := True;
Set_Has_Primitive_Operations (B_Typ);
Set_Is_Primitive (S);
- Check_Private_Overriding (B_Typ);
+ -- Add a primitive for an untagged type to B_Typ's list
+ -- of primitives. Tagged primitives are dealt with in
+ -- Check_Dispatching_Operation.
+
+ if Extensions_Allowed
+ and then not Is_Tagged_Type (B_Typ)
+ then
+ Add_Or_Replace_Untagged_Primitive (B_Typ);
+ end if;
+
+ Check_Private_Overriding (B_Typ);
-- The Ghost policy in effect at the point of declaration
-- or a tagged type and a primitive operation must match
-- (SPARK RM 6.9(16)).
Is_Primitive := True;
Set_Is_Primitive (S);
Set_Has_Primitive_Operations (B_Typ);
+
+ -- Add a primitive for an untagged type to B_Typ's list
+ -- of primitives. Tagged primitives are dealt with in
+ -- Check_Dispatching_Operation.
+
+ if Extensions_Allowed
+ and then not Is_Tagged_Type (B_Typ)
+ then
+ Add_Or_Replace_Untagged_Primitive (B_Typ);
+ end if;
+
Check_Private_Overriding (B_Typ);
-- The Ghost policy in effect at the point of declaration
elsif Abstract_Present (Def) then
Error_Msg_N ("only a tagged type can be abstract", N);
+
+ -- When extensions are enabled, we initialize the primitive operations
+ -- list of an untagged private type to an empty element list. (Note:
+ -- This could be done for all private types and shared with the tagged
+ -- case above, but for now we do it separately when the feature of
+ -- prefixed calls for untagged types is enabled.)
+
+ elsif Extensions_Allowed then
+ Set_Direct_Primitive_Operations (Id, New_Elmt_List);
end if;
end New_Private_Type;
P_Type := Implicitly_Designated_Type (P_Type);
end if;
- -- First check for components of a record object (not the
- -- result of a call, which is handled below).
-
- if Has_Components (P_Type)
+ -- First check for components of a record object (not the result of
+ -- a call, which is handled below). This also covers the case where
+ -- where the extension feature that supports the prefixed form of
+ -- calls for primitives of untagged types is enabled (excluding
+ -- concurrent cases, which are handled further below).
+
+ if Is_Type (P_Type)
+ and then (Has_Components (P_Type)
+ or else (Extensions_Allowed
+ and then not Is_Concurrent_Type (P_Type)))
and then not Is_Overloadable (P_Name)
and then not Is_Type (P_Name)
then
projects / thirdparty / gcc.git / commitdiff
