From patchwork Tue Jul 29 13:02:17 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 374470 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 7BEC1140189 for ; Tue, 29 Jul 2014 23:36:18 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=uwaOhrs4PxHir3gqsJHJA4yVfyUAy6kyusQwghIJkQF/ZxejD2 XOcfM0IV5c7flEBu+Z9ysxwzPjuZW2Zv4gw9gKlE68992/Om+rhF+MWElpMlO7BT vOZzOna2xG2lmt0/K34/Wa7bN76nypfL5mgmLiLYmqC1rzHGfqTbi6f8Y= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=VEiksOEYeebHs3WS9L0d8aCPRQU=; b=kyYmEoUsKjVi/DAFqOvb cf7AzK3DUtu9k8tes/tXz2QLcaASbrq+TBFyNx6fhc+alKF0pfb39NKMq7SIM/wd 9ccL4vzIo6SfNQmfhuWB6NIcg0CWQ8XVfIdyS5kz0+24ro1f0WtGygiM3nqa0qGW 87pDqAKzNCXyIoEimYwfdQM= Received: (qmail 31305 invoked by alias); 29 Jul 2014 13:36:11 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 9202 invoked by uid 89); 29 Jul 2014 13:02:28 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.7 required=5.0 tests=AWL, BAYES_00 autolearn=ham version=3.3.2 X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Tue, 29 Jul 2014 13:02:19 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 4E45F1162D3; Tue, 29 Jul 2014 09:02:17 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id mziTfOpPKicT; Tue, 29 Jul 2014 09:02:17 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 3D58A1162C2; Tue, 29 Jul 2014 09:02:17 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 3A92E3FE21; Tue, 29 Jul 2014 09:02:17 -0400 (EDT) Date: Tue, 29 Jul 2014 09:02:17 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Cleanup handling of discrete static predicates Message-ID: <20140729130217.GA22625@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.21 (2010-09-15) This is just an internal cleanup, involving some name changes and slightly cleaned up testing of flags etc. This is part of the preparation for implementing static real predicates. No functional effect. Tested on x86_64-pc-linux-gnu, committed on trunk 2014-07-29 Robert Dewar * sem_aggr.adb, exp_ch5.adb, sem_ch5.adb, exp_util.adb, einfo.adb, einfo.ads, sem_util.adb, sem_attr.adb, sem_case.adb, sem_eval.adb, sem_eval.ads, sem_ch13.adb: General cleanup of static predicate handling. Change name of Discrete_Predicate to Discrete_Static_Predicate, and replace testing of the presence of this field by testing the flag Has_Static_Expression. Index: sem_aggr.adb =================================================================== --- sem_aggr.adb (revision 213159) +++ sem_aggr.adb (working copy) @@ -1721,11 +1721,11 @@ -- original choice with the list of individual values -- covered by the predicate. - if Present (Static_Predicate (E)) then + if Present (Static_Discrete_Predicate (E)) then Delete_Choice := True; New_Cs := New_List; - P := First (Static_Predicate (E)); + P := First (Static_Discrete_Predicate (E)); while Present (P) loop C := New_Copy (P); Set_Sloc (C, Sloc (Choice)); Index: exp_ch5.adb =================================================================== --- exp_ch5.adb (revision 213159) +++ exp_ch5.adb (working copy) @@ -3977,7 +3977,7 @@ LPS : constant Node_Id := Loop_Parameter_Specification (Isc); Loop_Id : constant Entity_Id := Defining_Identifier (LPS); Ltype : constant Entity_Id := Etype (Loop_Id); - Stat : constant List_Id := Static_Predicate (Ltype); + Stat : constant List_Id := Static_Discrete_Predicate (Ltype); Stmts : constant List_Id := Statements (N); begin Index: sem_ch5.adb =================================================================== --- sem_ch5.adb (revision 213159) +++ sem_ch5.adb (working copy) @@ -2480,8 +2480,8 @@ -- function only, look for a dynamic predicate aspect as well. if Is_Discrete_Type (Entity (DS)) - and then Present (Predicate_Function (Entity (DS))) - and then (No (Static_Predicate (Entity (DS))) + and then Has_Predicates (Entity (DS)) + and then (not Has_Static_Predicate (Entity (DS)) or else Has_Dynamic_Predicate_Aspect (Entity (DS))) then Bad_Predicated_Subtype_Use Index: exp_util.adb =================================================================== --- exp_util.adb (revision 213158) +++ exp_util.adb (working copy) @@ -1980,7 +1980,7 @@ -- if the list is empty, corresponding to a False predicate, then -- no choices are inserted. - P := First (Static_Predicate (Entity (Choice))); + P := First (Static_Discrete_Predicate (Entity (Choice))); while Present (P) loop -- If low bound and high bounds are equal, copy simple choice Index: einfo.adb =================================================================== --- einfo.adb (revision 213160) +++ einfo.adb (working copy) @@ -222,7 +222,7 @@ -- DT_Offset_To_Top_Func Node25 -- PPC_Wrapper Node25 -- Related_Array_Object Node25 - -- Static_Predicate List25 + -- Static_Discrete_Predicate List25 -- Task_Body_Procedure Node25 -- Dispatch_Table_Wrappers Elist26 @@ -2971,11 +2971,11 @@ return Node19 (Id); end Spec_Entity; - function Static_Predicate (Id : E) return S is + function Static_Discrete_Predicate (Id : E) return S is begin pragma Assert (Is_Discrete_Type (Id)); return List25 (Id); - end Static_Predicate; + end Static_Discrete_Predicate; function Status_Flag_Or_Transient_Decl (Id : E) return N is begin @@ -5761,11 +5761,11 @@ Set_Node19 (Id, V); end Set_Spec_Entity; - procedure Set_Static_Predicate (Id : E; V : S) is + procedure Set_Static_Discrete_Predicate (Id : E; V : S) is begin pragma Assert (Is_Discrete_Type (Id) and then Has_Predicates (Id)); Set_List25 (Id, V); - end Set_Static_Predicate; + end Set_Static_Discrete_Predicate; procedure Set_Status_Flag_Or_Transient_Decl (Id : E; V : E) is begin @@ -9404,7 +9404,7 @@ E_Modular_Integer_Type | E_Modular_Integer_Subtype | E_Signed_Integer_Subtype => - Write_Str ("Static_Predicate"); + Write_Str ("Static_Discrete_Predicate"); when others => Write_Str ("Field25??"); Index: einfo.ads =================================================================== --- einfo.ads (revision 213160) +++ einfo.ads (working copy) @@ -3897,7 +3897,7 @@ -- case where there is a separate spec, where this field references -- the corresponding parameter entities in the spec. --- Static_Predicate (List25) +-- Static_Discrete_Predicate (List25) -- Defined in discrete types/subtypes with static predicates (with the -- two flags Has_Predicates set and Has_Static_Predicate set). Set if the -- type/subtype has a static predicate. Points to a list of expression @@ -5526,7 +5526,7 @@ -- Default_Aspect_Value (Node19) (base type only) -- Scalar_Range (Node20) -- Enum_Pos_To_Rep (Node23) (type only) - -- Static_Predicate (List25) + -- Static_Discrete_Predicate (List25) -- Has_Biased_Representation (Flag139) -- Has_Contiguous_Rep (Flag181) -- Has_Enumeration_Rep_Clause (Flag66) @@ -5741,7 +5741,7 @@ -- Default_Aspect_Value (Node19) (base type only) -- Original_Array_Type (Node21) -- Scalar_Range (Node20) - -- Static_Predicate (List25) + -- Static_Discrete_Predicate (List25) -- Non_Binary_Modulus (Flag58) (base type only) -- Has_Biased_Representation (Flag139) -- Has_Shift_Operator (Flag267) (base type only) @@ -6037,7 +6037,7 @@ -- E_Signed_Integer_Subtype -- Default_Aspect_Value (Node19) (base type only) -- Scalar_Range (Node20) - -- Static_Predicate (List25) + -- Static_Discrete_Predicate (List25) -- Has_Biased_Representation (Flag139) -- Has_Shift_Operator (Flag267) (base type only) -- Type_Low_Bound (synth) @@ -6790,7 +6790,7 @@ function Spec_Entity (Id : E) return E; function Static_Elaboration_Desired (Id : E) return B; function Static_Initialization (Id : E) return N; - function Static_Predicate (Id : E) return S; + function Static_Discrete_Predicate (Id : E) return S; function Status_Flag_Or_Transient_Decl (Id : E) return E; function Storage_Size_Variable (Id : E) return E; function Stored_Constraint (Id : E) return L; @@ -7424,7 +7424,7 @@ procedure Set_Spec_Entity (Id : E; V : E); procedure Set_Static_Elaboration_Desired (Id : E; V : B); procedure Set_Static_Initialization (Id : E; V : N); - procedure Set_Static_Predicate (Id : E; V : S); + procedure Set_Static_Discrete_Predicate (Id : E; V : S); procedure Set_Status_Flag_Or_Transient_Decl (Id : E; V : E); procedure Set_Storage_Size_Variable (Id : E; V : E); procedure Set_Stored_Constraint (Id : E; V : L); @@ -8208,7 +8208,7 @@ pragma Inline (Spec_Entity); pragma Inline (Static_Elaboration_Desired); pragma Inline (Static_Initialization); - pragma Inline (Static_Predicate); + pragma Inline (Static_Discrete_Predicate); pragma Inline (Status_Flag_Or_Transient_Decl); pragma Inline (Storage_Size_Variable); pragma Inline (Stored_Constraint); @@ -8641,7 +8641,7 @@ pragma Inline (Set_Spec_Entity); pragma Inline (Set_Static_Elaboration_Desired); pragma Inline (Set_Static_Initialization); - pragma Inline (Set_Static_Predicate); + pragma Inline (Set_Static_Discrete_Predicate); pragma Inline (Set_Status_Flag_Or_Transient_Decl); pragma Inline (Set_Storage_Size_Variable); pragma Inline (Set_Stored_Constraint); Index: sem_util.adb =================================================================== --- sem_util.adb (revision 213159) +++ sem_util.adb (working copy) @@ -798,7 +798,7 @@ -- Emit an optional suggestion on how to remedy the error if the -- context warrants it. - if Suggest_Static and then Present (Static_Predicate (Typ)) then + if Suggest_Static and then Has_Static_Predicate (Typ) then Error_Msg_FE ("\predicate of & should be marked static", N, Typ); end if; end if; Index: sem_attr.adb =================================================================== --- sem_attr.adb (revision 213160) +++ sem_attr.adb (working copy) @@ -1498,7 +1498,7 @@ -- Now test for dynamic predicate if Has_Predicates (P_Type) - and then No (Static_Predicate (P_Type)) + and then not (Has_Static_Predicate (P_Type)) then Error_Attr_P ("prefix of % attribute may not have dynamic predicate"); @@ -1515,7 +1515,8 @@ if Expr_Value (Type_Low_Bound (P_Type)) > Expr_Value (Type_High_Bound (P_Type)) or else (Has_Predicates (P_Type) - and then Is_Empty_List (Static_Predicate (P_Type))) + and then + Is_Empty_List (Static_Discrete_Predicate (P_Type))) then Error_Attr_P ("prefix of % attribute must be subtype with " @@ -8044,10 +8045,11 @@ when Attribute_First_Valid => First_Valid : begin if Has_Predicates (P_Type) - and then Present (Static_Predicate (P_Type)) + and then Has_Static_Predicate (P_Type) then declare - FirstN : constant Node_Id := First (Static_Predicate (P_Type)); + FirstN : constant Node_Id := + First (Static_Discrete_Predicate (P_Type)); begin if Nkind (FirstN) = N_Range then Fold_Uint (N, Expr_Value (Low_Bound (FirstN)), Static); @@ -8296,10 +8298,11 @@ when Attribute_Last_Valid => Last_Valid : begin if Has_Predicates (P_Type) - and then Present (Static_Predicate (P_Type)) + and then Has_Static_Predicate (P_Type) then declare - LastN : constant Node_Id := Last (Static_Predicate (P_Type)); + LastN : constant Node_Id := + Last (Static_Discrete_Predicate (P_Type)); begin if Nkind (LastN) = N_Range then Fold_Uint (N, Expr_Value (High_Bound (LastN)), Static); Index: sem_case.adb =================================================================== --- sem_case.adb (revision 213156) +++ sem_case.adb (working copy) @@ -648,7 +648,7 @@ Num_Choices : constant Nat := Choice_Table'Last; Has_Predicate : constant Boolean := Is_OK_Static_Subtype (Bounds_Type) - and then Present (Static_Predicate (Bounds_Type)); + and then Has_Static_Predicate (Bounds_Type); Choice : Node_Id; Choice_Hi : Uint; @@ -696,13 +696,10 @@ -- Note that in GNAT the predicate is considered static if the predicate -- expression is static, independently of whether the aspect mentions - -- Static explicitly. It is unclear whether this is RM-conforming, but - -- it's certainly useful, and GNAT source make use of this. The downside - -- is that currently case expressions cannot appear in predicates that - -- are not static. ??? + -- Static explicitly. if Has_Predicate then - Pred := First (Static_Predicate (Bounds_Type)); + Pred := First (Static_Discrete_Predicate (Bounds_Type)); Prev_Lo := Uint_Minus_1; Prev_Hi := Uint_Minus_1; Error := False; @@ -1387,7 +1384,7 @@ if Is_OK_Static_Subtype (Subtyp) then if not Has_Predicates (Subtyp) - or else Present (Static_Predicate (Subtyp)) + or else Has_Static_Predicate (Subtyp) then Bounds_Type := Subtyp; else @@ -1464,7 +1461,7 @@ -- Use of non-static predicate is an error if not Is_Discrete_Type (E) - or else No (Static_Predicate (E)) + or else not Has_Static_Predicate (E) then Bad_Predicated_Subtype_Use ("cannot use subtype& with non-static " @@ -1484,7 +1481,7 @@ -- list is empty, corresponding to a False -- predicate, then no choices are checked. - P := First (Static_Predicate (E)); + P := First (Static_Discrete_Predicate (E)); while Present (P) loop C := New_Copy (P); Set_Sloc (C, Sloc (Choice)); Index: sem_eval.adb =================================================================== --- sem_eval.adb (revision 213159) +++ sem_eval.adb (working copy) @@ -330,7 +330,7 @@ -- types, so no need to make a special test for that). if not (Has_Static_Predicate (Typ) - and then Compile_Time_Known_Value (Expr)) + and then Compile_Time_Known_Value (Expr)) then return; end if; @@ -354,7 +354,7 @@ -- If static predicate matches, nothing to do - if Choices_Match (Expr, Static_Predicate (Typ)) = Match then + if Choices_Match (Expr, Static_Discrete_Predicate (Typ)) = Match then return; end if; @@ -383,6 +383,7 @@ ("??expression fails predicate check on &", Expr, Typ); end if; end Check_Expression_Against_Static_Predicate; + ------------------------------ -- Check_Non_Static_Context -- ------------------------------ Index: sem_eval.ads =================================================================== --- sem_eval.ads (revision 213159) +++ sem_eval.ads (working copy) @@ -232,7 +232,7 @@ -- -- Implementation note: an attempt to include this Ada 2012 case failed, -- since it appears that this routine is called in some cases before the - -- Static_Predicate field is set ??? + -- Static_Discrete_Predicate field is set ??? -- -- This differs from Is_OK_Static_Subtype (which is what must be used by -- clients) in that it does not care whether the bounds raise a constraint @@ -250,7 +250,7 @@ -- -- Implementation note: an attempt to include this Ada 2012 case failed, -- since it appears that this routine is called in some cases before the - -- Static_Predicate field is set ??? + -- Static_Discrete_Predicate field is set ??? -- -- This differs from Is_Static_Subtype in that it includes the constraint -- error checks, which are missing from Is_Static_Subtype. Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 213159) +++ sem_ch13.adb (working copy) @@ -97,8 +97,8 @@ -- name, which is unique, so any identifier with Chars matching Nam must be -- a reference to the type. If the predicate is non-static, this procedure -- returns doing nothing. If the predicate is static, then the predicate - -- list is stored in Static_Predicate (Typ), and the Expr is rewritten as - -- a canonicalized membership operation. + -- list is stored in Static_Discrete_Predicate (Typ), and the Expr is + -- rewritten as a canonicalized membership operation. procedure Build_Predicate_Functions (Typ : Entity_Id; N : Node_Id); -- If Typ has predicates (indicated by Has_Predicates being set for Typ), @@ -6266,13 +6266,13 @@ function Build_Val (V : Uint) return Node_Id; -- Return an analyzed N_Identifier node referencing this value, suitable - -- for use as an entry in the Static_Predicate list. This node is typed - -- with the base type. + -- for use as an entry in the Static_Discrte_Predicate list. This node + -- is typed with the base type. function Build_Range (Lo : Uint; Hi : Uint) return Node_Id; -- Return an analyzed N_Range node referencing this range, suitable for - -- use as an entry in the Static_Predicate list. This node is typed with - -- the base type. + -- use as an entry in the Static_Discrete_Predicate list. This node is + -- typed with the base type. function Get_RList (Exp : Node_Id) return RList; -- This is a recursive routine that converts the given expression into a @@ -6295,12 +6295,14 @@ -- name appears in parens, this routine will return False. function Lo_Val (N : Node_Id) return Uint; - -- Given static expression or static range from a Static_Predicate list, - -- gets expression value or low bound of range. + -- Given an entry from a Static_Discrete_Predicate list that is either + -- a static expression or static range, gets either the expression value + -- or the low bound of the range. function Hi_Val (N : Node_Id) return Uint; - -- Given static expression or static range from a Static_Predicate list, - -- gets expression value of high bound of range. + -- Given an entry from a Static_Discrete_Predicate list that is either + -- a static expression or static range, gets either the expression value + -- or the high bound of the range. function Membership_Entry (N : Node_Id) return RList; -- Given a single membership entry (range, value, or subtype), returns @@ -6920,18 +6922,19 @@ begin -- Not static if type does not have static predicates - if not Has_Predicates (Typ) or else No (Static_Predicate (Typ)) then + if not Has_Static_Predicate (Typ) then raise Non_Static; end if; -- Otherwise we convert the predicate list to a range list declare - Result : RList (1 .. List_Length (Static_Predicate (Typ))); + Spred : constant List_Id := Static_Discrete_Predicate (Typ); + Result : RList (1 .. List_Length (Spred)); P : Node_Id; begin - P := First (Static_Predicate (Typ)); + P := First (Static_Discrete_Predicate (Typ)); for J in Result'Range loop Result (J) := REnt'(Lo_Val (P), Hi_Val (P)); Next (P); @@ -6999,7 +7002,7 @@ -- Processing was successful and all entries were static, so now we -- can store the result as the predicate list. - Set_Static_Predicate (Typ, Plist); + Set_Static_Discrete_Predicate (Typ, Plist); -- The processing for static predicates put the expression into -- canonical form as a series of ranges. It also eliminated @@ -8027,7 +8030,7 @@ -- dynamic. But if we do succeed in building the list, then -- we mark the predicate as static. - if No (Static_Predicate (Typ)) then + if No (Static_Discrete_Predicate (Typ)) then Set_Has_Static_Predicate (Typ, False); end if; end if;