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.
+
+2014-07-29 Robert Dewar <dewar@adacore.com>
+
* gnat_rm.texi: Document pragma Unevaluated_Use_Of_Old.
* opt.adb: Handle Uneval_Old.
* opt.ads (Uneval_Old, Uneval_Old_Config): New variables.
-- 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
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
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
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??");
-- 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
-- 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)
-- 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)
-- 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)
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;
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);
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);
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);
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
-- 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
-- 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));
-- 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");
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 "
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);
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);
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;
-- 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;
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
-- 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 "
-- 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));
-- 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),
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
-- 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
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);
-- 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
-- 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;
-- 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
-- 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;
-- 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;
("??expression fails predicate check on &", Expr, Typ);
end if;
end Check_Expression_Against_Static_Predicate;
+
------------------------------
-- Check_Non_Static_Context --
------------------------------
--
-- 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
--
-- 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.
-- 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;
projects / platform / upstream / linaro-gcc.git / commitdiff