From patchwork Tue Nov 9 09:46:26 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 47266 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 82FDD3858417 for ; Tue, 9 Nov 2021 10:11:50 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 82FDD3858417 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1636452710; bh=tcoTg1YCLBfgZsp42WbeaRmQ1eL+TpDfLyU6cLeEq/A=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=il1lpn++OMTnds6uQODRZMyxn9MWSjQIS2UBduY+pGlorKE7gsxeEcgW7HzRYQMrP E8di4sAJDg6wjqpXHDJWyPkPALarLbvf55GMyR8XxMCQwxpVGp0DhOzlHowl3VxqaE hBZ40bguijN/25IxazIYWNxdAbPQDfaVG5W3RHUY= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lf1-x135.google.com (mail-lf1-x135.google.com [IPv6:2a00:1450:4864:20::135]) by sourceware.org (Postfix) with ESMTPS id 6676D3858001 for ; Tue, 9 Nov 2021 09:46:29 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 6676D3858001 Received: by mail-lf1-x135.google.com with SMTP id br38so4566293lfb.8 for ; Tue, 09 Nov 2021 01:46:29 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=tcoTg1YCLBfgZsp42WbeaRmQ1eL+TpDfLyU6cLeEq/A=; b=zWokKnnjfLFrlJCJEHPNwLXDxB7OegxmE4TqBs8+vq6zPdRr7Ebo6QN5WvXfqtZnBQ qwPVeTeriVUPAl+evPYWK7ZWprsTGJP+2pK5/6n9TvR28NJMSZ1oSyLRM4hmgB7Bz7NW bC+it3XsqE5Pyd4zj7zvB/q5FzZ8w4BMWcgfv5f3Wb1yLjb3YUOfNiPqOm9rg1xtPWw1 zgTRRqq+zFXDR2ppTLp1pAcApXEYOjxOUu6MlpkwmewhxPkOm/79V8lGRAYvzdv8DiGS 9lG1BlCPHXm/8pVkujmA1fcFpFVh2HzqAIeLGeSJMYO20xGCiSHp6LkU89azSmRPdL61 UIHQ== X-Gm-Message-State: AOAM5311Vtkz0bc64u/VvF7sZ+1euAX+xZaOhWDi4f76RFHPuM8R7UVQ SL5U8EAfyWlAM3GC7PNsQrIT/BqCTBSNhZbR X-Google-Smtp-Source: ABdhPJzZNf5a2zheAUuEEpQ+LRRsA68sk4wES1m2VXlciQ+UDV8zds9D2/EuLuuYN/JFFZzKqINOFA== X-Received: by 2002:a05:6512:e9a:: with SMTP id bi26mr5564475lfb.480.1636451188316; Tue, 09 Nov 2021 01:46:28 -0800 (PST) Received: from adacore.com ([2a02:2ab8:224:2ce:72b5:e8ff:feef:ee60]) by smtp.gmail.com with ESMTPSA id j21sm113639lji.88.2021.11.09.01.46.27 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 09 Nov 2021 01:46:27 -0800 (PST) Date: Tue, 9 Nov 2021 09:46:26 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Tidy up implementation of Has_Compatible_Type Message-ID: <20211109094626.GA831043@adacore.com> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-13.0 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Eric Botcazou Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Has_Compatible_Type is essentially a wrapper around Covers in Sem_Type that handles overloading and a few other details, i.e. calling: Has_Compatible_Type (N, Typ) is morally equivalent to calling: Covers (Typ, Etype (N)) or Covers (Typ, Interp (N)) Except that the implementation also performs the reversed tests when Typ is neither a tagged nor an anonymous access type and this is questionable. This change removes the reversed tests in the general case and add them back only in the few cases where they are still needed for now. This reduces the total number of calls to Covers by 50%. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_ch4.adb (Analyze_Membership_Op) : Handle both overloaded and non-overloaded cases. : Do a reversed call to Covers if the outcome of the call to Has_Compatible_Type is false. Simplify implementation after change to Find_Interpretation. (Analyze_User_Defined_Binary_Op): Be prepared for previous errors. (Find_Comparison_Types) : Do a reversed call to Covers if the outcome of the call to Has_Compatible_Type is false. (Find_Equality_Types) : Likewise. * sem_type.adb (Has_Compatible_Type): Remove the reversed calls to Covers. Add explicit return on all paths. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -2976,10 +2976,7 @@ package body Sem_Ch4 is procedure Find_Interpretation; function Find_Interpretation return Boolean; - -- Routine and wrapper to find a matching interpretation in case - -- of overloading. The wrapper returns True iff a matching - -- interpretation is found. Beware, in absence of overloading, - -- using this function will break gnat's bootstrapping. + -- Routine and wrapper to find a matching interpretation procedure Try_One_Interp (T1 : Entity_Id); -- Routine to try one proposed interpretation. Note that the context @@ -3091,11 +3088,16 @@ package body Sem_Ch4 is procedure Find_Interpretation is begin - Get_First_Interp (L, Index, It); - while Present (It.Typ) loop - Try_One_Interp (It.Typ); - Get_Next_Interp (Index, It); - end loop; + if not Is_Overloaded (L) then + Try_One_Interp (Etype (L)); + + else + Get_First_Interp (L, Index, It); + while Present (It.Typ) loop + Try_One_Interp (It.Typ); + Get_Next_Interp (Index, It); + end loop; + end if; end Find_Interpretation; function Find_Interpretation return Boolean is @@ -3111,7 +3113,7 @@ package body Sem_Ch4 is procedure Try_One_Interp (T1 : Entity_Id) is begin - if Has_Compatible_Type (R, T1) then + if Has_Compatible_Type (R, T1) or else Covers (Etype (R), T1) then if Found and then Base_Type (T1) /= Base_Type (T_F) then @@ -3156,12 +3158,7 @@ package body Sem_Ch4 is then Analyze (R); - if not Is_Overloaded (L) then - Try_One_Interp (Etype (L)); - - else - Find_Interpretation; - end if; + Find_Interpretation; -- If not a range, it can be a subtype mark, or else it is a degenerate -- membership test with a singleton value, i.e. a test for equality, @@ -3170,16 +3167,11 @@ package body Sem_Ch4 is else Analyze (R); - if Is_Entity_Name (R) - and then Is_Type (Entity (R)) - then + if Is_Entity_Name (R) and then Is_Type (Entity (R)) then Find_Type (R); Check_Fully_Declared (Entity (R), R); - elsif Ada_Version >= Ada_2012 and then - ((Is_Overloaded (L) and then Find_Interpretation) or else - (not Is_Overloaded (L) and then Has_Compatible_Type (R, Etype (L)))) - then + elsif Ada_Version >= Ada_2012 and then Find_Interpretation then if Nkind (N) = N_In then Op := Make_Op_Eq (Loc, Left_Opnd => L, Right_Opnd => R); else @@ -5918,14 +5910,16 @@ package body Sem_Ch4 is begin -- Verify that Op_Id is a visible binary function. Note that since -- we know Op_Id is overloaded, potentially use visible means use - -- visible for sure (RM 9.4(11)). + -- visible for sure (RM 9.4(11)). Be prepared for previous errors. if Ekind (Op_Id) = E_Function and then Present (F2) and then (Is_Immediately_Visible (Op_Id) or else Is_Potentially_Use_Visible (Op_Id)) - and then Has_Compatible_Type (Left_Opnd (N), Etype (F1)) - and then Has_Compatible_Type (Right_Opnd (N), Etype (F2)) + and then (Has_Compatible_Type (Left_Opnd (N), Etype (F1)) + or else Etype (F1) = Any_Type) + and then (Has_Compatible_Type (Right_Opnd (N), Etype (F2)) + or else Etype (F2) = Any_Type) then Add_One_Interp (N, Op_Id, Etype (Op_Id)); @@ -6612,7 +6606,10 @@ package body Sem_Ch4 is return; end if; - if Valid_Comparison_Arg (T1) and then Has_Compatible_Type (R, T1) then + if Valid_Comparison_Arg (T1) + and then (Has_Compatible_Type (R, T1) + or else Covers (Etype (R), T1)) + then if Found and then Base_Type (T1) /= Base_Type (T_F) then It := Disambiguate (L, I_F, Index, Any_Type); @@ -6710,6 +6707,7 @@ package body Sem_Ch4 is Get_Next_Interp (Index, It); end loop; end if; + elsif Has_Compatible_Type (R, T1) or else Covers (Etype (R), T1) then Add_One_Interp (N, Op_Id, Standard_Boolean, Base_Type (T1)); end if; @@ -7100,7 +7098,9 @@ package body Sem_Ch4 is -- Finally, also check for RM 4.5.2 (9.6/2). if T1 /= Standard_Void_Type - and then (Universal_Access or else Has_Compatible_Type (R, T1)) + and then (Universal_Access + or else Has_Compatible_Type (R, T1) + or else Covers (Etype (R), T1)) and then ((not Is_Limited_Type (T1) @@ -7161,9 +7161,7 @@ package body Sem_Ch4 is -- If left operand is aggregate, the right operand has to -- provide a usable type for it. - if Nkind (L) = N_Aggregate - and then Nkind (R) /= N_Aggregate - then + if Nkind (L) = N_Aggregate and then Nkind (R) /= N_Aggregate then Find_Equality_Types (L => R, R => L, Op_Id => Op_Id, N => N); return; end if; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -2449,11 +2449,8 @@ package body Sem_Type is return False; end if; - if Nkind (N) = N_Subtype_Indication - or else not Is_Overloaded (N) - then - return - Covers (Typ, Etype (N)) + if Nkind (N) = N_Subtype_Indication or else not Is_Overloaded (N) then + if Covers (Typ, Etype (N)) -- Ada 2005 (AI-345): The context may be a synchronized interface. -- If the type is already frozen use the corresponding_record @@ -2471,11 +2468,6 @@ package body Sem_Type is and then Present (Corresponding_Record_Type (Typ)) and then Covers (Corresponding_Record_Type (Typ), Etype (N))) - or else - (not Is_Tagged_Type (Typ) - and then Ekind (Typ) /= E_Anonymous_Access_Type - and then Covers (Etype (N), Typ)) - or else (Nkind (N) = N_Integer_Literal and then Present (Find_Aspect (Typ, Aspect_Integer_Literal))) @@ -2486,7 +2478,10 @@ package body Sem_Type is or else (Nkind (N) = N_String_Literal - and then Present (Find_Aspect (Typ, Aspect_String_Literal))); + and then Present (Find_Aspect (Typ, Aspect_String_Literal))) + then + return True; + end if; -- Overloaded case @@ -2501,24 +2496,22 @@ package body Sem_Type is -- Ada 2005 (AI-345) or else - (Is_Concurrent_Type (It.Typ) + (Is_Record_Type (Typ) + and then Is_Concurrent_Type (It.Typ) and then Present (Corresponding_Record_Type (Etype (It.Typ))) and then Covers (Typ, Corresponding_Record_Type (Etype (It.Typ)))) - or else (not Is_Tagged_Type (Typ) - and then Ekind (Typ) /= E_Anonymous_Access_Type - and then Covers (It.Typ, Typ)) then return True; end if; Get_Next_Interp (I, It); end loop; - - return False; end if; + + return False; end Has_Compatible_Type; ---------------------