From patchwork Tue Sep 3 08:20:57 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 1979886 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=Q79V3JLX; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4WydtK1FH5z1yg9 for ; Tue, 3 Sep 2024 18:23:21 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 5B611385EC14 for ; Tue, 3 Sep 2024 08:23:19 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32a.google.com (mail-wm1-x32a.google.com [IPv6:2a00:1450:4864:20::32a]) by sourceware.org (Postfix) with ESMTPS id 49252385E44D for ; Tue, 3 Sep 2024 08:21:18 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 49252385E44D Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 49252385E44D Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::32a ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1725351682; cv=none; b=OCrYceUPdQcv6li3CmvIojzmxkWXJYKQ56NlyLZOwuXv0uM+SO0hjhTCkPP+dfmwHh5euB9WB06d+Nrt17mjKKmL+ZcGfX8iPjL9nZtzZsSN4MLrkZN+ZdfdSfO7aThroHIl5yo1u7Erb+oSaWYGG0qmCu98FoNSWNrG6k54pig= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1725351682; c=relaxed/simple; bh=7rODuazeMqiLNXdnjtjbsdhyS1BTh1oFY0XXx/0gO+Q=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=CJAEwPyAdwZVivCZxzIZVHaE7BoweoYpPHJgBGttSDp5kFy/DXV/1Li3oEH1/bZE0yp4hO7qb6BvuSt2k3YXWcfoH/3mHa8gBIwIt6Il68AHaIMO0HEvZbgxItPtl6+/dv85n5kiXp3O6XHRcJiWIs9xEnS2Xk0KCAgy3i+d+d4= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wm1-x32a.google.com with SMTP id 5b1f17b1804b1-42bbffe38e6so26200705e9.0 for ; Tue, 03 Sep 2024 01:21:18 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1725351677; x=1725956477; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=6X0qyoze+nNc5U5uj1d//97O1jBSev66cs8VhptPk+g=; b=Q79V3JLXu+s39UyVugEd8TqSeDQNO/jS1gEgvREH1i0aKqxxh9va9HeAt0ftC9gKTR bcMqKNjywjG8SgSVJgCcy/7e0OhHFxZMhaXc0xu/quQv1Rbz/gydHc+6dmYkRi2X3zgo E/lBEfHu6qTAvRpkDIvkM0iEsGMYTMo3o/pM+zOZqvi8rNqR7IcVwQJt+CpzkV0HeG4l Xpe7/6/K8H9/kN2mXob6lbxe734HluSJL0ugjRBZ1Tdpeko4XSjCwWHdp7T1Qi9SuZjg vFa3hl1jvWbOSIHOM23GPK4XnpxfXVsRWgSlQ6vAj5iGcaHVWV/4ifN43ePg9WgAUyne rsvQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1725351677; x=1725956477; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=6X0qyoze+nNc5U5uj1d//97O1jBSev66cs8VhptPk+g=; b=WCnrRtJwW8tTJz3E9BOPvsvWUCnY/s8ib+jl6P09ni90BicSw7bkzuP31LIJxFqiCU LcyI+Oe1AyrHWcYqzVF0P4JT3yHGIsord4qq4BAFZvqxDiFlAlHLP58aQVqTTAWAK9fp urpTkX9XEdLeK0qnwGSmsz+Rn2HmfdsXW4kHUVBDGWf3jIoG58GjCBntrV6EZTWNx/fH AkNQA21PFLYt7Wvjqs7eb8WRI2oJgpienjymPVZdYVXvGxJC/eZlVlvNo4cl81PbIlEG M+PKgy2FVDKXe6hhldCT1Hh4Z0a9g5yZfoE/c0jDgdbcVkkTl6BOwG3zcevZ1XAjRKLz LRdA== X-Gm-Message-State: AOJu0YxVNnjhHFB5h1lwi+S82yVxPZOEDlj63G4v6rXzQ1futEp027GM tXeIXHI92GF8iAeagHbVtcQy0HcP2yN7Epz4KsQ6bcZWJbucm49EBZZ+uIVvFgas60B9dMrSyvo = X-Google-Smtp-Source: AGHT+IGzbFaT4l2rmhrDMs7iyWxzhzjxzhPCoobhjbjsRNxumumRr0HCUIqdhV64FH9a3UFciqOPsw== X-Received: by 2002:a05:600c:3c93:b0:426:62c5:4742 with SMTP id 5b1f17b1804b1-42bb02c1d88mr138566015e9.7.1725351676646; Tue, 03 Sep 2024 01:21:16 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id 5b1f17b1804b1-42bb6e27467sm162553425e9.38.2024.09.03.01.21.16 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 03 Sep 2024 01:21:16 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: =?utf-8?q?Marc_Poulhi=C3=A8s?= Subject: [COMMITTED 05/10] ada: Simplify Note_Uplevel_Bound procedure Date: Tue, 3 Sep 2024 10:20:57 +0200 Message-ID: <20240903082102.2268026-5-poulhies@adacore.com> X-Mailer: git-send-email 2.45.2 In-Reply-To: <20240903082102.2268026-1-poulhies@adacore.com> References: <20240903082102.2268026-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org The procedure Note_Uplevel_Bound was implemented as a custom expression tree walk. This change replaces this custom tree traversal by a more idiomatic use of Traverse_Proc. gcc/ada/ * exp_unst.adb (Check_Static_Type::Note_Uplevel_Bound): Refactor to use the generic Traverse_Proc. (Check_Static_Type): Adjust calls to Note_Uplevel_Bound as the previous second parameter was unused, so removed. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_unst.adb | 169 +++++++++++++++++-------------------------- 1 file changed, 66 insertions(+), 103 deletions(-) diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 7ff1ea621bb..fb48a64ac86 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -507,78 +507,90 @@ package body Exp_Unst is is T : constant Entity_Id := Get_Fullest_View (In_T); - procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id); + procedure Note_Uplevel_Bound (N : Node_Id); -- N is the bound of a dynamic type. This procedure notes that -- this bound is uplevel referenced, it can handle references -- to entities (typically _FIRST and _LAST entities), and also -- attribute references of the form T'name (name is typically -- FIRST or LAST) where T is the uplevel referenced bound. - -- Ref, if Present, is the location of the reference to - -- replace. ------------------------ -- Note_Uplevel_Bound -- ------------------------ - procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id) is - begin - -- Entity name case. Make sure that the entity is declared - -- in a subprogram. This may not be the case for a type in a - -- loop appearing in a precondition. - -- Exclude explicitly discriminants (that can appear - -- in bounds of discriminated components) and enumeration - -- literals. - - if Is_Entity_Name (N) then - if Present (Entity (N)) - and then not Is_Type (Entity (N)) - and then Present (Enclosing_Subprogram (Entity (N))) - and then - Ekind (Entity (N)) - not in E_Discriminant | E_Enumeration_Literal - then - Note_Uplevel_Ref - (E => Entity (N), - N => Empty, - Caller => Current_Subprogram, - Callee => Enclosing_Subprogram (Entity (N))); - end if; + procedure Note_Uplevel_Bound (N : Node_Id) is - -- Attribute or indexed component case + function Note_Uplevel_Bound_Trav + (N : Node_Id) return Traverse_Result; + -- Tree visitor that marks entities that are uplevel + -- referenced. - elsif Nkind (N) in - N_Attribute_Reference | N_Indexed_Component - then - Note_Uplevel_Bound (Prefix (N), Ref); + procedure Do_Note_Uplevel_Bound + is new Traverse_Proc (Note_Uplevel_Bound_Trav); + -- Subtree visitor instantiation - -- The indices of the indexed components, or the - -- associated expressions of an attribute reference, - -- may also involve uplevel references. + ----------------------------- + -- Note_Uplevel_Bound_Trav -- + ----------------------------- - declare - Expr : Node_Id; + function Note_Uplevel_Bound_Trav + (N : Node_Id) return Traverse_Result + is + begin + -- Entity name case. Make sure that the entity is + -- declared in a subprogram. This may not be the case for + -- a type in a loop appearing in a precondition. Exclude + -- explicitly discriminants (that can appear in bounds of + -- discriminated components), enumeration literals and + -- block. + + if Is_Entity_Name (N) then + if Present (Entity (N)) + and then not Is_Type (Entity (N)) + and then Present + (Enclosing_Subprogram (Entity (N))) + and then + Ekind (Entity (N)) + not in E_Discriminant | E_Enumeration_Literal + | E_Block + then + Note_Uplevel_Ref + (E => Entity (N), + N => Empty, + Caller => Current_Subprogram, + Callee => Enclosing_Subprogram (Entity (N))); + end if; + end if; - begin - Expr := First (Expressions (N)); - while Present (Expr) loop - Note_Uplevel_Bound (Expr, Ref); - Next (Expr); - end loop; - end; + -- N_Function_Call are handled later, don't touch them + -- yet. + if Nkind (N) in N_Function_Call + then + return Skip; + + -- In N_Selected_Component and N_Expanded_Name, only the + -- prefix may be referencing a uplevel entity. + + elsif Nkind (N) in N_Selected_Component + | N_Expanded_Name + then + Do_Note_Uplevel_Bound (Prefix (N)); + return Skip; -- The type of the prefix may be have an uplevel -- reference if this needs bounds. - if Nkind (N) = N_Attribute_Reference then + elsif Nkind (N) = N_Attribute_Reference then declare Attr : constant Attribute_Id := Get_Attribute_Id (Attribute_Name (N)); DT : Boolean := False; begin - if (Attr = Attribute_First - or else Attr = Attribute_Last - or else Attr = Attribute_Length) + if Attr in + Attribute_First + | Attribute_Last + | Attribute_Length and then Is_Constrained (Etype (Prefix (N))) then Check_Static_Type @@ -587,59 +599,10 @@ package body Exp_Unst is end; end if; - -- Binary operator cases. These can apply to arrays for - -- which we may need bounds. - - elsif Nkind (N) in N_Binary_Op then - Note_Uplevel_Bound (Left_Opnd (N), Ref); - Note_Uplevel_Bound (Right_Opnd (N), Ref); - - -- Unary operator case - - elsif Nkind (N) in N_Unary_Op then - Note_Uplevel_Bound (Right_Opnd (N), Ref); - - -- Explicit dereference and selected component case - - elsif Nkind (N) in - N_Explicit_Dereference | N_Selected_Component - then - Note_Uplevel_Bound (Prefix (N), Ref); - - -- Conditional expressions - - elsif Nkind (N) = N_If_Expression then - declare - Expr : Node_Id; - - begin - Expr := First (Expressions (N)); - while Present (Expr) loop - Note_Uplevel_Bound (Expr, Ref); - Next (Expr); - end loop; - end; - - elsif Nkind (N) = N_Case_Expression then - declare - Alternative : Node_Id; - - begin - Note_Uplevel_Bound (Expression (N), Ref); - - Alternative := First (Alternatives (N)); - while Present (Alternative) loop - Note_Uplevel_Bound (Expression (Alternative), Ref); - end loop; - end; - - -- Conversion case - - elsif Nkind (N) in - N_Type_Conversion | N_Unchecked_Type_Conversion - then - Note_Uplevel_Bound (Expression (N), Ref); - end if; + return OK; + end Note_Uplevel_Bound_Trav; + begin + Do_Note_Uplevel_Bound (N); end Note_Uplevel_Bound; -- Start of processing for Check_Static_Type @@ -673,12 +636,12 @@ package body Exp_Unst is begin if not Is_Static_Expression (LB) then - Note_Uplevel_Bound (LB, N); + Note_Uplevel_Bound (LB); DT := True; end if; if not Is_Static_Expression (UB) then - Note_Uplevel_Bound (UB, N); + Note_Uplevel_Bound (UB); DT := True; end if; end; @@ -704,7 +667,7 @@ package body Exp_Unst is D := First_Elmt (Discriminant_Constraint (T)); while Present (D) loop if not Is_Static_Expression (Node (D)) then - Note_Uplevel_Bound (Node (D), N); + Note_Uplevel_Bound (Node (D)); DT := True; end if;