The Sem_Type.Covers predicate is by far the topmost subprogram in the profile of unoptimized compilations in Ada. This change contains a series of small optimizations that save about 2% of the instruction count on x86-64:
1. Inline 3 more predicates from einfo, 2. Simplify a convoluted condition dealing with Standard_Void_Type, 3. Move up cheap tests on T2 so that they are executed before more costly tests on T1, 4. Move the Is_Private_Type test from Full_View_Covers to the main body and remove tests on base types that were already done in the main body. The main saving stems from 4. because tests on In_Instance are now guarded by the Is_Private_Type predicate and In_Instance is quite costly since it climbs the scope chain on each invocation. No functional changes. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-10-09 Eric Botcazou <ebotca...@adacore.com> * einfo.ads (Is_Boolean_Type): Add pragma Inline. (Is_Entity_Name): Likewise. (Is_String_Type): Likewise. * sem_type.adb (Full_View_Covers): Do not test Is_Private_Type here and remove useless comparisons on the base types. (Covers): Use simple tests for Standard_Void_Type. Move up cheap tests on T2. Always test Is_Private_Type before Full_View_Covers.
Index: einfo.ads =================================================================== --- einfo.ads (revision 253559) +++ einfo.ads (working copy) @@ -9470,9 +9470,12 @@ pragma Inline (Base_Type); pragma Inline (Is_Base_Type); + pragma Inline (Is_Boolean_Type); pragma Inline (Is_Controlled); + pragma Inline (Is_Entity_Name); pragma Inline (Is_Package_Or_Generic_Package); pragma Inline (Is_Packed_Array); + pragma Inline (Is_String_Type); pragma Inline (Is_Subprogram_Or_Generic_Subprogram); pragma Inline (Is_Volatile); pragma Inline (Is_Wrapper_Package); Index: sem_type.adb =================================================================== --- sem_type.adb (revision 253546) +++ sem_type.adb (working copy) @@ -761,15 +761,19 @@ function Full_View_Covers (Typ1, Typ2 : Entity_Id) return Boolean is begin - return - Is_Private_Type (Typ1) - and then - ((Present (Full_View (Typ1)) - and then Covers (Full_View (Typ1), Typ2)) - or else (Present (Underlying_Full_View (Typ1)) - and then Covers (Underlying_Full_View (Typ1), Typ2)) - or else Base_Type (Typ1) = Typ2 - or else Base_Type (Typ2) = Typ1); + if Present (Full_View (Typ1)) + and then Covers (Full_View (Typ1), Typ2) + then + return True; + + elsif Present (Underlying_Full_View (Typ1)) + and then Covers (Underlying_Full_View (Typ1), Typ2) + then + return True; + + else + return False; + end if; end Full_View_Covers; ----------------- @@ -825,7 +829,7 @@ -- Standard_Void_Type is a special entity that has some, but not all, -- properties of types. - if (T1 = Standard_Void_Type) /= (T2 = Standard_Void_Type) then + if T1 = Standard_Void_Type or else T2 = Standard_Void_Type then return False; end if; @@ -892,8 +896,8 @@ or else (T2 = Universal_Real and then Is_Real_Type (T1)) or else (T2 = Universal_Fixed and then Is_Fixed_Point_Type (T1)) or else (T2 = Any_Fixed and then Is_Fixed_Point_Type (T1)) + or else (T2 = Any_Character and then Is_Character_Type (T1)) or else (T2 = Any_String and then Is_String_Type (T1)) - or else (T2 = Any_Character and then Is_Character_Type (T1)) or else (T2 = Any_Access and then Is_Access_Type (T1)) then return True; @@ -916,9 +920,9 @@ -- task_type or protected_type that implements the interface. elsif Ada_Version >= Ada_2005 + and then Is_Concurrent_Type (T2) and then Is_Class_Wide_Type (T1) and then Is_Interface (Etype (T1)) - and then Is_Concurrent_Type (T2) and then Interface_Present_In_Ancestor (Typ => BT2, Iface => Etype (T1)) then @@ -928,9 +932,9 @@ -- object T2 implementing T1. elsif Ada_Version >= Ada_2005 + and then Is_Tagged_Type (T2) and then Is_Class_Wide_Type (T1) and then Is_Interface (Etype (T1)) - and then Is_Tagged_Type (T2) then if Interface_Present_In_Ancestor (Typ => T2, Iface => Etype (T1)) @@ -1183,19 +1187,16 @@ -- whether a partial and a full view match. Verify that types are -- legal, to prevent cascaded errors. - elsif In_Instance - and then (Full_View_Covers (T1, T2) or else Full_View_Covers (T2, T1)) - then - return True; - - elsif Is_Type (T2) - and then Is_Generic_Actual_Type (T2) + elsif Is_Private_Type (T1) + and then (In_Instance + or else (Is_Type (T2) and then Is_Generic_Actual_Type (T2))) and then Full_View_Covers (T1, T2) then return True; - elsif Is_Type (T1) - and then Is_Generic_Actual_Type (T1) + elsif Is_Private_Type (T2) + and then (In_Instance + or else (Is_Type (T1) and then Is_Generic_Actual_Type (T1))) and then Full_View_Covers (T2, T1) then return True;