Patchwork [Ada] Implement more general predicates

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 25, 2010, 1:51 p.m.
Message ID <20101025135117.GA719@adacore.com>
Download mbox | patch
Permalink /patch/69100/
State New
Headers show

Comments

Arnaud Charlet - Oct. 25, 2010, 1:51 p.m.
This rewrite of handling of static predicates allows much more general
predicate forms, including inheritance of static predicates, comparisons
with static values, IN, NOT IN, and the use of AND/OR/NOT to join
conditions to create more complex static predicates.

The following program compiled with -gnat12 shows some of the new
capabilities (all capabilities are there, not all have been tested yet)

     1. with Text_IO; use Text_IO;
     2. procedure Predicate_Loops is
     3.    type Int is range 1 .. 10;
     4.
     5.    subtype P2 is Int with
     6.      predicate => P2 > 6;
     7.
     8.    subtype P3 is Int with
     9.      predicate => ((P3 > 6) and P3 < 9);
    10.
    11.    subtype P4 is Int with
    12.      predicate => (P4 in P2) and P4 < 10;
    13.
    14.    subtype P5 is Int with
    15.      predicate => P5 < 3 or P5 > 8;
    16.
    17. begin
    18.    for J in P2 loop
    19.       Put_Line ("P2:" & J'Img);
    20.    end loop;
    21.
    22.    for J in P3 loop
    23.       Put_Line ("P3:" & J'Img);
    24.    end loop;
    25.
    26.    for J in P4 loop
    27.       Put_Line ("P4:" & J'Img);
    28.    end loop;
    29.
    30.    for J in P5 loop
    31.       Put_Line ("P5:" & J'Img);
    32.    end loop;
    33. end Predicate_Loops;

The output is:

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

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

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

	* sem_ch13.adb (Build_Static_Predicate): Moved out of
	Build_Predicate_Function.
	(Build_Static_Predicate): Complet rewrite for more general predicates

Patch

Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 165916)
+++ sem_ch13.adb	(working copy)
@@ -77,10 +77,6 @@  package body Sem_Ch13 is
    --  inherited from a derived type that is no longer appropriate for the
    --  new Esize value. In this case, we reset the Alignment to unknown.
 
-   -----------------------
-   -- Local Subprograms --
-   -----------------------
-
    procedure Build_Predicate_Function
      (Typ   : Entity_Id;
       FDecl : out Node_Id;
@@ -94,6 +90,21 @@  package body Sem_Ch13 is
    --  and setting Predicate_Procedure for Typ. In some error situations no
    --  procedure is built, in which case PDecl/PBody are empty on return.
 
+   procedure Build_Static_Predicate
+     (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.
+
    function Get_Alignment_Value (Expr : Node_Id) return Uint;
    --  Given the expression for an alignment value, returns the corresponding
    --  Uint value. If the value is inappropriate, then error messages are
@@ -3851,10 +3862,6 @@  package body Sem_Ch13 is
       --  Inheritance of predicates for the parent type is done by calling the
       --  Predicate_Function of the parent type, using Add_Call above.
 
-      procedure Build_Static_Predicate;
-      --  This function is called to process a static predicate, and put it in
-      --  canonical form and store it in Static_Predicate (Typ).
-
       Object_Name : constant Name_Id := New_Internal_Name ('I');
       --  Name for argument of Predicate procedure
 
@@ -4001,455 +4008,895 @@  package body Sem_Ch13 is
          end loop;
       end Add_Predicates;
 
-      ----------------------------
-      -- Build_Static_Predicate --
-      ----------------------------
+   --  Start of processing for Build_Predicate_Function
+
+   begin
+      --  Initialize for construction of statement list
 
-      procedure Build_Static_Predicate is
-         Exp : Node_Id;
-         Alt : Node_Id;
+      Expr  := Empty;
+      FDecl := Empty;
+      FBody := Empty;
+
+      --  Return if already built or if type does not have predicates
+
+      if not Has_Predicates (Typ)
+        or else Present (Predicate_Function (Typ))
+      then
+         return;
+      end if;
+
+      --  Add Predicates for the current type
+
+      Add_Predicates;
+
+      --  Add predicates for ancestor if present
+
+      declare
+         Atyp : constant Entity_Id := Nearest_Ancestor (Typ);
+      begin
+         if Present (Atyp) then
+            Add_Call (Atyp);
+         end if;
+      end;
+
+      --  If we have predicates, build the function
+
+      if Present (Expr) then
+
+         --  Deal with static predicate case
+
+         Build_Static_Predicate (Typ, Expr, Object_Name);
+
+         --  Build function declaration
+
+         pragma Assert (Has_Predicates (Typ));
+         SId :=
+           Make_Defining_Identifier (Loc,
+             Chars => New_External_Name (Chars (Typ), "Predicate"));
+         Set_Has_Predicates (SId);
+         Set_Predicate_Function (Typ, SId);
+
+         Spec :=
+           Make_Function_Specification (Loc,
+             Defining_Unit_Name       => SId,
+             Parameter_Specifications => New_List (
+               Make_Parameter_Specification (Loc,
+                 Defining_Identifier =>
+                   Make_Defining_Identifier (Loc, Chars => Object_Name),
+                 Parameter_Type      => New_Occurrence_Of (Typ, Loc))),
+             Result_Definition        =>
+               New_Occurrence_Of (Standard_Boolean, Loc));
+
+         FDecl :=
+           Make_Subprogram_Declaration (Loc,
+             Specification => Spec);
+
+         --  Build function body
+
+         SId :=
+           Make_Defining_Identifier (Loc,
+             Chars => New_External_Name (Chars (Typ), "Predicate"));
+
+         Spec :=
+           Make_Function_Specification (Loc,
+             Defining_Unit_Name       => SId,
+             Parameter_Specifications => New_List (
+               Make_Parameter_Specification (Loc,
+                 Defining_Identifier =>
+                   Make_Defining_Identifier (Loc, Chars => Object_Name),
+                 Parameter_Type =>
+                   New_Occurrence_Of (Typ, Loc))),
+             Result_Definition        =>
+               New_Occurrence_Of (Standard_Boolean, Loc));
 
-         Non_Static : Boolean := False;
-         --  Set True if something non-static is found
+         FBody :=
+           Make_Subprogram_Body (Loc,
+             Specification              => Spec,
+             Declarations               => Empty_List,
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 Statements => New_List (
+                   Make_Simple_Return_Statement (Loc,
+                     Expression => Expr))));
+      end if;
+   end Build_Predicate_Function;
+
+   ----------------------------
+   -- Build_Static_Predicate --
+   ----------------------------
+
+   procedure Build_Static_Predicate
+     (Typ  : Entity_Id;
+      Expr : Node_Id;
+      Nam  : Name_Id)
+   is
+      Loc : constant Source_Ptr := Sloc (Expr);
 
-         Plist : List_Id := No_List;
-         --  The entries in Plist are either static expressions which represent
-         --  a possible value, or ranges of values. Subtype marks don't appear,
-         --  since we expand them out.
+      Non_Static : exception;
+      --  Raised if something non-static is found
 
+      TLo, THi : Uint;
+      --  Low bound and high bound values of static subtype of Typ
+
+      type REnt is record
          Lo, Hi : Uint;
-         --  Low bound and high bound values of static subtype of Typ
+      end record;
+      --  One entry in a Rlist value, a single REnt (range entry) value
+      --  denotes one range from Lo to Hi. To represent a single value
+      --  range Lo = Hi = value.
+
+      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).
+
+      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 => REnt'(Uint_1, Uint_0));
+      --  Range representing false
+
+      function "and" (Left, Right : RList) return RList;
+      --  And's together two range lists, returning a range list. This is
+      --  a set intersection operation.
+
+      function "or" (Left, Right : RList) return RList;
+      --  Or's together two range lists, returning a range list. This is a
+      --  set union operation.
+
+      function "not" (Right : RList) return RList;
+      --  Returns complement of a given range list, i.e. a range list
+      --  representing all the values in TLo .. THi that are not in the
+      --  input operand Right.
+
+      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.
+
+      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.
+
+      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_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
+      --  the expression (i.e. if it is an identifier whose Chars field matches
+      --  the Nam given in the call).
+
+      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.
+
+      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.
+
+      function Membership_Entry (N : Node_Id) return RList;
+      --  Given a single membership entry (range, value, or subtype), returns
+      --  the corresponding range list. Raises Static_Error if not static.
+
+      function Membership_Entries (N : Node_Id) return RList;
+      --  Given an element on an alternatives list of a membership operation,
+      --  returns the range list corresponding to this entry and all following
+      --  entries (i.e. returns the "or" of this list of values).
+
+      function Stat_Pred (Typ : Entity_Id) return RList;
+      --  Given a type, if it has a static predicate, then return the predicate
+      --  as a range list, otherwise raise Non_Static.
+
+      -----------
+      -- "and" --
+      -----------
+
+      function "and" (Left, Right : RList) return RList is
+         FEnt : REnt;
+         --  First range of result
 
-         procedure Process_Entry (N : Node_Id);
-         --  Process one entry (range or value or subtype mark)
+         SLeft : Nat := Left'First;
+         --  Start of rest of left entries
 
-         -------------------
-         -- Process_Entry --
-         -------------------
+         SRight : Nat := Right'First;
+         --  Start of rest of right entries
 
-         procedure Process_Entry (N : Node_Id) is
-            SLo, SHi : Uint;
-            --  Low and high bounds of range in list
+      begin
+         --  If either range is True, return the other
 
-            P : Node_Id;
+         if Left = True_Range then
+            return Right;
+         elsif Right = True_Range then
+            return Left;
+         end if;
 
-            function Build_Val (V : Uint) return Node_Id;
-            --  Return an analyzed N_Identifier node referencing this value
+         --  If either range is False, return False
 
-            function Build_Range (Lo, Hi : Uint) return Node_Id;
-            --  Return an analyzed N_Range node referencing this range
+         if Left = False_Range or else Right = False_Range then
+            return False_Range;
+         end if;
 
-            function Lo_Val (N : Node_Id) return Uint;
-            --  Given static expression or static range, gets expression value
-            --  or low bound of range.
+         --  If either range is empty, return False
 
-            function Hi_Val (N : Node_Id) return Uint;
-            --  Given static expression or static range, gets expression value
-            --  of high bound of range.
+         if Left'Length = 0 or else Right'Length = 0 then
+            return False_Range;
+         end if;
 
-            -----------------
-            -- Build_Range --
-            -----------------
+         --  Loop to remove entries at start that are disjoint, and thus
+         --  just get discarded from the result entirely.
 
-            function Build_Range (Lo, Hi : Uint) return Node_Id is
-               Result : Node_Id;
-            begin
-               if Lo = Hi then
-                  return Build_Val (Hi);
-               else
-                  Result :=
-                    Make_Range (Sloc (N),
-                      Low_Bound  => Build_Val (Lo),
-                      High_Bound => Build_Val (Hi));
-                  Set_Etype (Result, Typ);
-                  Set_Analyzed (Result);
-                  return Result;
-               end if;
-            end Build_Range;
-
-            ---------------
-            -- Build_Val --
-            ---------------
+         loop
+            --  If no operands left in either operand, result is false
 
-            function Build_Val (V : Uint) return Node_Id is
-               Result : Node_Id;
+            if SLeft > Left'Last or else SRight > Right'Last then
+               return False_Range;
 
-            begin
-               if Is_Enumeration_Type (Typ) then
-                  Result := Get_Enum_Lit_From_Pos (Typ, V, Sloc (N));
-               else
-                  Result := Make_Integer_Literal (Sloc (N), Intval => V);
-               end if;
+            --  Discard first left operand entry if disjoint with right
 
-               Set_Etype (Result, Typ);
-               Set_Is_Static_Expression (Result);
-               Set_Analyzed (Result);
-               return Result;
-            end Build_Val;
+            elsif Left (SLeft).Hi < Right (SRight).Lo then
+               SLeft := SLeft + 1;
 
-            ------------
-            -- Hi_Val --
-            ------------
+            --  Discard first right operand entry if disjoint with left
 
-            function Hi_Val (N : Node_Id) return Uint is
-            begin
-               if Is_Static_Expression (N) then
-                  return Expr_Value (N);
-               else
-                  pragma Assert (Nkind (N) = N_Range);
-                  return Expr_Value (High_Bound (N));
-               end if;
-            end Hi_Val;
+            elsif Right (SRight).Hi < Left (SLeft).Lo then
+               SRight := SRight + 1;
 
-            ------------
-            -- Lo_Val --
-            ------------
+            --  Otherwise we have an overlapping entry
 
-            function Lo_Val (N : Node_Id) return Uint is
-            begin
-               if Is_Static_Expression (N) then
-                  return Expr_Value (N);
-               else
-                  pragma Assert (Nkind (N) = N_Range);
-                  return Expr_Value (Low_Bound (N));
-               end if;
-            end Lo_Val;
+            else
+               exit;
+            end if;
+         end loop;
+
+         --  Now we have two non-null operands, and first entries overlap.
+         --  The first entry in the result will be the overlapping part of
+         --  these two entries.
+
+         FEnt := REnt'(Lo => UI_Max (Left (SLeft).Lo, Right (SRight).Lo),
+                       Hi => UI_Min (Left (SLeft).Hi, Right (SRight).Hi));
+
+         --  Now we can remove the entry that ended at a lower value, since
+         --  its contribution is entirely contained in Fent.
+
+         if Left (SLeft).Hi <= Right (SRight).Hi then
+            SLeft := SLeft + 1;
+         else
+            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);
+
+         --  Else compute and of remaining entries and concatenate
+
+         else
+            return
+              FEnt &
+                (Left (SLeft .. Left'Last) and Right (SRight .. Right'Last));
+         end if;
+      end "and";
+
+      -----------
+      -- "not" --
+      -----------
+
+      function "not" (Right : RList) return RList is
+      begin
+         --  Return True if False range
+
+         if Right = False_Range then
+            return True_Range;
+         end if;
 
-         --  Start of processing for Process_Entry
+         --  Return False if True range
+
+         if Right'Length = 0 then
+            return False_Range;
+         end if;
+
+         --  Here if not trivial case
+
+         declare
+            Result : RList (1 .. Right'Length + 1);
+            --  May need one more entry for gap at beginning and end
+
+            Count : Nat := 0;
+            --  Number of entries stored in Result
 
          begin
-            --  Range case
+            --  Gap at start
 
-            if Nkind (N) = N_Range then
-               if not Is_Static_Expression (Low_Bound (N))
-                    or else
-                  not Is_Static_Expression (High_Bound (N))
+            if Right (Right'First).Lo > TLo then
+               Count := Count + 1;
+               Result (Count) := REnt'(TLo, Right (Right'First).Lo - 1);
+            end if;
+
+            --  Gaps between ranges
+
+            for J in Right'First .. Right'Last - 1 loop
+               Count := Count + 1;
+               Result (Count) :=
+                 REnt'(Right (J).Hi + 1, Right (J + 1).Lo - 1);
+            end loop;
+
+            --  Gap at end
+
+            if Right (Right'Last).Hi < THi then
+               Count := Count + 1;
+               Result (Count) := REnt'(Right (Right'Last).Hi + 1, THi);
+            end if;
+
+            return Result (1 .. Count);
+         end;
+      end "not";
+
+      ----------
+      -- "or" --
+      ----------
+
+      function "or" (Left, Right : RList) return RList is
+      begin
+         --  If either range is True, return True
+
+         if Left = True_Range or else Right = True_Range then
+            return True_Range;
+         end if;
+
+         --  If either range is False, return the other
+
+         if Left = False_Range then
+            return Right;
+         elsif Right = False_Range then
+            return Left;
+         end if;
+
+         --  If either operand is null, return the other one
+
+         if Left'Length = 0 then
+            return Right;
+         elsif Right'Length = 0 then
+            return Left;
+         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
+
+         begin
+            --  Initialize result first entry from left or right operand
+            --  depending on which starts with the lower range.
+
+            if Left (SLeft).Lo < Right (SRight).Lo then
+               FEnt := Left (SLeft);
+               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
-                  Non_Static := True;
-                  return;
+                  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;
+
+               --  All done if no more entries to eat!
+
                else
-                  SLo := Lo_Val (N);
-                  SHi := Hi_Val (N);
+                  exit;
                end if;
+            end loop;
 
-            --  Static expression case
+            --  If left operand now empty, concatenate our new entry to right
 
-            elsif Is_Static_Expression (N) then
-               SLo := Lo_Val (N);
-               SHi := Hi_Val (N);
+            if SLeft > Left'Last then
+               return FEnt & Right (SRight .. Right'Last);
 
-            --  Identifier (other than static expression) case
+            --  If right operand now empty, concatenate our new entry to left
 
-            else pragma Assert (Nkind (N) = N_Identifier);
+            elsif SRight > Right'Last then
+               return FEnt & Left (SLeft .. Left'Last);
 
-               --  Type case
+            --  Otherwise, compute or of what is left and concatenate
 
-               if Is_Type (Entity (N)) then
+            else
+               return
+                 FEnt &
+                  (Left (SLeft .. Left'Last) or Right (SRight .. Right'Last));
+            end if;
+         end;
+      end "or";
 
-                  --  If type has static predicates, process them recursively
+      -----------------
+      -- Build_Range --
+      -----------------
 
-                  if Present (Static_Predicate (Entity (N))) then
-                     P := First (Static_Predicate (Entity (N)));
-                     while Present (P) loop
-                        Process_Entry (P);
+      function Build_Range (Lo, Hi : Uint) return Node_Id is
+         Result : Node_Id;
+      begin
+         if Lo = Hi then
+            return Build_Val (Hi);
+         else
+            Result :=
+              Make_Range (Loc,
+                Low_Bound  => Build_Val (Lo),
+                High_Bound => Build_Val (Hi));
+            Set_Etype (Result, Typ);
+            Set_Analyzed (Result);
+            return Result;
+         end if;
+      end Build_Range;
+
+      ---------------
+      -- Build_Val --
+      ---------------
 
-                        if Non_Static then
-                           return;
-                        else
-                           Next (P);
-                        end if;
-                     end loop;
+      function Build_Val (V : Uint) return Node_Id is
+         Result : Node_Id;
 
-                     return;
+      begin
+         if Is_Enumeration_Type (Typ) then
+            Result := Get_Enum_Lit_From_Pos (Typ, V, Loc);
+         else
+            Result := Make_Integer_Literal (Loc, Intval => V);
+         end if;
 
-                  --  For static subtype without predicates, get range
+         Set_Etype (Result, Typ);
+         Set_Is_Static_Expression (Result);
+         Set_Analyzed (Result);
+         return Result;
+      end Build_Val;
+
+      ---------------
+      -- Get_RList --
+      ---------------
+
+      function Get_RList (Exp : Node_Id) return RList is
+         Op  : Node_Kind;
+         Val : Uint;
 
-                  elsif Is_Static_Subtype (Entity (N))
-                    and then not Has_Predicates (Entity (N))
-                  then
-                     SLo := Expr_Value (Type_Low_Bound  (Entity (N)));
-                     SHi := Expr_Value (Type_High_Bound (Entity (N)));
+      begin
+         --  Static expression can only be true or false
 
-                  --  Any other type makes us non-static
+         if Is_OK_Static_Expression (Exp) then
 
-                  else
-                     Non_Static := True;
-                     return;
-                  end if;
+            --  For False, return impossible range, which will always fail
+
+            if Expr_Value (Exp) = 0 then
+               return False_Range;
+
+            --  For True, null range
+
+            else
+               return Null_Range;
+            end if;
+         end if;
+
+         --  Otherwise test node type
 
-               --  Any other kind of identifier in predicate (e.g. a non-static
-               --  expression value) means this is not a static predicate.
+         Op := Nkind (Exp);
+
+         case Op is
+
+            --  And
+
+            when N_Op_And | N_And_Then =>
+               return Get_RList (Left_Opnd (Exp))
+                        and
+                      Get_RList (Right_Opnd (Exp));
+
+            --  Or
+
+            when N_Op_Or | N_Or_Else =>
+               return Get_RList (Left_Opnd (Exp))
+                        or
+                      Get_RList (Right_Opnd (Exp));
+
+            --  Not
+
+            when N_Op_Not =>
+               return not Get_RList (Right_Opnd (Exp));
+
+            --  Comparisons of type with static value
+
+            when N_Op_Compare =>
+               --  Type is left operand
+
+               if Is_Type_Ref (Left_Opnd (Exp))
+                 and then Is_OK_Static_Expression (Right_Opnd (Exp))
+               then
+                  Val := Expr_Value (Right_Opnd (Exp));
+
+                  --  Typ is right operand
+
+               elsif Is_Type_Ref (Right_Opnd (Exp))
+                 and then Is_OK_Static_Expression (Left_Opnd (Exp))
+               then
+                  Val := Expr_Value (Left_Opnd (Exp));
+
+                  --  Invert sense of comparison
+
+                  case Op is
+                     when N_Op_Gt => Op := N_Op_Lt;
+                     when N_Op_Lt => Op := N_Op_Gt;
+                     when N_Op_Ge => Op := N_Op_Le;
+                     when N_Op_Le => Op := N_Op_Ge;
+                     when others  => null;
+                  end case;
+
+                  --  Other cases are non-static
 
                else
-                  Non_Static := True;
-                  return;
+                  raise Non_Static;
                end if;
-            end if;
 
-            --  Here with SLo and SHi set for (possibly single element) range
-            --  of entry to insert in Plist. Non-static if out of range.
+               --  Construct range according to comparison operation
 
-            if SLo < Lo or else SHi > Hi then
-               Non_Static := True;
-               return;
-            end if;
+               case Op is
+                  when N_Op_Eq =>
+                     return RList'(1 => REnt'(Val, Val));
 
-            --  If no Plist currently, create it
+                  when N_Op_Ge =>
+                     return RList'(1 => REnt'(Val, THi));
 
-            if No (Plist) then
-               Plist := New_List (Build_Range (SLo, SHi));
-               return;
+                  when N_Op_Gt =>
+                     return RList'(1 => REnt'(Val + 1, THi));
 
-            --  Otherwise search Plist for insertion point
+                  when N_Op_Le =>
+                     return RList'(1 => REnt'(TLo, Val));
 
-            else
-               P := First (Plist);
-               loop
-                  --  Case of inserting before current entry
+                  when N_Op_Lt =>
+                     return RList'(1 => REnt'(TLo, Val - 1));
 
-                  if SHi < Lo_Val (P) - 1 then
-                     Insert_Before (P, Build_Range (SLo, SHi));
-                     exit;
+                  when N_Op_Ne =>
+                     return RList'(REnt'(TLo, Val - 1),
+                                   REnt'(Val + 1, THi));
+
+                  when others  =>
+                     raise Program_Error;
+               end case;
 
-                  --  Case of belongs past current entry
+            --  Membership (IN)
 
-                  elsif SLo > Hi_Val (P) + 1 then
+            when N_In =>
+               if not Is_Type_Ref (Left_Opnd (Exp)) then
+                  raise Non_Static;
+               end if;
 
-                     --  End of list case
+               if Present (Right_Opnd (Exp)) then
+                  return Membership_Entry (Right_Opnd (Exp));
+               else
+                  return Membership_Entries (First (Alternatives (Exp)));
+               end if;
 
-                     if No (Next (P)) then
-                        Append_To (Plist, Build_Range (SLo, SHi));
-                        exit;
+            --  Negative membership (NOT IN)
 
-                     --  Else just move to next item on list
+            when N_Not_In =>
+               if not Is_Type_Ref (Left_Opnd (Exp)) then
+                  raise Non_Static;
+               end if;
 
-                     else
-                        Next (P);
+               if Present (Right_Opnd (Exp)) then
+                  return not Membership_Entry (Right_Opnd (Exp));
+               else
+                  return not Membership_Entries (First (Alternatives (Exp)));
+               end if;
+
+            --  Function call, may be call to static predicate
+
+            when N_Function_Call =>
+               if Is_Entity_Name (Name (Exp)) then
+                  declare
+                     Ent : constant Entity_Id := Entity (Name (Exp));
+                  begin
+                     if Has_Predicates (Ent) then
+                        return Stat_Pred (Etype (First_Formal (Ent)));
                      end if;
+                  end;
+               end if;
 
-                  --  Case of extending current entyr, and in overlap cases
-                  --  may also eat up entries past this one.
+               --  Other function call cases are non-static
 
-                  else
-                     declare
-                        New_Lo : constant Uint := UI_Min (Lo_Val (P), SLo);
-                        New_Hi : Uint          := UI_Max (Hi_Val (P), SHi);
+               raise Non_Static;
 
-                     begin
-                        --  See if there are entries past us that we eat up
+            --  Qualified expression, dig out the expression
 
-                        while Present (Next (P))
-                          and then Lo_Val (Next (P)) <= New_Hi + 1
-                        loop
-                           New_Hi := Hi_Val (Next (P));
-                           Remove (Next (P));
-                        end loop;
+            when N_Qualified_Expression =>
+               return Get_RList (Expression (Exp));
 
-                        --  We now need to replace the current node P with
-                        --  a new entry New_Lo .. New_Hi.
+            --  Any other node type is non-static
 
-                        Insert_After (P, Build_Range (New_Lo, New_Hi));
-                        Remove (P);
-                        exit;
-                     end;
-                  end if;
-               end loop;
-            end if;
-         end Process_Entry;
+            when others =>
+               raise Non_Static;
+         end case;
+      end Get_RList;
 
-      --  Start of processing for Build_Static_Predicate
+      ------------
+      -- Hi_Val --
+      ------------
 
+      function Hi_Val (N : Node_Id) return Uint is
       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;
+         if Is_Static_Expression (N) then
+            return Expr_Value (N);
+         else
+            pragma Assert (Nkind (N) = N_Range);
+            return Expr_Value (High_Bound (N));
          end if;
+      end Hi_Val;
 
-         Lo := Expr_Value (Type_Low_Bound  (Typ));
-         Hi := Expr_Value (Type_High_Bound (Typ));
-
-         --  Check if we have membership predicate
+      -----------------
+      -- Is_Type_Ref --
+      -----------------
 
-         if Nkind (Expr) = N_In then
-            Exp := Expr;
+      function Is_Type_Ref (N : Node_Id) return Boolean is
+      begin
+         return Nkind (N) = N_Identifier and then Chars (N) = Nam;
+      end Is_Type_Ref;
 
-         --  Allow qualified expression with membership predicate inside
+      ------------
+      -- Lo_Val --
+      ------------
 
-         elsif Nkind (Expr) = N_Qualified_Expression
-           and then Nkind (Expression (Expr)) = N_In
-         then
-            Exp := Expression (Expr);
+      function Lo_Val (N : Node_Id) return Uint is
+      begin
+         if Is_Static_Expression (N) then
+            return Expr_Value (N);
+         else
+            pragma Assert (Nkind (N) = N_Range);
+            return Expr_Value (Low_Bound (N));
+         end if;
+      end Lo_Val;
 
-         --  Anything else cannot be a static predicate
+      ------------------------
+      -- Membership_Entries --
+      ------------------------
 
+      function Membership_Entries (N : Node_Id) return RList is
+      begin
+         if No (Next (N)) then
+            return Membership_Entry (N);
          else
-            return;
+            return Membership_Entry (N) or Membership_Entries (Next (N));
          end if;
+      end Membership_Entries;
 
-         --  We have a membership operation, so we have a potentially static
-         --  predicate, collect and canonicalize the entries in the list.
+      ----------------------
+      -- Membership_Entry --
+      ----------------------
 
-         if Present (Right_Opnd (Exp)) then
-            Process_Entry (Right_Opnd (Exp));
+      function Membership_Entry (N : Node_Id) return RList is
+         Val : Uint;
+         SLo : Uint;
+         SHi : Uint;
 
-            if Non_Static then
-               return;
+      begin
+         --  Range case
+
+         if Nkind (N) = N_Range then
+            if not Is_Static_Expression (Low_Bound (N))
+                 or else
+               not Is_Static_Expression (High_Bound (N))
+            then
+               raise Non_Static;
+            else
+               SLo := Expr_Value (Low_Bound  (N));
+               SHi := Expr_Value (High_Bound (N));
+               return RList'(1 => REnt'(SLo, SHi));
             end if;
 
-         else
-            Alt := First (Alternatives (Exp));
-            while Present (Alt) loop
-               Process_Entry (Alt);
+         --  Static expression case
 
-               if Non_Static then
-                  return;
-               end if;
+         elsif Is_Static_Expression (N) then
+            Val := Expr_Value (N);
+            return RList'(1 => REnt'(Val, Val));
 
-               Next (Alt);
-            end loop;
-         end if;
+         --  Identifier (other than static expression) case
 
-         --  Processing was successful and all entries were static, so
-         --  now we can store the result as the predicate list.
+         else pragma Assert (Nkind (N) = N_Identifier);
 
-         Set_Static_Predicate (Typ, Plist);
+            --  Type case
 
-         --  The processing for static predicates coalesced ranges and also
-         --  eliminated duplicates. We might as well replace the alternatives
-         --  list of the right operand of the membership test with the static
-         --  predicate list, which will be more efficient.
+            if Is_Type (Entity (N)) then
 
-         declare
-            New_Alts : constant List_Id := New_List;
-            Old_Node : Node_Id;
-            New_Node : Node_Id;
+               --  If type has predicates, process them
 
-         begin
-            Old_Node := First (Plist);
-            while Present (Old_Node) loop
-               New_Node := New_Copy (Old_Node);
+               if Has_Predicates (Entity (N)) then
+                  return Stat_Pred (Entity (N));
 
-               if Nkind (New_Node) = N_Range then
-                  Set_Low_Bound  (New_Node, New_Copy (Low_Bound  (Old_Node)));
-                  Set_High_Bound (New_Node, New_Copy (High_Bound (Old_Node)));
-               end if;
+               --  For static subtype without predicates, get range
 
-               Append_To (New_Alts, New_Node);
-               Next (Old_Node);
-            end loop;
+               elsif Is_Static_Subtype (Entity (N)) then
+                  SLo := Expr_Value (Type_Low_Bound  (Entity (N)));
+                  SHi := Expr_Value (Type_High_Bound (Entity (N)));
+                  return RList'(1 => REnt'(SLo, SHi));
 
-            --  Now update the membership test node
+               --  Any other type makes us non-static
 
-            pragma Assert (Nkind (Expr) = N_In);
+               else
+                  raise Non_Static;
+               end if;
+
+            --  Any other kind of identifier in predicate (e.g. a non-static
+            --  expression value) means this is not a static predicate.
 
-            if List_Length (New_Alts) = 1 then
-               Set_Right_Opnd   (Expr, First (New_Alts));
-               Set_Alternatives (Expr, No_List);
             else
-               Set_Alternatives (Expr, New_Alts);
-               Set_Right_Opnd   (Expr, Empty);
+               raise Non_Static;
             end if;
-         end;
-      end Build_Static_Predicate;
+         end if;
+      end Membership_Entry;
 
-   --  Start of processing for Build_Predicate_Function
+      ---------------
+      -- Stat_Pred --
+      ---------------
 
-   begin
-      --  Initialize for construction of statement list
+      function Stat_Pred (Typ : Entity_Id) return RList is
+      begin
+         --  Not static if type does not have static predicates
 
-      Expr  := Empty;
-      FDecl := Empty;
-      FBody := Empty;
+         if not Has_Predicates (Typ)
+           or else No (Static_Predicate (Typ))
+         then
+            raise Non_Static;
+         end if;
 
-      --  Return if already built or if type does not have predicates
+         --  Otherwise we convert the predicate list to a range list
 
-      if not Has_Predicates (Typ)
-        or else Present (Predicate_Function (Typ))
+         declare
+            Result : RList (1 .. List_Length (Static_Predicate (Typ)));
+            P      : Node_Id;
+
+         begin
+            P := First (Static_Predicate (Typ));
+            for J in Result'Range loop
+               Result (J) := REnt'(Lo_Val (P), Hi_Val (P));
+               Next (P);
+            end loop;
+
+            return Result;
+         end;
+      end Stat_Pred;
+
+   --  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;
 
-      --  Add Predicates for the current type
+      --  Get bounds of the type
 
-      Add_Predicates;
+      TLo := Expr_Value (Type_Low_Bound  (Typ));
+      THi := Expr_Value (Type_High_Bound (Typ));
 
-      --  Add predicates for ancestor if present
+      --  Now analyze the expression to see if it is a static predicate
 
       declare
-         Atyp : constant Entity_Id := Nearest_Ancestor (Typ);
+         Ranges : constant RList := Get_RList (Expr);
+         --  Range list from expression if it is static
+
+         Plist : List_Id;
+
       begin
-         if Present (Atyp) then
-            Add_Call (Atyp);
-         end if;
-      end;
+         --  Convert range list into a form for the static predicate. In the
+         --  Ranges array, we just have raw ranges, these must be converted
+         --  to properly typed and analyzed static expressions or range nodes.
 
-      --  If we have predicates, build the function
+         Plist := New_List;
 
-      if Present (Expr) then
+         for J in Ranges'Range loop
+            declare
+               Lo : constant Uint := Ranges (J).Lo;
+               Hi : constant Uint := Ranges (J).Hi;
 
-         --  Deal with static predicate case
+            begin
+               if Lo = Hi then
+                  Append_To (Plist, Build_Val (Lo));
+               else
+                  Append_To (Plist, Build_Range (Lo, Hi));
+               end if;
+            end;
+         end loop;
 
-         Build_Static_Predicate;
+         --  Processing was successful and all entries were static, so now we
+         --  can store the result as the predicate list.
 
-         --  Build function declaration
+         Set_Static_Predicate (Typ, Plist);
 
-         pragma Assert (Has_Predicates (Typ));
-         SId :=
-           Make_Defining_Identifier (Loc,
-             Chars => New_External_Name (Chars (Typ), "Predicate"));
-         Set_Has_Predicates (SId);
-         Set_Predicate_Function (Typ, SId);
+         --  The processing for static predicates put the expression into
+         --  canonical form as a series of ranges. It also eliminated
+         --  duplicates and collapsed and combined ranges. We might as well
+         --  replace the alternatives list of the right operand of the
+         --  membership test with the static predicate list, which will
+         --  usually be more efficient.
 
-         Spec :=
-           Make_Function_Specification (Loc,
-             Defining_Unit_Name       => SId,
-             Parameter_Specifications => New_List (
-               Make_Parameter_Specification (Loc,
-                 Defining_Identifier =>
-                   Make_Defining_Identifier (Loc, Chars => Object_Name),
-                 Parameter_Type      => New_Occurrence_Of (Typ, Loc))),
-             Result_Definition        =>
-               New_Occurrence_Of (Standard_Boolean, Loc));
+         declare
+            New_Alts : constant List_Id := New_List;
+            Old_Node : Node_Id;
+            New_Node : Node_Id;
 
-         FDecl :=
-           Make_Subprogram_Declaration (Loc,
-             Specification => Spec);
+         begin
+            Old_Node := First (Plist);
+            while Present (Old_Node) loop
+               New_Node := New_Copy (Old_Node);
 
-         --  Build function body
+               if Nkind (New_Node) = N_Range then
+                  Set_Low_Bound  (New_Node, New_Copy (Low_Bound  (Old_Node)));
+                  Set_High_Bound (New_Node, New_Copy (High_Bound (Old_Node)));
+               end if;
 
-         SId :=
-           Make_Defining_Identifier (Loc,
-             Chars => New_External_Name (Chars (Typ), "Predicate"));
+               Append_To (New_Alts, New_Node);
+               Next (Old_Node);
+            end loop;
 
-         Spec :=
-           Make_Function_Specification (Loc,
-             Defining_Unit_Name       => SId,
-             Parameter_Specifications => New_List (
-               Make_Parameter_Specification (Loc,
-                 Defining_Identifier =>
-                   Make_Defining_Identifier (Loc, Chars => Object_Name),
-                 Parameter_Type =>
-                   New_Occurrence_Of (Typ, Loc))),
-             Result_Definition        =>
-               New_Occurrence_Of (Standard_Boolean, Loc));
+            --  If empty list, replace by True
 
-         FBody :=
-           Make_Subprogram_Body (Loc,
-             Specification              => Spec,
-             Declarations               => Empty_List,
-             Handled_Statement_Sequence =>
-               Make_Handled_Sequence_Of_Statements (Loc,
-                 Statements => New_List (
-                   Make_Simple_Return_Statement (Loc,
-                     Expression => Expr))));
-      end if;
-   end Build_Predicate_Function;
+            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));
+
+            --  If more than one range, replace by set membership test
+
+            else
+               Rewrite (Expr,
+                 Make_In (Loc,
+                   Left_Opnd    => Make_Identifier (Loc, Nam),
+                   Right_Opnd   => Empty,
+                   Alternatives => New_Alts));
+            end if;
+         end;
+      end;
+
+   --  If non-static, return doing nothing
+
+   exception
+      when Non_Static =>
+         return;
+   end Build_Static_Predicate;
 
    -----------------------------------
    -- Check_Constant_Address_Clause --