sem_aggr.adb, [...]: General cleanup of static predicate handling.

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.

From-SVN: r213161

13 files changed, 68 insertions, 55 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8b3e285..e598c0c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,14 @@
 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.
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 8c967d3..ac62412 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -222,7 +222,7 @@ package body Einfo is
    --    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 @@ package body Einfo is
       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 @@ package body Einfo is
       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 @@ package body Einfo is
               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??");
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 141ad09..d6f7d7d 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3897,7 +3897,7 @@ package Einfo is
 --       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 @@ package Einfo is
    --    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 @@ package Einfo is
    --    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 @@ package Einfo is
    --  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 @@ package Einfo is
    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 @@ package Einfo is
    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 @@ package Einfo is
    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 @@ package Einfo is
    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);
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 8c76981..78f876b 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -3977,7 +3977,7 @@ package body Exp_Ch5 is
       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
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index d94e69d..d2a5f84 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1980,7 +1980,7 @@ package body Exp_Util is
             --  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
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 5171398..1f72ed9 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -1721,11 +1721,11 @@ package body Sem_Aggr is
                         --  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));
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 1619d6f..8b70326 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1498,7 +1498,7 @@ package body Sem_Attr is
          --  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 @@ package body Sem_Attr is
          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 @@ package body Sem_Attr is
       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 @@ package body Sem_Attr is
       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);
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index 7a8a60a..709a264 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -648,7 +648,7 @@ package body Sem_Case is
       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 @@ package body Sem_Case is
 
       --  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 @@ package body Sem_Case is
 
          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 @@ package body Sem_Case is
                            --  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 @@ package body Sem_Case is
                                  --  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));
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 9c9c6da..e0c6782 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -97,8 +97,8 @@ package body Sem_Ch13 is
    --  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 @@ package body Sem_Ch13 is
 
       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 @@ package body Sem_Ch13 is
       --  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 @@ package body Sem_Ch13 is
       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 @@ package body Sem_Ch13 is
          --  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 @@ package body Sem_Ch13 is
                   --  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;
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 26acb3b..265c2c7 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2480,8 +2480,8 @@ package body Sem_Ch5 is
          --  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
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 27e1d20..57152ae 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -330,7 +330,7 @@ package body Sem_Eval is
       --  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 @@ package body Sem_Eval is
 
       --  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 @@ package body Sem_Eval is
            ("??expression fails predicate check on &", Expr, Typ);
       end if;
    end Check_Expression_Against_Static_Predicate;
+
    ------------------------------
    -- Check_Non_Static_Context --
    ------------------------------
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index b4dbec8..fd9dce0 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -232,7 +232,7 @@ package Sem_Eval is
    --
    --  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 @@ package Sem_Eval is
    --
    --  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.
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 76cc667..0782c50 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -798,7 +798,7 @@ package body Sem_Util is
          --  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;