[Ada] Cleanup handling of discrete static predicates
Arnaud Charlet
charlet@adacore.com
Tue Jul 29 13:39:00 GMT 2014
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 <dewar@adacore.com>
* 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.
-------------- next part --------------
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;
More information about the Gcc-patches
mailing list