This patch slightly reduces compilation time at -O0 in typical conditions by
streamlining the implementation of the Sem_Type.Covers predicate.
No functional changes.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-02 Eric Botcazou <ebotca...@adacore.com>
* sem_type.adb (Covers): Move trivial case to the top and reuse the
computed value of Base_Type.
Index: sem_type.adb
===================================================================
--- sem_type.adb (revision 177087)
+++ sem_type.adb (working copy)
@@ -737,22 +737,12 @@
else
raise Program_Error;
end if;
+ end if;
- else
- BT1 := Base_Type (T1);
- BT2 := Base_Type (T2);
+ -- Trivial case: same types are always compatible
- -- Handle underlying view of records with unknown discriminants
- -- using the original entity that motivated the construction of
- -- this underlying record view (see Build_Derived_Private_Type).
-
- if Is_Underlying_Record_View (BT1) then
- BT1 := Underlying_Record_View (BT1);
- end if;
-
- if Is_Underlying_Record_View (BT2) then
- BT2 := Underlying_Record_View (BT2);
- end if;
+ if T1 = T2 then
+ return True;
end if;
-- First check for Standard_Void_Type, which is special. Subsequent
@@ -762,26 +752,38 @@
if (T1 = Standard_Void_Type) /= (T2 = Standard_Void_Type) then
return False;
+ end if;
- -- Simplest case: same types are compatible, and types that have the
- -- same base type and are not generic actuals are compatible. Generic
- -- actuals belong to their class but are not compatible with other
- -- types of their class, and in particular with other generic actuals.
- -- They are however compatible with their own subtypes, and itypes
- -- with the same base are compatible as well. Similarly, constrained
- -- subtypes obtained from expressions of an unconstrained nominal type
- -- are compatible with the base type (may lead to spurious ambiguities
- -- in obscure cases ???)
+ BT1 := Base_Type (T1);
+ BT2 := Base_Type (T2);
+ -- Handle underlying view of records with unknown discriminants
+ -- using the original entity that motivated the construction of
+ -- this underlying record view (see Build_Derived_Private_Type).
+
+ if Is_Underlying_Record_View (BT1) then
+ BT1 := Underlying_Record_View (BT1);
+ end if;
+
+ if Is_Underlying_Record_View (BT2) then
+ BT2 := Underlying_Record_View (BT2);
+ end if;
+
+ -- Simplest case: types that have the same base type and are not generic
+ -- actuals are compatible. Generic actuals belong to their class but are
+ -- not compatible with other types of their class, and in particular
+ -- with other generic actuals. They are however compatible with their
+ -- own subtypes, and itypes with the same base are compatible as well.
+ -- Similarly, constrained subtypes obtained from expressions of an
+ -- unconstrained nominal type are compatible with the base type (may
+ -- lead to spurious ambiguities in obscure cases ???)
+
-- Generic actuals require special treatment to avoid spurious ambi-
-- guities in an instance, when two formal types are instantiated with
-- the same actual, so that different subprograms end up with the same
-- signature in the instance.
- elsif T1 = T2 then
- return True;
-
- elsif BT1 = BT2
+ if BT1 = BT2
or else BT1 = T2
or else BT2 = T1
then
@@ -830,7 +832,7 @@
and then Is_Interface (Etype (T1))
and then Is_Concurrent_Type (T2)
and then Interface_Present_In_Ancestor
- (Typ => Base_Type (T2),
+ (Typ => BT2,
Iface => Etype (T1))
then
return True;
@@ -889,7 +891,7 @@
elsif Is_Class_Wide_Type (T2)
and then
(Class_Wide_Type (T1) = T2
- or else Base_Type (Root_Type (T2)) = Base_Type (T1))
+ or else Base_Type (Root_Type (T2)) = BT1)
then
return True;
@@ -1037,7 +1039,7 @@
-- The actual type may be the result of a previous error
- elsif Base_Type (T2) = Any_Type then
+ elsif BT2 = Any_Type then
return True;
-- A packed array type covers its corresponding non-packed type. This is
