Patchwork [Ada] Fully implement general form static predicates

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 25, 2010, 2:45 p.m.
Message ID <20101025144511.GA13634@adacore.com>
Download mbox | patch
Permalink /patch/69103/
State New
Headers show

Comments

Arnaud Charlet - Oct. 25, 2010, 2:45 p.m.
This patch implements static predicates allowing all comparisons,
membership tests, linked by OR/NOT/AND/AND-THEN/OR-ELSE/XOR.

The following is a more extensive test, note that loops are
only allowed for the static predicate case, so that the fact
that the loop compiles shows that the static predicate has
been properly recognized:

     1. with Text_IO; use Text_IO;
     2. procedure Predicate_Loops is
     3.    type Int is range 1 .. 10;
     4.
     5.    subtype P1 is Int with
     6.      predicate =>
     7.        P1 in 3 | 5 .. 7 | 10 | 5 .. 6 | 6;
     8.
     9.    subtype P2 is Int with
    10.      predicate => P2 > 6;
    11.
    12.    subtype P3 is Int with
    13.      predicate => ((P3 > 6) and P3 < 9);
    14.
    15.    subtype P4 is Int with
    16.      predicate => (P4 in P2) and P4 < 10;
    17.
    18.    subtype P5 is Int with
    19.      predicate => P5 < 3 or P5 > 8;
    20.
    21.    subtype P6 is P5 with
                   |
        >>> info: "P6" inherits predicate from "P5" at line 18

    22.      predicate => P6 /= 1 and P6 /= 10;
    23.
    24.    subtype P7 is Int with
    25.      predicate => Boolean'(P7 not in 1 .. 7);
    26.
    27.    subtype P8 is Int with
    28.      predicate => not (P8 = 3 or else P8 in 5 .. 10);
    29.
    30.    subtype P9 is Int with
    31.      predicate => P9 in 1 .. 8 xor P9 in 3 .. 10;
    32.
    33.    type Enum is (A,B,C,D,E,F,G,H,I,J);
    34.
    35.    subtype E1 is Enum with
    36.      predicate =>
    37.        E1 in C | E .. G | J | E .. F | F;
    38.
    39.    subtype E2 is Enum with
    40.      predicate => E2 > F;
    41.
    42.    subtype E3 is Enum with
    43.      predicate => ((E3 > F) and E3 < I);
    44.
    45.    subtype E4 is Enum with
    46.      predicate => (E4 in E2) and E4 < J;
    47.
    48.    subtype E5 is Enum with
    49.      predicate => E5 < C or E5 > H;
    50.
    51.    subtype E6 is E5 with
                   |
        >>> info: "E6" inherits predicate from "E5" at line 48

    52.      predicate => E6 /= A and E6 /= J;
    53.
    54.    subtype E7 is Enum with
    55.      predicate => Boolean'(E7 not in A .. G);
    56.
    57.    subtype E8 is Enum with
    58.      predicate => not (E8 = C or else E8 in E .. J);
    59.
    60.    subtype E9 is Enum with
    61.      predicate => E9 in A .. H xor E9 in C .. J;
    62.
    63.    subtype T1 is Int with
    64.      predicate => True;
    65.
    66.    subtype T2 is Int with
    67.      predicate => False;
    68.
    69.    subtype T3 is Enum with
    70.      predicate => True;
    71.
    72.    subtype T4 is Enum with
    73.      predicate => False;
    74.
    75.
    76. begin
    77.    for J in P1 loop
    78.       Put_Line ("P1:" & J'Img);
    79.    end loop;
    80.
    81.    for J in P2 loop
    82.       Put_Line ("P2:" & J'Img);
    83.    end loop;
    84.
    85.    for J in P3 loop
    86.       Put_Line ("P3:" & J'Img);
    87.    end loop;
    88.
    89.    for J in P4 loop
    90.       Put_Line ("P4:" & J'Img);
    91.    end loop;
    92.
    93.    for J in P5 loop
    94.       Put_Line ("P5:" & J'Img);
    95.    end loop;
    96.
    97.    for J in P6 loop
    98.       Put_Line ("P6:" & J'Img);
    99.    end loop;
   100.
   101.    for J in P7 loop
   102.       Put_Line ("P7:" & J'Img);
   103.    end loop;
   104.
   105.    for J in P8 loop
   106.       Put_Line ("P8:" & J'Img);
   107.    end loop;
   108.
   109.    for J in P9 loop
   110.       Put_Line ("P9:" & J'Img);
   111.    end loop;
   112.
   113.    for J in E1 loop
   114.       Put_Line ("E1:" & J'Img);
   115.    end loop;
   116.
   117.    for J in E2 loop
   118.       Put_Line ("E2:" & J'Img);
   119.    end loop;
   120.
   121.    for J in E3 loop
   122.       Put_Line ("E3:" & J'Img);
   123.    end loop;
   124.
   125.    for J in E4 loop
   126.       Put_Line ("E4:" & J'Img);
   127.    end loop;
   128.
   129.    for J in E5 loop
   130.       Put_Line ("E5:" & J'Img);
   131.    end loop;
   132.
   133.    for J in E6 loop
   134.       Put_Line ("E6:" & J'Img);
   135.    end loop;
   136.
   137.    for J in E7 loop
   138.       Put_Line ("E7:" & J'Img);
   139.    end loop;
   140.
   141.    for J in E8 loop
   142.       Put_Line ("E8:" & J'Img);
   143.    end loop;
   144.
   145.    for J in E9 loop
   146.       Put_Line ("E9:" & J'Img);
   147.    end loop;
   148.
   149.    for J in T1 loop
   150.       Put_Line ("T1:" & J'Img);
   151.    end loop;
   152.
   153.    for J in T2 loop
   154.       Put_Line ("T2:" & J'Img);
   155.    end loop;
   156.
   157.    for J in T3 loop
   158.       Put_Line ("T3:" & J'Img);
   159.    end loop;
   160.
   161.    for J in T4 loop
   162.       Put_Line ("T4:" & J'Img);
   163.    end loop;
   164.
   165. end Predicate_Loops;

The output of this program is:

P1: 3
P1: 5
P1: 6
P1: 7
P1: 10
P2: 7
P2: 8
P2: 9
P2: 10
P3: 7
P3: 8
P4: 7
P4: 8
P4: 9
P5: 1
P5: 2
P5: 9
P5: 10
P6: 2
P6: 9
P7: 8
P7: 9
P7: 10
P8: 1
P8: 2
P8: 4
P9: 1
P9: 2
P9: 9
P9: 10
E1:C
E1:E
E1:F
E1:G
E1:J
E2:G
E2:H
E2:I
E2:J
E3:G
E3:H
E4:G
E4:H
E4:I
E5:A
E5:B
E5:I
E5:J
E6:B
E6:I
E7:H
E7:I
E7:J
E8:A
E8:B
E8:D
E9:A
E9:B
E9:I
E9:J
T1: 1
T1: 2
T1: 3
T1: 4
T1: 5
T1: 6
T1: 7
T1: 8
T1: 9
T1: 10
T3:A
T3:B
T3:C
T3:D
T3:E
T3:F
T3:G
T3:H
T3:I
T3:J

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-10-25  Robert Dewar  <dewar@adacore.com>

	* exp_ch5.adb (Expand_Predicated_Loop): Remove code for loop through
	non-static predicate, since we agree not to allow this.
	(Expand_Predicated_Loop): Properlay handle false predicate (null
	list in Static_Predicate field.
	* sem_ch13.adb (Build_Static_Predicate): Extensive changes to clean up
	handling of more general predicate forms.

Patch

Index: exp_ch5.adb
===================================================================
--- exp_ch5.adb	(revision 165916)
+++ exp_ch5.adb	(working copy)
@@ -3001,7 +3001,7 @@  package body Exp_Ch5 is
       if No (Isc) then
          null;
 
-      --  Case of for loop (Loop_Parameter_Specfication present)
+      --  Case of for loop (Loop_Parameter_Specification present)
 
       --  Note: we do not have to worry about validity checking of the for loop
       --  range bounds here, since they were frozen with constant declarations
@@ -3215,26 +3215,20 @@  package body Exp_Ch5 is
       Stmts   : constant List_Id    := Statements (N);
 
    begin
-      --  Case of iteration over non-static predicate. In this case we
-      --  generate the sequence:
-
-      --     for J in Ltype'First .. Ltype'Last loop
-      --        if Ltype_Predicate_Function (J) then
-      --           body;
-      --        end if;
-      --     end loop;
+      --  Case of iteration over non-static predicate, should not be possible
+      --  since this is not allowed by the semantics and should have been
+      --  caught during analysis of the loop statement.
 
       if No (Stat) then
+         raise Program_Error;
 
-         --  The analyzer already expanded the First/Last, so all we have
-         --  to do is wrap the body within the predicate function test.
-
-         Set_Statements (N, New_List (
-           Make_If_Statement (Loc,
-             Condition =>
-               Make_Predicate_Call (Ltype, New_Occurrence_Of (Loop_Id, Loc)),
-             Then_Statements => Stmts)));
-         Analyze (First (Statements (N)));
+      --  If the predicate list is empty, that corresponds to a predicate of
+      --  False, in which case the loop won't run at all, and we rewrite the
+      --  entire loop as a null statement.
+
+      elsif Is_Empty_List (Stat) then
+         Rewrite (N, Make_Null_Statement (Loc));
+         Analyze (N);
 
       --  For expansion over a static predicate we generate the following
 
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 165917)
+++ sem_ch13.adb	(working copy)
@@ -94,16 +94,16 @@  package body Sem_Ch13 is
      (Typ  : Entity_Id;
       Expr : Node_Id;
       Nam  : Name_Id);
-   --  Given a predicated type Typ, whose predicate expression is Expr, tests
-   --  if Expr is a static predicate, and if so, builds the predicate range
-   --  list. Nam is the name of the argument to the predicate function.
-   --  Occurrences of the type name in the predicate expression have been
-   --  replaced by identifer references to this 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 corresponding predicate list is stored
-   --  in Static_Predicate (Typ), and the Expr is rewritten as a canonicalized
-   --  membership operation.
+   --  Given a predicated type Typ, where Typ is a discrete static subtype,
+   --  whose predicate expression is Expr, tests if Expr is a static predicate,
+   --  and if so, builds the predicate range list. Nam is the name of the one
+   --  argument to the predicate function. Occurrences of the type name in the
+   --  predicate expression have been replaced by identifer references to this
+   --  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.
 
    function Get_Alignment_Value (Expr : Node_Id) return Uint;
    --  Given the expression for an alignment value, returns the corresponding
@@ -4045,7 +4045,13 @@  package body Sem_Ch13 is
 
          --  Deal with static predicate case
 
-         Build_Static_Predicate (Typ, Expr, Object_Name);
+         if Ekind_In (Typ, E_Enumeration_Subtype,
+                           E_Modular_Integer_Subtype,
+                           E_Signed_Integer_Subtype)
+           and then Is_Static_Subtype (Typ)
+         then
+            Build_Static_Predicate (Typ, Expr, Object_Name);
+         end if;
 
          --  Build function declaration
 
@@ -4115,8 +4121,15 @@  package body Sem_Ch13 is
       Non_Static : exception;
       --  Raised if something non-static is found
 
-      TLo, THi : Uint;
-      --  Low bound and high bound values of static subtype of Typ
+      Btyp : constant Entity_Id := Base_Type (Typ);
+
+      BLo : constant Uint := Expr_Value (Type_Low_Bound  (Btyp));
+      BHi : constant Uint := Expr_Value (Type_High_Bound (Btyp));
+      --  Low bound and high bound value of base type of Typ
+
+      TLo : constant Uint := Expr_Value (Type_Low_Bound  (Typ));
+      THi : constant Uint := Expr_Value (Type_High_Bound (Typ));
+      --  Low bound and high bound values of static subtype Typ
 
       type REnt is record
          Lo, Hi : Uint;
@@ -4128,15 +4141,20 @@  package body Sem_Ch13 is
       type RList is array (Nat range <>) of REnt;
       --  A list of ranges. The ranges are sorted in increasing order,
       --  and are disjoint (there is a gap of at least one value between
-      --  each range in the table).
+      --  each range in the table). A value is in the set of ranges in
+      --  Rlist if it lies within one of these ranges
 
-      Null_Range : constant RList := RList'(1 .. 0 => REnt'(No_Uint, No_Uint));
-      True_Range : RList renames Null_Range;
-      --  Constant representing null list of ranges, used to represent a
-      --  predicate of True, since there are no ranges to be satisfied.
+      False_Range : constant RList :=
+                      RList'(1 .. 0 => REnt'(No_Uint, No_Uint));
+      --  An empty set of ranges represents a range list that can never be
+      --  satisfied, since there are no ranges in which the value could lie,
+      --  so it does not lie in any of them. False_Range is a canonical value
+      --  for this empty set, but general processing should test for an Rlist
+      --  with length zero (see Is_False predicate), since other null ranges
+      --  may appear which must be treated as False.
 
-      False_Range : constant RList := RList'(1 => REnt'(Uint_1, Uint_0));
-      --  Range representing false
+      True_Range : constant RList := RList'(1 => REnt'(BLo, BHi));
+      --  Range representing True, value must be in the base range
 
       function "and" (Left, Right : RList) return RList;
       --  And's together two range lists, returning a range list. This is
@@ -4153,16 +4171,27 @@  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.
+      --  for use as an entry in the Static_Predicate list. This node is typed
+      --  with the base type.
 
       function Build_Range (Lo, 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.
+      --  for use as an entry in the Static_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 list of ranges, suitable for use in building the static predicate.
 
+      function Is_False (R : RList) return Boolean;
+      pragma Inline (Is_False);
+      --  Returns True if the given range list is empty, and thus represents
+      --  a False list of ranges that can never be satsified.
+
+      function Is_True (R : RList) return Boolean;
+      --  Returns True if R trivially represents the True predicate by having
+      --  a single range from BLo to BHi.
+
       function Is_Type_Ref (N : Node_Id) return Boolean;
       pragma Inline (Is_Type_Ref);
       --  Returns if True if N is a reference to the type for the predicate in
@@ -4207,21 +4236,15 @@  package body Sem_Ch13 is
       begin
          --  If either range is True, return the other
 
-         if Left = True_Range then
+         if Is_True (Left) then
             return Right;
-         elsif Right = True_Range then
+         elsif Is_True (Right) then
             return Left;
          end if;
 
          --  If either range is False, return False
 
-         if Left = False_Range or else Right = False_Range then
-            return False_Range;
-         end if;
-
-         --  If either range is empty, return False
-
-         if Left'Length = 0 or else Right'Length = 0 then
+         if Is_False (Left) or else Is_False (Right) then
             return False_Range;
          end if;
 
@@ -4267,18 +4290,13 @@  package body Sem_Ch13 is
             SRight := SRight + 1;
          end if;
 
-         --  If either operand is empty, that's the only entry
-
-         if SLeft > Left'Last or else SRight > Right'Last then
-            return RList'(1 => FEnt);
+         --  Compute result by concatenating this first entry with the "and"
+         --  of the remaining parts of the left and right operands. Note that
+         --  if either of these is empty, "and" will yield empty, so that we
+         --  will end up with just Fent, which is what we want in that case.
 
-         --  Else compute and of remaining entries and concatenate
-
-         else
-            return
-              FEnt &
-                (Left (SLeft .. Left'Last) and Right (SRight .. Right'Last));
-         end if;
+         return
+           FEnt & (Left (SLeft .. Left'Last) and Right (SRight .. Right'Last));
       end "and";
 
       -----------
@@ -4289,13 +4307,13 @@  package body Sem_Ch13 is
       begin
          --  Return True if False range
 
-         if Right = False_Range then
+         if Is_False (Right) then
             return True_Range;
          end if;
 
          --  Return False if True range
 
-         if Right'Length = 0 then
+         if Is_True (Right) then
             return False_Range;
          end if;
 
@@ -4340,100 +4358,76 @@  package body Sem_Ch13 is
       ----------
 
       function "or" (Left, Right : RList) return RList is
+         FEnt : REnt;
+         --  First range of result
+
+         SLeft : Nat := Left'First;
+         --  Start of rest of left entries
+
+         SRight : Nat := Right'First;
+         --  Start of rest of right entries
+
       begin
          --  If either range is True, return True
 
-         if Left = True_Range or else Right = True_Range then
+         if Is_True (Left) or else Is_True (Right) then
             return True_Range;
          end if;
 
-         --  If either range is False, return the other
+         --  If either range is False (empty), return the other
 
-         if Left = False_Range then
+         if Is_False (Left) then
             return Right;
-         elsif Right = False_Range then
+         elsif Is_False (Right) then
             return Left;
          end if;
 
-         --  If either operand is null, return the other one
+         --  Initialize result first entry from left or right operand
+         --  depending on which starts with the lower range.
 
-         if Left'Length = 0 then
-            return Right;
-         elsif Right'Length = 0 then
-            return Left;
+         if Left (SLeft).Lo < Right (SRight).Lo then
+            FEnt := Left (SLeft);
+            SLeft := SLeft + 1;
+         else
+            FEnt := Right (SRight);
+            SRight := SRight + 1;
          end if;
 
-         --  Now we have two non-null ranges
-
-         declare
-            FEnt : REnt;
-            --  First range of result
-
-            SLeft : Nat := Left'First;
-            --  Start of rest of left entries
-
-            SRight : Nat := Right'First;
-            --  Start of rest of right entries
+         --  This loop eats ranges from left and right operands that
+         --  are contiguous with the first range we are gathering.
 
-         begin
-            --  Initialize result first entry from left or right operand
-            --  depending on which starts with the lower range.
+         loop
+            --  Eat first entry in left operand if contiguous or
+            --  overlapped by gathered first operand of result.
 
-            if Left (SLeft).Lo < Right (SRight).Lo then
-               FEnt := Left (SLeft);
+            if SLeft <= Left'Last
+              and then Left (SLeft).Lo <= FEnt.Hi + 1
+            then
+               FEnt.Hi := UI_Max (FEnt.Hi, Left (SLeft).Hi);
                SLeft := SLeft + 1;
-            else
-               FEnt := Right (SRight);
-               SRight := SRight + 1;
-            end if;
-
-            --  This loop eats ranges from left and right operands that
-            --  are contiguous with the first range we are gathering.
-
-            loop
-               --  Eat first entry in left operand if contiguous or
-               --  overlapped by gathered first operand of result.
-
-               if SLeft <= Left'Last
-                 and then Left (SLeft).Lo <= FEnt.Hi + 1
-               then
-                  FEnt.Hi := UI_Max (FEnt.Hi, Left (SLeft).Hi);
-                  SLeft := SLeft + 1;
 
                --  Eat first entry in right operand if contiguous or
                --  overlapped by gathered right operand of result.
 
-               elsif SRight <= Right'Last
-                 and then Right (SRight).Lo <= FEnt.Hi + 1
-               then
-                  FEnt.Hi := UI_Max (FEnt.Hi, Right (SRight).Hi);
-                  SRight := SRight + 1;
+            elsif SRight <= Right'Last
+              and then Right (SRight).Lo <= FEnt.Hi + 1
+            then
+               FEnt.Hi := UI_Max (FEnt.Hi, Right (SRight).Hi);
+               SRight := SRight + 1;
 
                --  All done if no more entries to eat!
 
-               else
-                  exit;
-               end if;
-            end loop;
-
-            --  If left operand now empty, concatenate our new entry to right
-
-            if SLeft > Left'Last then
-               return FEnt & Right (SRight .. Right'Last);
-
-            --  If right operand now empty, concatenate our new entry to left
-
-            elsif SRight > Right'Last then
-               return FEnt & Left (SLeft .. Left'Last);
-
-            --  Otherwise, compute or of what is left and concatenate
-
             else
-               return
-                 FEnt &
-                  (Left (SLeft .. Left'Last) or Right (SRight .. Right'Last));
+               exit;
             end if;
-         end;
+         end loop;
+
+         --  Obtain result as the first entry we just computed, concatenated
+         --  to the "or" of the remaining results (if one operand is empty,
+         --  this will just concatenate with the other
+
+         return
+           FEnt & (Left (SLeft .. Left'Last) or Right (SRight .. Right'Last));
       end "or";
 
       -----------------
@@ -4450,7 +4444,7 @@  package body Sem_Ch13 is
               Make_Range (Loc,
                 Low_Bound  => Build_Val (Lo),
                 High_Bound => Build_Val (Hi));
-            Set_Etype (Result, Typ);
+            Set_Etype (Result, Btyp);
             Set_Analyzed (Result);
             return Result;
          end if;
@@ -4470,7 +4464,7 @@  package body Sem_Ch13 is
             Result := Make_Integer_Literal (Loc, Intval => V);
          end if;
 
-         Set_Etype (Result, Typ);
+         Set_Etype (Result, Btyp);
          Set_Is_Static_Expression (Result);
          Set_Analyzed (Result);
          return Result;
@@ -4489,15 +4483,12 @@  package body Sem_Ch13 is
 
          if Is_OK_Static_Expression (Exp) then
 
-            --  For False, return impossible range, which will always fail
+            --  For False
 
             if Expr_Value (Exp) = 0 then
                return False_Range;
-
-            --  For True, null range
-
             else
-               return Null_Range;
+               return True_Range;
             end if;
          end if;
 
@@ -4566,20 +4557,20 @@  package body Sem_Ch13 is
                      return RList'(1 => REnt'(Val, Val));
 
                   when N_Op_Ge =>
-                     return RList'(1 => REnt'(Val, THi));
+                     return RList'(1 => REnt'(Val, BHi));
 
                   when N_Op_Gt =>
-                     return RList'(1 => REnt'(Val + 1, THi));
+                     return RList'(1 => REnt'(Val + 1, BHi));
 
                   when N_Op_Le =>
-                     return RList'(1 => REnt'(TLo, Val));
+                     return RList'(1 => REnt'(BLo, Val));
 
                   when N_Op_Lt =>
-                     return RList'(1 => REnt'(TLo, Val - 1));
+                     return RList'(1 => REnt'(BLo, Val - 1));
 
                   when N_Op_Ne =>
-                     return RList'(REnt'(TLo, Val - 1),
-                                   REnt'(Val + 1, THi));
+                     return RList'(REnt'(BLo, Val - 1),
+                                   REnt'(Val + 1, BHi));
 
                   when others  =>
                      raise Program_Error;
@@ -4633,6 +4624,14 @@  package body Sem_Ch13 is
             when N_Qualified_Expression =>
                return Get_RList (Expression (Exp));
 
+            --  Xor operator
+
+            when N_Op_Xor =>
+               return (Get_RList (Left_Opnd (Exp))
+                        and not Get_RList (Right_Opnd (Exp)))
+                 or   (Get_RList (Right_Opnd (Exp))
+                        and not Get_RList (Left_Opnd (Exp)));
+
             --  Any other node type is non-static
 
             when others =>
@@ -4654,6 +4653,26 @@  package body Sem_Ch13 is
          end if;
       end Hi_Val;
 
+      --------------
+      -- Is_False --
+      --------------
+
+      function Is_False (R : RList) return Boolean is
+      begin
+         return R'Length = 0;
+      end Is_False;
+
+      -------------
+      -- Is_True --
+      -------------
+
+      function Is_True (R : RList) return Boolean is
+      begin
+         return R'Length = 1
+           and then R (R'First).Lo = BLo
+           and then R (R'First).Hi = BHi;
+      end Is_True;
+
       -----------------
       -- Is_Type_Ref --
       -----------------
@@ -4789,22 +4808,6 @@  package body Sem_Ch13 is
    --  Start of processing for Build_Static_Predicate
 
    begin
-      --  Immediately non-static if our subtype is non static, or we
-      --  do not have an appropriate discrete subtype in the first place.
-
-      if not Ekind_In (Typ, E_Enumeration_Subtype,
-                            E_Modular_Integer_Subtype,
-                            E_Signed_Integer_Subtype)
-        or else not Is_Static_Subtype (Typ)
-      then
-         return;
-      end if;
-
-      --  Get bounds of the type
-
-      TLo := Expr_Value (Type_Low_Bound  (Typ));
-      THi := Expr_Value (Type_High_Bound (Typ));
-
       --  Now analyze the expression to see if it is a static predicate
 
       declare
@@ -4818,18 +4821,45 @@  package body Sem_Ch13 is
          --  Ranges array, we just have raw ranges, these must be converted
          --  to properly typed and analyzed static expressions or range nodes.
 
+         --  Note: here we limit ranges to the ranges of the subtype, so that
+         --  a predicate is always false for values outside the subtype. That
+         --  seems fine, such values are invalid anyway, and considering them
+         --  to fail the predicate seems allowed and friendly, and furthermore
+         --  simplifies processing for case statements and loops.
+
          Plist := New_List;
 
          for J in Ranges'Range loop
             declare
-               Lo : constant Uint := Ranges (J).Lo;
-               Hi : constant Uint := Ranges (J).Hi;
+               Lo : Uint := Ranges (J).Lo;
+               Hi : Uint := Ranges (J).Hi;
 
             begin
-               if Lo = Hi then
-                  Append_To (Plist, Build_Val (Lo));
+               --  Ignore completely out of range entry
+
+               if Hi < TLo or else Lo > THi then
+                  null;
+
+                  --  Otherwise process entry
+
                else
-                  Append_To (Plist, Build_Range (Lo, Hi));
+                  --  Adjust out of range value to subtype range
+
+                  if Lo < TLo then
+                     Lo := TLo;
+                  end if;
+
+                  if Hi > THi then
+                     Hi := THi;
+                  end if;
+
+                  --  Convert range into required form
+
+                  if Lo = Hi then
+                     Append_To (Plist, Build_Val (Lo));
+                  else
+                     Append_To (Plist, Build_Range (Lo, Hi));
+                  end if;
                end if;
             end;
          end loop;
@@ -4865,21 +4895,12 @@  package body Sem_Ch13 is
                Next (Old_Node);
             end loop;
 
-            --  If empty list, replace by True
+            --  If empty list, replace by False
 
             if Is_Empty_List (New_Alts) then
-               Rewrite (Expr, New_Occurrence_Of (Standard_True, Loc));
-
-            --  If singleton list, replace by simple membership test
-
-            elsif List_Length (New_Alts) = 1 then
-               Rewrite (Expr,
-                 Make_In (Loc,
-                   Left_Opnd    => Make_Identifier (Loc, Nam),
-                   Right_Opnd   => Relocate_Node (First (New_Alts)),
-                   Alternatives => No_List));
+               Rewrite (Expr, New_Occurrence_Of (Standard_False, Loc));
 
-            --  If more than one range, replace by set membership test
+            --  Else replace by set membership test
 
             else
                Rewrite (Expr,