------------------------------------------------------------------------------
--                                                                          --
--                            GNAT2WHY COMPONENTS                           --
--                                                                          --
--                        G N A T 2 W H Y - E X P R                         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2010-2025, AdaCore                     --
--                                                                          --
-- gnat2why is  free  software;  you can redistribute  it and/or  modify it --
-- under terms of the  GNU General Public License as published  by the Free --
-- Software  Foundation;  either version 3,  or (at your option)  any later --
-- version.  gnat2why is distributed  in the hope that  it will be  useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of  MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
-- License for  more details.  You should have  received  a copy of the GNU --
-- General  Public License  distributed with  gnat2why;  see file COPYING3. --
-- If not,  go to  http://www.gnu.org/licenses  for a complete  copy of the --
-- license.                                                                 --
--                                                                          --
-- gnat2why is maintained by AdaCore (http://www.adacore.com)               --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Containers.Vectors;
with Ada.Characters.Handling;        use Ada.Characters.Handling;
with Ada.Containers;                 use Ada.Containers;
with Ada.Containers.Hashed_Maps;
with Ada.Strings;
with Ada.Strings.Unbounded;          use Ada.Strings.Unbounded;
with Ada.Text_IO;  --  For debugging, to print info before raising an exception
with Checks;                         use Checks;
with Elists;                         use Elists;
with Errout_Wrapper;                 use Errout_Wrapper;
with Exp_Util;
with Flow.Analysis.Antialiasing;     use Flow.Analysis.Antialiasing;
with Flow.Analysis.Assumptions;      use Flow.Analysis.Assumptions;
with Flow_Dependency_Maps;           use Flow_Dependency_Maps;
with Flow_Generated_Globals.Phase_2; use Flow_Generated_Globals.Phase_2;
with Flow_Refinement;                use Flow_Refinement;
with Flow_Utility;                   use Flow_Utility;
with Flow_Utility.Initialization;    use Flow_Utility.Initialization;
with GNAT.Source_Info;
with GNATCOLL.Symbols;               use GNATCOLL.Symbols;
with Gnat2Why_Args;
with Gnat2Why.Data_Decomposition;    use Gnat2Why.Data_Decomposition;
with Gnat2Why.Error_Messages;        use Gnat2Why.Error_Messages;
with Gnat2Why.Expr.Aggregates;       use Gnat2Why.Expr.Aggregates;
with Gnat2Why.Expr.Loops;            use Gnat2Why.Expr.Loops;
with Gnat2Why.Subprograms;           use Gnat2Why.Subprograms;
with Gnat2Why.Subprograms.Pointers;  use Gnat2Why.Subprograms.Pointers;
with Gnat2Why.Tables;                use Gnat2Why.Tables;
with Gnat2Why.Unchecked_Conversion;  use Gnat2Why.Unchecked_Conversion;
with Namet;                          use Namet;
with Opt;
use type Opt.Warning_Mode_Type;
with Rtsfind;                        use Rtsfind;
with Sem;
with Sinput;                         use Sinput;
with Snames;                         use Snames;
with SPARK_Definition;               use SPARK_Definition;
with SPARK_Definition.Annotate;      use SPARK_Definition.Annotate;
with SPARK_Util.Hardcoded;           use SPARK_Util.Hardcoded;
with SPARK_Util.Subprograms;         use SPARK_Util.Subprograms;
with Stand;                          use Stand;
with Stringt;                        use Stringt;
with String_Utils;                   use String_Utils;
with Uintp;                          use Uintp;
with Urealp;                         use Urealp;
with VC_Kinds;                       use VC_Kinds;
with Why;                            use Why;
with Why.Atree;                      use Why.Atree;
with Why.Atree.Builders;             use Why.Atree.Builders;
with Why.Atree.Accessors;            use Why.Atree.Accessors;
with Why.Atree.Mutators;             use Why.Atree.Mutators;
with Why.Atree.Modules;              use Why.Atree.Modules;
with Why.Gen.Arrays;                 use Why.Gen.Arrays;
with Why.Gen.Decl;                   use Why.Gen.Decl;
with Why.Gen.Hardcoded;              use Why.Gen.Hardcoded;
with Why.Gen.Init;                   use Why.Gen.Init;
with Why.Gen.Names;                  use Why.Gen.Names;
with Why.Gen.Progs;                  use Why.Gen.Progs;
with Why.Gen.Pointers;               use Why.Gen.Pointers;
with Why.Gen.Records;                use Why.Gen.Records;
with Why.Gen.Scalars;                use Why.Gen.Scalars;
with Why.Images;                     use Why.Images;

package body Gnat2Why.Expr is

   --  This package handles the translation of expressions and statements to
   --  Why.

   --  -----------------------------
   --  Handling of 'Image and 'Value
   --  -----------------------------
   --
   --  For each scalar type, we introduce functions corresponding to 'Image and
   --  'Value. Logically, the return type of 'Image and the argument type of
   --  'Value should be Standard__String, but this would be circular, as String
   --  depends on a scalar type itself. Therefore, we introduce an abstract
   --  type __image, which is used as return type/argument type of the Why3
   --  functions for 'Image and 'Value. In addition, in the Why3 module for
   --  Standard__String, we generate two conversion functions between __image
   --  and String. The actual translation of the attributes now needs to use
   --  these conversion functions to get an actual String from a scalar, or
   --  to be able to convert a string to a scalar. So X'Image gets converted to
   --
   --  Standard__String.to_string (attr__ATTRIBUTE_IMAGE (to_int (x)))
   --
   --  Finally, to express that 'Value may fail, there is also a program
   --  function that corresponds to 'Value, that has an unprovable
   --  precondition, and "true" as postcondition.

   --  Code pointers:
   --    * Why3 declarations for type __image and the attributes Image
   --      and Value: see file ada__model.mlw.
   --    * Special case for the Standard__String module: see
   --      why-gen-arrays.adb:Declare_Unconstrained_Array
   --    * handling of the attributes: Transform_Attr in this file.

   -----------------------
   -- Local Subprograms --
   -----------------------

   function All_DICs_But_Last
     (E : Type_Kind_Id; W_Expr : W_Term_Id; Params : Transformation_Params)
      return W_Pred_Id;
   --  Compute all default initial conditions applicable to E on W_Expr except
   --  for E's own DIC if it should be checked at declaration.

   function Assignment_Of_Obj_Decl
     (N : N_Object_Declaration_Id) return W_Prog_Id;
   --  @param N the object declaration
   --  @return an assignment of the declared variable to its initial value

   procedure Assume_For_Nested_Package
     (E        : Entity_Id;
      Params   : Transformation_Params;
      Assumes  : in out W_Prog_Id;
      For_Decl : Boolean;
      For_Body : Boolean)
   with Pre => For_Decl or else For_Body;
   --  Recursively traverse the declaration of a package and its nested
   --  packages to assume the declaration of objects and potential initial
   --  conditions.
   --  If For_Decl is true, include the assumptions that should be made
   --  when encountering the package declaration (initial values of constants).
   --  If For_Body is true, include the assumptions that should be made
   --  when encountering the package body (initialization of variables and
   --  initial conditions).
   --  Both can be True at once for packages with no bodies or generic
   --  instances.

   function Can_Be_Moved (Expr : Node_Or_Entity_Id) return Boolean;
   --  Return whether an expression can be moved. In proof, moving is only
   --  considered for types with allocated parts, so this function will return
   --  false on other types even if they are subject to ownership (like
   --  general access types).

   function Call_Never_Terminates
     (Call : Node_Id; Scope : Entity_Id) return Boolean;
   --  Return True if Call should be considered to potentially not terminate
   --  indendently of the termination annotations on the callee. Scope should
   --  be the entity in which Call occurs.
   --  This might happen for several reasons:
   --    * the callee is recursive with its enclosing subprogram Scope and has
   --      no variants,
   --    * Call is dispatching, or
   --    * the callee is a subprogram type.

   function Check_No_Memory_Leaks
     (Ada_Node           : Node_Id;
      N                  : Node_Or_Entity_Id;
      Is_Uncheck_Dealloc : Boolean := False;
      At_End_Of_Scope    : Boolean := False) return W_Prog_Id
   with Pre => (if Nkind (N) = N_Defining_Identifier then Is_Object (N));
   --  @param Ada_Node location for the generated check
   --  @param N either entity for a local object on which to check absence of
   --    resource leak at the end of scope, or lvalue of an assignment (which
   --    includes OUT parameters and actuals of calls to instances of
   --    Ada.Unchecked_Deallocation)
   --  @param Is_Uncheck_Dealloc whether this is a call to an instance of
   --    Ada.Unchecked_Deallocation
   --  @return program checking the absence of resource leak

   function Check_No_Memory_Leaks_At_End_Of_Scope
     (Decls : List_Id) return W_Prog_Id;
   --  Go through the list of declarations Decls and generate checks that no
   --  variable leads to a resource leak at the end of its scope. This function
   --  follows the same traversal structure as Check_No_Owning_Decl in
   --  SPARK_Definition.

   procedure Check_Or_Assume_All_DICs_At_Use
     (Ada_Node : Node_Id;
      E        : Type_Kind_Id;
      W_Expr   : W_Term_Id;
      Params   : Transformation_Params;
      Prog     : in out W_Prog_Id;
      Check    : Boolean);
   --  Go over all the default initial conditions applicable to E an either
   --  check (if Check is True) or assume those that should be checked at
   --  use. Default initial conditions that are checked at declaration are
   --  ignored. Generated checks and assumptions are prepended to Prog.

   function Check_Subprogram_Variants
     (Call                  : Node_Id;
      Args                  : W_Expr_Array;
      Params                : Transformation_Params;
      Specialization_Module : Symbol := No_Symbol) return W_Prog_Id
   with
     Pre =>
       Nkind (Call) in N_Subprogram_Call | N_Entry_Call_Statement | N_Op
       and then Call_Needs_Variant_Check (Call, Current_Subp);
   --  Introduce a check to make sure that the variants progress on a recursive
   --  call Call. This check might be statically False if we do not support
   --  precise variant checks on Call (see Is_Valid_Recursive_Call). Args
   --  is the Why3 translation of the actual parameters of Call.
   --  Specialization_Module is the name of the specialization module if Call
   --  is a specialized call. It is used to get the specialized variant
   --  check procedure.

   function Check_Type_Invariants_For_Call
     (Call : Node_Id; Params : Transformation_Params) return W_Prog_Id;
   --  Perform all necessary invariant checks for Call

   function Check_Type_With_Invariants
     (Params : Transformation_Params; N : Type_Kind_Id) return W_Prog_Id;
   --  Generate checks for absence of runtime errors in the type invariant
   --  expression. It also checks that the invariant holds for default values
   --  of the type.
   --  @param Params transformation parameters
   --  @param N a type with a type invariant visible in SPARK
   --  @return a program that checks that no error can appear in N's type
   --          invariant and that the invariant holds for default values
   --          of type N.

   procedure Check_UU_Restrictions (Expr : Node_Id)
   with
     Pre =>
       Nkind (Expr) in N_Op_Eq | N_Op_Ne | N_Function_Call | N_Membership_Test
       and then
         (if Nkind (Expr) = N_Function_Call
          then Is_Tagged_Predefined_Eq (Get_Called_Entity_For_Proof (Expr)));
   --  Check special restrictions for unchecked union types on membership tests
   --  and builtin equality. Emit statically failed proof results for these
   --  checks.

   procedure Collect_Index_Expressions
     (Expr      : Node_Id;
      Domain    : EW_Domain;
      Params    : Transformation_Params;
      Context   : in out Ref_Context;
      Index_Map : in out Ada_Node_To_Why_Id.Map);
   --  Populate the Index_Map with a mapping per index in Expr.
   --  Add the bindings to Context.

   function Compute_Call_Args
     (Call      : Node_Id;
      Domain    : EW_Domain;
      Context   : in out Ref_Context;
      Store     : in out W_Statement_Sequence_Id;
      Exc_Exit  : Boolean := False;
      Exc_Store : in out W_Statement_Sequence_Id;
      Params    : Transformation_Params;
      Use_Tmps  : Boolean := False) return W_Expr_Array;
   --  Compute arguments for a function call or procedure call. The node in
   --  argument must have a "Name" field and a "Parameter_Associations" field.
   --  Sometimes, because of type mismatch, or because the actual is a
   --  subcomponent of an object, (mutable) actual parameters of the
   --  call cannot be used directly as parameters of the Why call. In this
   --  case, Compute_Call_Args will also compute mappings for new parameters
   --  as well as some post processing to store them back into the actual
   --  parameters. The mappings are then stored in Context, and the post
   --  processing is stored in Store. If Call requires an exception handler for
   --  Ada exceptions, then Exc_Exit shall be set to True. Store for the
   --  handler is stored in Exc_Store in this case. If Use_Tmps is True, then
   --  temporaries are introduced in Context for parameters so that checks are
   --  not duplicated if the returned array is used several times.

   function Compute_Default_Value
     (Ada_Node     : Node_Id;
      E            : Type_Kind_Id;
      Relaxed_Init : Boolean;
      Domain       : EW_Domain;
      Params       : Transformation_Params := Body_Params) return W_Expr_Id
   with
     Pre =>
       Can_Be_Default_Initialized (Retysp (E))
       and then not Is_Inherently_Limited_Type (Retysp (E))
       and then Ekind (Retysp (E)) /= E_String_Literal_Subtype;
   --  Expression for the default value of an object of type E. In the term
   --  domain, the values of uninitialized components are set arbitrarily,
   --  potential default initial conditions are ignored.
   --  Ada_Node is used to issue info messages on ignored DICs if any when
   --  --info is set.

   procedure Compute_Store
     (Pattern        : Item_Type;
      Actual         : Opt_N_Subexpr_Id;
      Need_Store     : Boolean;
      No_Pred_Checks : Boolean;
      Pre_Expr       : W_Expr_Id;
      Store          : in out W_Statement_Sequence_Id;
      Params         : Transformation_Params;
      Index_Map      : Ada_Node_To_Why_Id.Map;
      Ext_Visible    : Boolean;
      Exceptional    : Boolean := False);
   --  Compute in Store the sequence of statements necessary to store back
   --  local identifiers of Pattern inside Actual, which is Empty in the case
   --  of the special "self" parameter of protected subprograms.
   --  If Need_Store is True, at least one new identifier was used for the
   --  call. Note that postprocessing may be needed even if Need_Store is
   --  False, to set the init wrapper flag if any, or to perform predicate
   --  checks.
   --  If No_Pred_Checks is True, do not check the predicate of the actual
   --  after the call.
   --  Index_Map is a mapping from index nodes in Actual to identifiers that
   --  should be used to refer to these indices.
   --  For tagged records, Ext_Visible shall be True iff the tagged extension
   --  of Actual is visible by the callee.
   --  Exceptional should be True when Compute_Store is called for exceptional
   --  cases.

   procedure Compute_Exceptional_Store
     (Formal         : Formal_Kind_Id;
      Pattern        : Item_Type;
      Actual         : N_Subexpr_Id;
      Need_Store     : Boolean;
      No_Pred_Checks : Boolean;
      Pre_Expr       : W_Expr_Id;
      Store          : in out W_Statement_Sequence_Id;
      Params         : Transformation_Params;
      Index_Map      : Ada_Node_To_Why_Id.Map;
      Ext_Visible    : Boolean);
   --  Same as above but for parameters whose type is neither "by copy" nor
   --  "by reference", the actual is simply havoc'ed.

   procedure Compute_Size_Of_Object
     (Expr         : Node_Or_Entity_Id;
      Domain       : EW_Domain;
      Params       : Transformation_Params;
      Dynamic_Size : out W_Expr_Id;
      Precise      : out Boolean;
      Explanation  : out Unbounded_String)
   with
     Pre =>
       Nkind (Expr) in N_Subexpr | N_Defining_Identifier
       and then not Is_Class_Wide_Type (Retysp (Etype (Expr)))
       and then
         (if Has_Mutable_Discriminants (Retysp (Etype (Expr)))
          then Nkind (Expr) in N_Subexpr);
   --  Compute the size of an object Expr. Set Precise to False if the
   --  translation uses an abstract object.
   --  Size dispatches on tagged types, do not support it.
   --  If Expr has mutable discriminants, the computation of Size uses the
   --  constrained attribute. Do not support entities in that case as the
   --  frontend routines used to compute the value of static attributes expects
   --  an expression.

   procedure Compute_Array_Component_Size
     (Typ          : Type_Kind_Id;
      Domain       : EW_Domain;
      Dynamic_Size : out W_Expr_Id;
      Precise      : out Boolean;
      Explanation  : out Unbounded_String)
   with Pre => Is_Array_Type (Typ);
   --  Compute the Component_Size of Typ. It is either the Component_Size
   --  aspect if supplied, or the Component_Type's Size (if the array is
   --  packed) or Object_Size (if it is not packed).

   procedure Compute_Record_Component_Size
     (Comp         : Entity_Id;
      Typ          : Type_Kind_Id;
      Domain       : EW_Domain;
      Dynamic_Size : out W_Expr_Id;
      Precise      : out Boolean;
      Explanation  : out Unbounded_String)
   with Pre => Is_Record_Type_In_Why (Typ);
   --  Same as above but with a record component Comp

   procedure Compute_Size_Of_Type
     (Typ          : Type_Kind_Id;
      Object_Size  : Boolean;
      Domain       : EW_Domain;
      Dynamic_Size : out W_Expr_Id;
      Precise      : out Boolean;
      Explanation  : out Unbounded_String);
   --  Compute the Size or Object_Size (if Object_Size is set) or a type

   function Compute_Tag_Check
     (Call : Node_Id; Params : Transformation_Params) return W_Prog_Id
   with Pre => Nkind (Call) in N_Subprogram_Call;
   --  Generate a check to make sure that all dispatching parameters of a
   --  dispatching call have the same tag.

   function New_Validity_Tree_Assignment
     (LHS       : N_Subexpr_Id;
      New_Tree  : W_Prog_Id;
      Params    : Transformation_Params;
      Index_Map : Ada_Node_To_Why_Id.Map := Ada_Node_To_Why_Id.Empty_Map)
      return W_Prog_Id
   with Pre => Is_Potentially_Invalid_Expr (LHS);
   --  Compute a program updating the validity tree of the root of LHS for a
   --  write of New_Tree in LHS.

   function DIC_Expression
     (Expr               : W_Expr_Id;
      Default_Init_Param : Formal_Kind_Id;
      Default_Init_Expr  : Node_Id;
      Params             : Transformation_Params;
      Domain             : EW_Domain) return W_Expr_Id;
   --  Transform the expression of a default initial condition
   --  @param Expr expression on which the DIC is called
   --  @param Default_Init_Expr expression of the DIC
   --  @param Default_Init_Param formal for the type instance
   --  @param Params transformation parameters
   --  @return the translation of the expression contained in the DIC
   --  applied on Expr.

   function Dynamic_Predicate_Expression
     (Expr       : W_Term_Id;
      Pred_Param : Formal_Kind_Id;
      Pred_Expr  : Node_Id;
      Params     : Transformation_Params) return W_Pred_Id;
   --  Transform the expression of a dynamic_predicate
   --  @param Expr term on which the predicate is called
   --  @param Pred_Expr expression of the predicate
   --  @param Pred_Param formal for the type instance
   --  @param Params transformation parameters
   --  @return the translation of the expression contained in the predicate
   --  applied on Expr.

   function Discrete_Choice_Is_Range (Choice : Node_Id) return Boolean;
   --  Return whether Choice is a range ("others" counts as a range)

   procedure Emit_Dynamic_Accessibility_Check
     (Returned_Expr : N_Subexpr_Id; Subp : E_Function_Id);
   --  Emit static proof results for dynamic accessibility checks on return of
   --  traversal functions.

   function Expected_Type_Of_Prefix
     (N : N_Subexpr_Id; Skip_Slice : Boolean := False) return Type_Kind_Id;
   --  The node in argument is the target of an assignment. This function
   --  computes the type of the entity that corresponds to the access.
   --  This may be different from the Etype of the node in case of
   --  unconstrained array types, or discriminant records. If Skip_Slice is
   --  True, ignore slices to get the type of the prefix.

   function Expected_Type_Of_Prefix (N : N_Subexpr_Id) return W_Type_Id;
   --  Same as above but returns a Why type Id. Note that this may not be
   --  the same as EW_Abstract (Expected_Type_Of_Prefix (N)) on identifiers
   --  which are not in abstract form.

   generic
      with
        function Generate_Branch_Expr
          (N : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
           return W_Expr_Id;
   function Generate_Case_Expression
     (N : N_Case_Kind_Id; Domain : EW_Domain; Params : Transformation_Params)
      return W_Expr_Id;
   --  Build Case expression. The branches are computed by calling
   --  Generate_Branch_Expr on each branch.

   generic
      with
        function Generate_Expr
          (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
           return W_Expr_Id;
   function Generate_Expr_With_Actions
     (Expr    : Node_Id;
      Actions : List_Id;
      Domain  : EW_Domain;
      Params  : Transformation_Params) return W_Expr_Id;
   --  Handles an expression with actions. Its expression is computed by
   --  calling Generate_Expr on Expr.

   generic
      with
        function Generate_Condition
          (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
           return W_Expr_Id;
   function Generate_Quantified_Expression
     (Expr   : N_Quantified_Expression_Id;
      Domain : EW_Domain;
      Params : Transformation_Params) return W_Expr_Id;
   --  Generate a quantified expression. Its expression is computed by calling
   --  Generate_Condition of Condition (Expr). It generates:
   --  In the program domain:
   --
   --    let i = any in
   --      if guard i then cond i
   --
   --  In the term or predicate domains:
   --
   --    forall/exists i. guard i -> cond i

   procedure Get_Item_From_Var
     (Pattern    : in out Item_Type;
      Var        : Item_Type;
      Expr       : W_Expr_Id;
      Context    : in out Ref_Context;
      Args       : out W_Expr_Array;
      Need_Store : out Boolean)
   with
     Pre  =>
       Item_Is_Mutable (Pattern)
       and
         Args'Length
         >= Item_Array_Length ((1 => Pattern), Ignore_Init_And_Valid => True),
     Post => Need_Store or Context.Length = Context.Length'Old;

   --  Try to reuse parts of the references of the actual Var for the
   --  formal. If the types do not match, fall back to Get_Item_From_Expr. If
   --  Need_Store is True, the Pattern is updated to reference the parts reused
   --  from Var if any.

   procedure Insert_Check_For_Size_Of_Overlays
     (Ada_Node        : Node_Id;
      Obj             : Entity_Id;
      Overlaid_Object : Node_Id;
      P               : in out W_Prog_Id;
      Params          : Transformation_Params);
   --  Insert a check in P to ensure that an object Obj and the path it
   --  overlays Overlaid_Object have the same size. Emit the check statically
   --  if possible.

   function Insert_Invariant_Check_For_Eq
     (Ada_Node         : Node_Id;
      Typ              : Type_Kind_Id;
      W_Expr           : W_Expr_Id;
      Domain           : EW_Domain;
      Force_Predefined : Boolean := True) return W_Expr_Id;
   --  Insert to W_Expr the necessary invariant checks for a comparison using
   --  the equality of Typ.
   --  If Force_Predefined is True, consider the predefined equality.
   --  Otherwise, consider the primitive equality or the predefined equality
   --  as per Ada rules for membership tests and components.
   --  For now, we handle operands independently, so we might perform invariant
   --  checks that are not necessary. Indeed component comparison might not
   --  occur, for example on arrays with different lenghs or records whose
   --  discriminants do not match.

   procedure Insert_Move_Of_Deep_Parts
     (Rhs     : N_Subexpr_Id;
      Lhs_Typ : Entity_Id;
      Expr    : in out W_Prog_Id;
      Do_Move : out Boolean);
   --  @param Rhs the expression of an assignment or object declaration or
   --         return statement
   --  @param Lhs_Typ expected type for the lhs of the assignment
   --  @param Expr program that contains the translation of the rhs on input,
   --         and inserts moves on output and checks for moves to types without
   --         reclamation.
   --  @param Do_Move True if moves have effectively been inserted.

   function Insert_Overflow_Check
     (Ada_Node : Node_Id;
      T        : W_Expr_Id;
      In_Type  : Type_Kind_Id;
      Is_Float : Boolean) return W_Prog_Id
   with Pre => Is_Scalar_Type (In_Type);
   --  Inserts an overflow check on top of the Why expression T, using the
   --  bounds of the base type of In_Type. Use Ada_Node for the VC location.

   function Insert_Ref_Context
     (Ada_Call : Node_Id;
      Why_Call : W_Prog_Id;
      Context  : Ref_Context;
      Store    : in out W_Statement_Sequence_Id) return W_Prog_Id;
   --  Reconstruct the complete sequence needed to model the Ada call Ada_Call.
   --  Why_Call is the actual call in Why3, Context holds the mappings for
   --  the new identifiers used in the call (when actual parameters are
   --  complex), and Store contains the postprocessing steps necessary to store
   --  back the actuals after the call.

   function Is_Simple_Actual (Actual : N_Subexpr_Id) return Boolean;
   --  Return True if N is a simple enough object so that its binder can
   --  be reused for parameter passing. Basically this is true for simple
   --  identifiers that are not too complex (e.g. not Part_Of or other
   --  complications).

   function Is_Terminal_Node (N : Node_Id) return Boolean;
   --  Decide whether this is a node where we should put a pretty printing
   --  label, or if we should descend further. Basically, everything that's
   --  not a quantifier or conjunction is a terminal node.

   function Move_Expression
     (Expr : N_Subexpr_Id; Tmp : W_Identifier_Id) return W_Prog_Id;
   --  @param Expr expression with pointers that is moved
   --  @param Tmp identifier storing the value of the expression to move
   --  @return program performing the move, moving all pointers in Expr and
   --          preserving the value of other components

   type Do_Check_Kind is (All_Checks, Only_Vars, No_Checks);

   function New_Assignment
     (Ada_Node    : Node_Id := Empty;
      Lvalue      : N_Subexpr_Id;
      Expr        : W_Prog_Id;
      Do_Check    : Do_Check_Kind := All_Checks;
      Preserv_Tag : Boolean := True;
      Index_Map   : Ada_Node_To_Why_Id.Map := Ada_Node_To_Why_Id.Empty_Map)
      return W_Prog_Id
   with

     --  Expr might be converted without checks to Type_Of_Node (Lvalue), so we
     --  should ensure that we are never missing checks by doing so.

     Pre =>
       Eq_Base (Type_Of_Node (Lvalue), Get_Type (+Expr))
       and then (Do_Check /= All_Checks or else Index_Map.Is_Empty);

   --  Translate an assignment of the form "Lvalue := Expr" (using Ada_Node
   --  for its source location).
   --  If Do_Check is set to No_Checks, then no check should be introduced.
   --  This is used for generating code havocking an object, that does not
   --  correspond to a source code assignment, and as such should not lead to
   --  the generation of checks. If Do_Checks is set to Only_Vars, it is not
   --  necessary to check the well-formedness of the prefix (discriminant,
   --  bounds...). This occurs when the new value already contains an
   --  evaluation of the prefix.
   --  If Preserv_Tag is set to False, the tag and extension of Lvalue are not
   --  preserved. This is used for actual parameters of mode OUT and IN OUT on
   --  calls. The preservation of the tag is ensured by splitting the record
   --  and the extension might be updated.
   --  Index_Map is a mapping from index nodes in Lvalue to identifiers that
   --  should be used to refer to these indices. It is supplied when the
   --  indices should be evaluated in a different context (typically before a
   --  call).

   function New_Constrained_Attribute_Expr
     (Prefix : N_Subexpr_Id; Domain : EW_Domain) return W_Expr_Id;
   --  @param Prefix prefix of the 'constrained attribute
   --  @param Domain domain of the expression
   --  @return a Why3 expression Prefix'Constrained

   function New_Type_Invariant_Call
     (Ty : Type_Kind_Id; W_Expr : W_Term_Id; Params : Transformation_Params)
      return W_Pred_Id;
   --  @param Ty type whose type invariant needs to be checked
   --  @param W_Expr Why3 expression on which to check the invariant
   --  @param Params transformation parameters
   --  @return Why3 predicate that expresses the check

   function New_Invariant_Check
     (Ada_Node         : Node_Id;
      Ty               : Type_Kind_Id;
      W_Expr           : W_Term_Id;
      On_Default_Value : Boolean := False;
      Check_Info       : Check_Info_Type := New_Check_Info) return W_Prog_Id;
   --  @param Ada_Node node to which the check is attached
   --  @param Ty type whose invariant needs to be checked
   --  @param W_Expr Why3 expression on which to check the invariant
   --  @param On_Default_Value True iff this invariant check applies to the
   --    default value for a type
   --  @param Check_Info check information
   --  @return Why3 program that performs the check

   function New_Move_Tree_Access
     (Expr      : N_Subexpr_Id;
      Domain    : EW_Terms;
      Params    : Transformation_Params;
      Index_Map : Ada_Node_To_Why_Id.Map := Ada_Node_To_Why_Id.Empty_Map)
      return W_Expr_Id;
   --  Create an access to the move tree for Expr

   function New_Move_Tree_Assignment
     (Lvalue    : N_Subexpr_Id;
      Expr      : W_Prog_Id;
      Index_Map : Ada_Node_To_Why_Id.Map := Ada_Node_To_Why_Id.Empty_Map)
      return W_Prog_Id;
   --  Create an update to store Expr in the move tree for Lvalue

   function New_Raise_Or_Absurd
     (Ada_Node    : Node_Id;
      Ex_Name     : W_Identifier_Id;
      Handled_Exc : Exception_Sets.Set;
      Params      : Transformation_Params) return W_Prog_Id;
   --  Generate conditional raising an exception if Ex_Name is in Handled_Exc
   --  and absurd statement otherwise. This also generates the relevant
   --  sequence of finalization actions for the raise.

   function One_Level_Access
     (N             : Node_Id;
      Expr          : W_Expr_Id;
      Domain        : EW_Domain;
      Params        : Transformation_Params;
      No_Init_Check : Boolean) return W_Expr_Id;
   --  Compute an access expression for record and array accesses without
   --  considering subexpressions. [N] represents the Ada node of the access,
   --  and [Expr] the Why expression of the prefix. If No_Init_Check is True,
   --  the expression does not need to be initialized and predicate checks and
   --  initialization checks for discriminants will not be emitted on
   --  expressions annotated with Relaxed_Initialization.

   function One_Level_Update
     (N            : Node_Id;
      Pref         : W_Term_Id;
      Value        : W_Expr_Id;
      Domain       : EW_Domain;
      Params       : Transformation_Params;
      Check_Prefix : Boolean := True;
      Index_Map    : Ada_Node_To_Why_Id.Map := Ada_Node_To_Why_Id.Empty_Map)
      return W_Expr_Id
   with
     --  Handling of slices is only valid in programs, as it introduces an
     --  "any" Why3 node. This is ensured by not allowing slices in borrowed
     --  expressions.
     Pre =>
       (if Nkind (N) = N_Slice then Domain in EW_Pterm | EW_Prog)
       and then (not Check_Prefix or else Index_Map.Is_Empty);
   --  @param N            the Ada node which defines the component to be
   --                      updated (e.g. a record access)
   --  @param Pref         the currently computed prefix, (e.g. the record
   --                      value before the update)
   --  @param Value        the new value of the updated component
   --  @param Domain       the domain
   --  @param Params       the translation params
   --  @param Check_Prefix False if it is not necessary to check the
   --      well-formedness of the prefix (discriminant, bounds...). This occurs
   --      when the new value already contains an evaluation of the prefix.
   --  @param Index_Map    a mapping from index nodes in N to identifiers that
   --      should be used to refer to these indices. It is supplied when the
   --      indices should be evaluated in a different context (typically before
   --      a call).
   --  @return the Why expression which corresponds to the Pref object, but
   --            updated at the point specified by N, with value Value;

   function Reconstruct_Actual_From_Item
     (Pattern   : Item_Type;
      Actual    : N_Subexpr_Id;
      No_Checks : Boolean;
      Pre_Expr  : W_Expr_Id) return W_Prog_Id;
   --  Same as Reconstruct_Formal_From_Item but introduce (possibly checked)
   --  conversion to compute a new version of the actual, suitable for being
   --  used in New_Assignment.

   procedure Shift_Rvalue
     (N            : in out N_Subexpr_Id;
      Expr         : in out W_Expr_Id;
      Last_Access  : in out Opt_N_Subexpr_Id;
      Domain       : EW_Domain := EW_Prog;
      Check_Prefix : Boolean := True;
      Index_Map    : Ada_Node_To_Why_Id.Map := Ada_Node_To_Why_Id.Empty_Map)
   with Pre => not Check_Prefix or else Index_Map.Is_Empty;
   --  the input pair (N, Expr) describes an assignment
   --      N := Expr
   --  where N is the Ada node for some Lvalue of the form
   --    Prefix.Acc1.(...).Acc[n-1].Accn := Expr;
   --  The *output* pair (N, Expr) corresponds to the same
   --  assignment, but shifting the Accn to the right side and transforming
   --  it into an update. We obtain
   --    Prefix.Acc1.(...).Acc[n-1] :=
   --         Upd (Prefix.Acc1.(...).Acc[n-1], Accn, Expr)
   --  Last_Access is used as an accumulator to store the last subexpression
   --  which is not a conversion in the parents of N.
   --  If Check_Prefix is False then it is not necessary to check the
   --  well-formedness of the prefix (discriminant, bounds...). This occurs
   --  when the new value already contains an evaluation of the prefix.
   --  Index_Map is a mapping from index nodes in N to identifiers that should
   --  be used to refer to these indices. It is supplied when the indices
   --  should be evaluated in a different context (typically before a call).

   function Transform_Array_Aggregate
     (Params        : Transformation_Params;
      Domain        : EW_Domain;
      Expr          : N_Aggregate_Kind_Id;
      Update_Prefix : Opt_N_Subexpr_Id := Empty;
      Relaxed_Init  : Boolean) return W_Expr_Id;
   --  Transform an aggregate Expr of array type. The aggregate may be a plain
   --  array aggregate (Ada RM 4.3.3), an array delta aggregate (Ada RM 4.3.4),
   --  or a multi-dimensional delta array aggregate defined by a 'Update
   --  attribute (GNAT extension). The aggregate is delta iff there is a
   --  non-empty update prefix supplied, in which case only the updates are
   --  looked up in Expr. Relaxed_Init identify whether the resulting array
   --  should have relaxed initialization.
   --
   --  The core translation is to produce a Why3 proposition P that defines the
   --  aggregate value by stating what its components and bounds are. The
   --  subexpressions of the aggregate, its 'elements', are separated out of
   --  the aggregate through the use of intermediate Why3 variables. This is
   --  done whenever such separation is possible (for components under iterated
   --  component association, elements depends on index, so they cannot be
   --  defined once and for all ahead of time). For example, for aggregate:
   --
   --  A : array (B .. B + 3) of Integer :=
   --    (1 => V + 3, 2 => V + 4, others => K - 1)
   --
   --  the defining proposition is generated along the lines of:
   --
   --  def_prop a f l x y z :=
   --      a.__first = f /\ a.__last = l /\ get a 1 = x /\ get a 2 = y
   --         /\ (forall i. i <> 1 /\ i <> 2 -> get a i = z)
   --
   --  With a being a variable standing for the defined value, and x,y,z,f,l
   --  being free variables standing for the translation of components (x,y,z
   --  for subexpressions V + 3, V + 4, K-1 respectively) and bounds (f,l for
   --  lower and upper bounds B, B+3 respectively). In general, the proposition
   --  will contain additional guards for bounds/indexes to ensures it has a
   --  witness (a) for every instance of the elements (x,y,z,f,l). That is,
   --  (forall x y z f l. exists a. def_prop a f l x y z) should be justified
   --  at the meta level for the translation to be sound.
   --
   --  As an alternative to the conjunctive structure above, the components of
   --  the aggregate can be described for an arbitrary index by a succession of
   --  ifs (a mix of conjunctive structure and successive if may occur for
   --  multidimensional arrays). This is necessary for delta aggregates, due to
   --  updated choices being allowed to overlap (possibly dynamically). For
   --  example, the following delta aggregate is allowed:
   --
   --  (U with delta I .. J => X, K => Y)
   --
   --  And the defining proposition (about result array a) is:
   --
   --  def_prop a u i j k x y :=
   --    a.__first = u.__first /\ a.__last = u.__last /\
   --    (forall index. if index = k then get a index = y else
   --                   if i <= index <= j then get a index = x else
   --                   get a index = get u index)
   --
   --  The translation may be called multiple times on the same Ada node,
   --  corresponding to different phases. If all elements of Expr can be
   --  properly separated away (that is, there is no iterated component
   --  association), a logic function aggr_func is generated and stored in the
   --  E_Module for Expr. That function is axiomatized (in the corresponding
   --  axiom module) as returning a witness for the defining proposition for
   --  every instance of the elements, taken as parameters.
   --
   --  function aggr_func <element-types> : <type of aggregate>
   --
   --  axiom aggr_func_def : forall <element-vars>:<element-types>.
   --    let a = aggr_func <element-vars> in def_prop a <element-vars>
   --    (* def_prop inline, we do not make a predicate symbol *)
   --
   --  The aggregate is then translated by a call to aggr_func, preceded in the
   --  program domain by the various checks expected for the aggregate.
   --
   --  If there are iterated component associations, instead, the expression is
   --  completely processed every time to translate components under iterated
   --  association properly. The components cannot be replaced by variables as
   --  they depend on the iteration index.
   --  The translation in the program domain replace the function call by an
   --  any statement:
   --
   --  let <element-vars> = <element-values> in
   --  ... (* Checks *) ...;
   --  any { def_prop result <element-vars> } (* In place of call *)
   --
   --  The translation in the term domain produces a Why3 epsilon:
   --
   --  let <element-vars> = <element-values> in
   --  (epsilon A. def_prop result <element-vars>) (* In place of call *)
   --
   --  A function call could be used if we processed components under iterated
   --  component associations to find the actual variable content and replaced
   --  it by additional elements. For example, for aggregate:
   --
   --  (for I in 1 .. 42 => H (I, G(X,X)))
   --
   --  We produce defining proposition:
   --
   --  def_prop a :=
   --    a.__first = 1 /\ a.__last = 42
   --    /\ (forall i. get A i = 'H' i ('G' 'X' 'X'))
   --
   --  Which is only meaningful in a context where reference to variable 'X'
   --  make sense (so not in axioms). This could be turned into a format
   --  suitable for the function-based translation if we took X through an
   --  additional parameter. This is effectively what Why3 does when
   --  eliminating epsilon on its end, but it would be more error-prone to do
   --  so ahead of time due to the variety of contextual elements (variables,
   --  but also reference to 'Old, 'Loop_Entry, @, etc.), and the need to
   --  correctly replace them by element variables during translation. In
   --  contrast, Why3's epsilon elimination is a standalone pass which only
   --  have to deal with substitution of free variables in logic terms. We
   --  still make the effort of generating the function ourselves when it is
   --  reasonably easy to do so, because relying on Why3's epsilon elimination
   --  result in one function symbol per epsilon instead of a single global
   --  one, resulting in possibly lost sharing.

   function Transform_Assignment_Statement
     (Stmt : N_Assignment_Statement_Id; Params : Transformation_Params)
      return W_Prog_Id;
   --  Translate a single Ada statement into a Why expression

   function Transform_Block_Statement
     (N : N_Block_Statement_Id; Params : Transformation_Params)
      return W_Prog_Id;
   --  ???

   function Transform_Call_With_Side_Effects
     (Params : Transformation_Params; Call : Node_Id) return W_Prog_Id
   with
     Pre =>
       Nkind (Call)
       in N_Entry_Call_Statement | N_Function_Call | N_Procedure_Call_Statement
       and then
         (if Nkind (Call) = N_Function_Call
          then Is_Function_With_Side_Effects (Get_Called_Entity (Call)));
   --  Transform a call to a subprogram with side effects

   function Transform_Comparison
     (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
      return W_Expr_Id;
   --  Transform comparison operations

   function Transform_Concatenation
     (Left               : W_Expr_Id;
      Right              : W_Expr_Id;
      Left_Type          : Type_Kind_Id;
      Right_Type         : Type_Kind_Id;
      Return_Type        : Type_Kind_Id;
      Is_Component_Left  : Boolean;
      Is_Component_Right : Boolean;
      Domain             : EW_Domain;
      Ada_Node           : Node_Id) return W_Expr_Id;
   --  Handle concatenation nodes

   function Transform_Discrete_Choice
     (Choice      : Node_Id;
      Choice_Type : Opt_Type_Kind_Id;
      Expr        : W_Expr_Id;
      Domain      : EW_Domain;
      Params      : Transformation_Params) return W_Expr_Id
   with Pre => Get_Type (Expr) = Base_Why_Type (Get_Type (Expr));
   --  For an expression Expr of a discrete type and a discrete Choice, build
   --  the expression that Expr belongs to the range expressed by Choice. In
   --  programs, also generate a check that dynamic choices are in the subtype
   --  Choice_Type.

   function Transform_Delta_Aggregate
     (Ada_Node : Node_Id;
      Pref     : N_Subexpr_Id;
      Aggr     : N_Aggregate_Kind_Id;
      Domain   : EW_Domain;
      Params   : Transformation_Params) return W_Expr_Id;
   --  Transform either a delta aggregate or an Update attribute

   function Transform_Declaration
     (Decl : Node_Id; Params : Transformation_Params) return W_Prog_Id;
   --  Transform a declaration. Return a program that takes into account the
   --  dynamic semantics of the declaration (checks and assumptions).

   function Transform_Expr_Or_Identifier
     (N      : Node_Or_Entity_Id;
      Domain : EW_Domain;
      Params : Transformation_Params) return W_Expr_Id
   is (if Nkind (N) = N_Defining_Identifier
       then Transform_Identifier (Params, N, N, Domain)
       else Transform_Expr (N, Domain, Params));
   --  N may be an expression or an identifier. Call the appropriate
   --  translation function.

   function Transform_Quantified_Expression
     (Expr   : N_Quantified_Expression_Id;
      Domain : EW_Domain;
      Params : Transformation_Params) return W_Expr_Id;
   --  @return the Why3 expression for SPARK quantified expression [Expr]

   function Transform_Priority_Pragmas
     (Prag : N_Pragma_Id; Params : Transformation_Params) return W_Prog_Id
   with
     Pre =>
       Get_Pragma_Id (Prag) in Pragma_Interrupt_Priority | Pragma_Priority;
   --  @param Prag either a pragma Priority or a pragma Interrupt_priority
   --  @param Params transformation parameters
   --  @return an expression that checks that the argument of the pragma is in
   --          the required range for this object type and pragma type

   function Transform_Slice
     (N      : Node_Id;
      Expr   : W_Expr_Id;
      Params : Transformation_Params;
      Domain : EW_Domain) return W_Expr_Id;
   --  Transform a slice Expr

   function Transform_Statement_Or_Declaration
     (Stmt_Or_Decl        : Node_Id;
      Params              : Transformation_Params;
      Assert_And_Cut_Prag : out Opt_N_Pragma_Id;
      Assert_And_Cut_Expr : out Opt_N_Subexpr_Id;
      Assert_And_Cut      : out W_Pred_Id) return W_Prog_Id;
   --  Transform the Ada statement into a Why program expression.
   --  @param Params transformation parameters
   --  @param Assert_And_Cut_Prag pragma Assert_And_Cut, if Stmt_Or_Decl was
   --     such a pragma, Empty otherwise.
   --  @param Assert_And_Cut_Expr Expression in the pragma Assert_And_Cut, if
   --     Stmt_Or_Decl was such a pragma, Empty otherwise.
   --  @param Assert_And_Cut Why3 predicate equivalent of the assertion
   --     expression, if Stmt_Or_Decl was such a pragma, Why_Empty otherwise.
   --  @return the check program expression that corresponds to the assertion
   --     expression.

   function Transform_Statements_And_Declarations
     (Stmts_And_Decls : List_Id; Params : Transformation_Params)
      return W_Prog_Id;
   --  Transforms a list of statements and declarations into a Why expression.
   --  An empty list is transformed into the void expression.

   function Type_Invariant_Expression
     (Expr     : W_Term_Id;
      Inv_Subp : E_Procedure_Id;
      Params   : Transformation_Params) return W_Pred_Id;
   --  Transform the expression of a type_invariant
   --  @param Expr term on which the invariant is called
   --  @param Inv_Subp entity of the invariant procedure
   --  @param Params transformation parameters
   --  @return the translation of the expression contained in the invariant
   --          applied on Expr.

   function Warn_On_Dead_Branch_Or_Code
     (N       : Node_Id;
      W       : W_Prog_Id;
      Branch  : Boolean;
      Phase   : Transformation_Phase;
      Do_Warn : Boolean) return W_Prog_Id;
   --  Shared functionality for warning on dead branch or dead code.

   ------------------------------------------
   -- Handling of Expressions with Actions --
   ------------------------------------------

   --  The detection phase currently allows 3 kinds of nodes in actions:
   --    N_Object_Declaration for constants
   --    N_Subtype_Declaration
   --    N_Full_Type_Declaration

   --  Declarations of constant objects are transformed into let-binding in
   --  Why, which is possible in any context (program, term, proposition).

   --  Declarations of types are simply ignored. Indeed, we don't know how to
   --  translate the assignment to type bounds like done in
   --  Transform_Declaration in a proposition context. Note that this choice
   --  can possibly lead to dynamic bounds not known at VC level, if such types
   --  are introduced in actions.

   function Transform_Actions
     (Actions : List_Id;
      Expr    : W_Expr_Id;
      Domain  : EW_Domain;
      Params  : Transformation_Params) return W_Expr_Id;
   --  Translate a list of Actions, that should consist only in declarations of
   --  constants used in Expr.

   procedure Transform_Actions_Preparation (Actions : List_Id);
   --  Update the symbol table for taking into account the names for
   --  declarations of constants in Actions.

   function Transform_Attr
     (Expr              : N_Attribute_Reference_Id;
      Domain            : EW_Domain;
      Params            : Transformation_Params;
      Expected_Typ      : W_Type_Id;
      No_Validity_Check : Boolean := False) return W_Expr_Id;
   --  Range_Check_Needed is set to True for some attributes (like 'Pos,
   --  'Length, 'Modulus) which return a universal integer, so that we check
   --  the result fits in the actual type used for the node.
   --  @param Expr attribute reference
   --  @param Domain domain where we want to do the transformation
   --  @param Params transformation parameters
   --  @param Expected_Typ expected why3 type of the expression. It only
   --         matters when computing the length attribute of an array type
   --         which has a modular index.
   --  @param No_Validity_Check if True, do not emit validity check if expr is
   --         potentially invalid.
   --  @return the translation of the expression contained in the invariant
   --          applied on Expr.

   procedure Transform_Expr_With_Cutpoints
     (Assertion : N_Subexpr_Id;
      Params    : Transformation_Params;
      Runtime   : out W_Prog_Id;
      Premise   : out W_Pred_Id;
      Result    : out W_Pred_Id)
   with
     Pre =>
       Contains_Cut_Operations (Assertion)
       and then Params.Phase = Generate_VCs_For_Assert;
   --  Expressions containing occurrences of the cut operations By and So are
   --  translated differently depending on whether they occur as an assumption
   --  or a goal. The fact that the two translations are compatible is checked
   --  by generating side-conditions.
   --
   --  For each such expression Assertion, we generate:
   --   * A program expression Runtime which performs checks for the absence of
   --     RTE in Assertion and the side-conditions of the cut operations;
   --   * A predicate Premise which is the translation of Assertion when we
   --     want to prove it;
   --   * A predicate Result which is the translation of Assertion when we
   --     want to assume it.

   function Transform_String_Literal
     (N : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
      return W_Expr_Id
   with
     Pre =>
       Nkind (N) = N_String_Literal
       or else
         (Nkind (N) = N_Unchecked_Type_Conversion
          and then Nkind (Expression (N)) = N_String_Literal);
   --  Transform a string literal. It uses an uninterpreted logic function with
   --  no parameters that returns a string value corresponding to the string
   --  literal.
   --  N here can be either a string literal if the literal has a static lower
   --  bound or an unchecked conversion introduced by the frontend to
   --  mimic the dynamic low bound. In the first case, the low bound can be
   --  taken from the string literal. In the second, it should be taken from
   --  the target of the conversion as the  string literal subtype might have
   --  bounds which are outside of the index type's base type.

   function Transform_Record_Component_Associations
     (Domain             : EW_Domain;
      Typ                : Type_Kind_Id;
      Assocs             : List_Id;
      Params             : Transformation_Params;
      In_Delta_Aggregate : Boolean := False;
      In_Extension       : Boolean := False;
      Relaxed_Init       : Boolean;
      Discr_Ids          : out W_Identifier_Array;
      Discr_Vals         : out W_Expr_Array;
      Missing_Fields     : out Component_Sets.Set)
      return W_Field_Association_Array
   with
     Pre =>
       (if In_Delta_Aggregate or In_Extension
        then Discr_Ids'Length = 0 and Discr_Vals'Length = 0
        else
          Discr_Ids'Length = Count_Discriminants (Typ)
          and Discr_Vals'Length = Count_Discriminants (Typ));
   --  Returns a list of updates to be applied to a record value, to
   --  translate either an aggregate or a delta aggregate.
   --  In_Delta_Aggregate is True when translating a delta aggregate.
   --  Associations for discriminants are stored before associations for
   --  normal fields.
   --  On regular record aggregates (not delta aggregates,
   --  nor extension aggregates) default values of component associations might
   --  depend on the discriminants. In this case, Discr_Ids contains an
   --  identifier per discriminant in Typ and Discr_Vals contains their
   --  expected values.
   --  After the call, Missing_Fields contains components from Typ's component
   --  set which do not have an association.

   type Validity_Check_Kind is (Do_Check, No_Check, Keep_Wrapper);

   function Transform_Function_Call
     (Expr           : Node_Id;
      Domain         : EW_Domain;
      Params         : Transformation_Params;
      Validity_Check : Validity_Check_Kind := Do_Check) return W_Expr_Id
   with Pre => Nkind (Expr) in N_Function_Call | N_Op;
   --  Transform a function call.
   --  Validity_Check encodes how the validity flag of the result should be
   --  handled. If it is Do_Check, check the flag and return the value. If it
   --  is No_Check, ignore the flag. If it is Keep_Wrapper, return the
   --  validity wrapper.

   function Transform_Membership_Expression
     (Params : Transformation_Params;
      Domain : EW_Domain;
      Expr   : N_Membership_Test_Id) return W_Expr_Id;
   --  Convert a membership expression (N_In or N_Not_In) into a boolean Why
   --  expression.

   function Transform_Array_Equality
     (Op        : N_Op_Compare;
      Left      : W_Expr_Id;
      Right     : W_Expr_Id;
      Left_Type : Type_Kind_Id;
      Domain    : EW_Domain;
      Ada_Node  : Node_Id) return W_Expr_Id;
   --  Translate an equality on arrays into a Why expression, take care of the
   --  different cases (constrained / unconstrained) for each argument.

   function Transform_Array_Comparison
     (Op       : N_Op_Compare;
      Left     : W_Expr_Id;
      Right    : W_Expr_Id;
      Domain   : EW_Domain;
      Ada_Node : Node_Id) return W_Expr_Id;
   --  Translate a comparison on arrays into a Why expression

   function Transform_Array_Logical_Op
     (Op        : N_Binary_Op;
      Left      : W_Expr_Id;
      Right     : W_Expr_Id;
      Left_Type : Type_Kind_Id;
      Domain    : EW_Domain;
      Ada_Node  : Node_Id;
      Do_Check  : Boolean) return W_Expr_Id;
   --  Translate a binary operation on boolean arrays into a Why expression

   function Transform_Array_Negation
     (Right      : W_Expr_Id;
      Right_Type : Type_Kind_Id;
      Domain     : EW_Domain;
      Ada_Node   : Node_Id;
      Do_Check   : Boolean) return W_Expr_Id;
   --  Translate negation on boolean arrays into a Why expression

   function Transform_Record_Equality
     (Expr   : Node_Id;
      Left   : Node_Id;
      Right  : Node_Id;
      Domain : EW_Domain;
      Params : Transformation_Params) return W_Expr_Id
   with
     Pre =>
       Nkind (Expr) in N_Op_Eq | N_Op_Ne | N_Function_Call
       and then
         (if Nkind (Expr) = N_Function_Call
          then Is_Tagged_Predefined_Eq (Get_Called_Entity_For_Proof (Expr)));

   function Transform_Shift_Or_Rotate_Call
     (Expr   : N_Function_Call_Id;
      Oper   : N_Op_Shift;
      Domain : EW_Domain;
      Params : Transformation_Params) return W_Expr_Id;
   --  @param Expr a call where the callee is a shift or rotate subprogram
   --  @param Oper the shift or rotate operation kind
   --  @param Domain the domain in which the translation happens
   --  @param Params the translation parameters
   --  @return the Why expression corresponding to the shift or rotate

   function Transform_Unhandled_Raise (Stat : N_Raise_Kind_Id) return W_Prog_Id
   is (Sequence
         (Left  =>
            (if Nkind (Stat) in N_Raise_xxx_Error
               or else No (Expression (Stat))
             then +Void
             else
               New_Ignore
                 (Stat, Transform_Prog (Expression (Stat), Body_Params))),
          Right =>
            New_Absurd_Statement (Ada_Node => Stat, Reason => VC_Raise)));
   --  Returns the Why program for raise statement Stat if the exception is not
   --  handled.

   ---------------------------------
   -- Handling of Local Borrowers --
   ---------------------------------

   function New_Update_For_Borrow_At_End
     (Brower : Entity_Id; Path : Node_Id) return W_Prog_Id;
   --  Create an assignment updating the value of at end of Brower from an
   --  update Path. Brower is either the local borrower in the case of a borrow
   --  or a reborrow, or the subprogram entity when returning from a traversal
   --  function. Also assume the value at end of the root of Path.

   function Transform_At_End_Borrow_Call
     (Call   : N_Function_Call_Id;
      Domain : EW_Domain;
      Params : Transformation_Params) return W_Expr_Id;
   --  Transform a call to a function annotated with a pragma Annotate
   --  (GNATprove, At_End_Borrow, ...).
   --  ??? The translation is stronger than the actual function body, as at
   --  in the proof, we know nothing about the value at the end of the borrow
   --  of the borrower, whereas for execution, the value taken for the borrower
   --  at the end of the borrow is the current value. Thus, it is possible that
   --  a contract/an assertion fails to prove whereas it actually holds at
   --  runtime, but not the other way around.

   function Finalization_Actions
     (Scopes  : Node_Lists.List;
      Exiting : Local_CFG.Vertex_Sets.Set;
      Params  : Transformation_Params) return W_Statement_Sequence_Id;
   --  For Scopes a list of <<scopes>> with attached finalization actions,
   --  translate the individual finalization actions to perform at exit. That
   --  is,
   --  * For Handled sequence of statements with a finally section, the
   --    translation of the code within the section.
   --  * For block statements or entity with bodies, havocs all borrowed
   --    expressions. After each individual havoc, we get information about
   --    potential updates from the borrower by assuming that its pledge
   --    (relation between the borrower and the borrowed expression) holds. We
   --    also check here that we have not broken any constraints on the
   --    borrowed object during the borrow.
   --  * For block statements or entities with bodies, checks that no variable
   --    leads to a resource leak.
   --
   --  Scopes must be listed in order of exit (innermost scopes first),
   --  without skipping any intermediate scope. They are considered to
   --  be exited from one of vertices in Exiting, in order to filter out
   --  borrowers not updated on any local control path to Exiting from the
   --  havoced borrows.
   --
   --  If Exiting is empty, then analysis of updated borrowers is performed
   --  from all potential sources instead.

   function Finalization_Actions
     (Scopes  : Node_Lists.List;
      Exiting : Local_CFG.Vertex;
      Params  : Transformation_Params) return W_Statement_Sequence_Id;
   --  Specialization of Finalization_Actions when the Exiting set is a
   --  singleton.

   function Finalization_Actions_On_Raise
     (Stmt_Or_Decl : Node_Id; Params : Transformation_Params) return W_Prog_Id;
   --  Perform finalization actions for scopes exited by a raise statement,
   --  or by implicit re-raise for an handled sequence of statement. Stops at
   --  the first exception handler or entity body. Exceptions which might not
   --  be handled at this point are propagated using an implicit reraise.

   function Havoc_Borrowed_Expression
     (Brower : Constant_Or_Variable_Kind_Id; Already_Equal : Boolean := False)
      return W_Prog_Id;
   --  Construct a program which havocs a borrowed expression. After the havoc,
   --  we get information about potential updates from the borrower by
   --  assuming that its pledge (relation between the borrower and the borrowed
   --  expression) holds. We also check here that we have not broken any
   --  constraints on the borrowed object during the borrow.
   --
   --  If Already_Equal is set to true, only assumes the pledge without
   --  havocking.

   --------------------------
   -- Handling of overlays --
   --------------------------

   function New_Overlay_Assignment
     (Lvalue : Object_Kind_Id; Right : W_Prog_Id := Why_Empty)
      return W_Prog_Id;
   --  Havoc the ultimate alias of Lvalue and assume that Lvalue is now equal
   --  to Right if it is supplied.

   procedure Assume_Dynamic_Invariant_For_Overlay
     (Obj     : Object_Kind_Id;
      Params  : Transformation_Params;
      Context : in out W_Prog_Id);
   --  For mutable overlays, assume the dynamic invariant
   --  of the overlay for all values of the root object.

   -----------------------
   -- All_DICs_But_Last --
   -----------------------

   function All_DICs_But_Last
     (E : Type_Kind_Id; W_Expr : W_Term_Id; Params : Transformation_Params)
      return W_Pred_Id
   is
      Pred : W_Pred_Id := True_Pred;

      procedure Add_DIC_Except_Last
        (Default_Init_Param : Formal_Kind_Id; Default_Init_Expr : Node_Id);
      --  Add the DIC to Pred if it does not apply to E itself

      -------------------------
      -- Add_DIC_Except_Last --
      -------------------------

      procedure Add_DIC_Except_Last
        (Default_Init_Param : Formal_Kind_Id; Default_Init_Expr : Node_Id)
      is
         Ty      : constant Entity_Id := Etype (Default_Init_Param);
         Use_DIC : constant Boolean :=
           Needs_DIC_Check_At_Use (Ty) or else Retysp (Ty) /= Retysp (E);
      begin
         if Use_DIC then
            Pred :=
              New_And_Pred
                (Left  =>
                   +DIC_Expression
                      (+W_Expr,
                       Default_Init_Param,
                       Default_Init_Expr,
                       Params,
                       EW_Pred),
                 Right => Pred);
         end if;
      end Add_DIC_Except_Last;

      procedure Add_All_DICs_But_Last is new
        Iterate_Applicable_DIC (Add_DIC_Except_Last);
   begin
      Add_All_DICs_But_Last (E);
      return Pred;
   end All_DICs_But_Last;

   ----------------------------
   -- Assignment_Of_Obj_Decl --
   ----------------------------

   function Assignment_Of_Obj_Decl
     (N : N_Object_Declaration_Id) return W_Prog_Id
   is
      Lvalue   : Entity_Id := Defining_Identifier (N);
      Do_Valid : constant Boolean := Object_Has_Valid_Id (Lvalue);
      Rexpr    : constant Node_Id := Expression (N);
   begin
      --  We ignore part_of objects as a first approximation

      if Is_Part_Of_Protected_Object (Lvalue) then
         return +Void;
      end if;

      --  In our Why translation, all objects are declared at top-level.
      --  Object declarations in Ada inside Subprograms are therefore
      --  translated to assignments to initialize these objects.
      --  We can only generate an assignment when the Lvalue is mutable; if it
      --  is not, there are two cases. If the expression is static, we already
      --  have generated an axiom upon declaration of the object, and we are
      --  done. If it is not, we replace the assignment by an assumption of
      --  the following form:

      --  let var_name__assume = <rexpr> in
      --    assume (var_name = var_name_assume);

      --  Some objects have two declarations, i.e. the partial and full view of
      --  a package level object. In this case, we always use the type of the
      --  partial view.

      if Is_Full_View (Lvalue) then
         Lvalue := Partial_View (Lvalue);
      end if;

      if Present (Rexpr) then
         declare
            Binder   : constant Item_Type :=
              Ada_Ent_To_Why.Element (Symbol_Table, Lvalue);
            Why_Ty   : constant W_Type_Id := Why_Type_Of_Entity (Lvalue);
            Why_Expr : W_Prog_Id;
            L_Name   : constant String := Full_Name (Lvalue);

            --  Context and validity flag to handle potentially invalid values

            Valid_Flag : W_Expr_Id :=
              (if Do_Valid
               then +New_Valid_Value_For_Type (Etype (Lvalue))
               else Why_Empty);
            Context    : Ref_Context;

            Res   : W_Prog_Id := +Void;
            Dummy : Boolean;

         begin
            --  Handle the potential propagation of invalid values

            if Propagates_Validity_Flag (N) then
               pragma Assert (Do_Valid);
               Why_Expr :=
                 +Transform_Potentially_Invalid_Expr
                    (Expr          => Rexpr,
                     Expected_Type => Why_Ty,
                     Domain        => EW_Prog,
                     Params        => Body_Params,
                     Context       => Context,
                     Valid_Flag    => Valid_Flag);
            else
               Why_Expr := Transform_Prog (Rexpr, Why_Ty, Body_Params);
            end if;

            Insert_Move_Of_Deep_Parts
              (Rhs     => Rexpr,
               Lhs_Typ => Etype (Lvalue),
               Expr    => Why_Expr,
               Do_Move => Dummy);

            --  Initializing an overlay havocs the overlaid object

            if Present (Ultimate_Overlaid_Entity (Lvalue)) then
               Res := New_Overlay_Assignment (Lvalue, Why_Expr);

            else
               if Binder.Init.Present then
                  Append
                    (Res,
                     New_Assignment
                       (Ada_Node => N,
                        Name     => Binder.Init.Id,
                        Labels   => Symbol_Sets.Empty_Set,
                        Value    => True_Prog,
                        Typ      => EW_Bool_Type));
               end if;

               --  Handle the validity field if any

               if Do_Valid then
                  if Is_Mutable_In_Why (Lvalue) then
                     Append
                       (Res,
                        New_Assignment
                          (Ada_Node => N,
                           Name     =>
                             +Get_Valid_Id_From_Object
                                (Lvalue, Ref_Allowed => False),
                           Labels   => Symbol_Sets.Empty_Set,
                           Value    => +Valid_Flag,
                           Typ      =>
                             Get_Validity_Tree_Type (Etype (Lvalue))));
                  else
                     Append
                       (Res,
                        New_Assume_Statement
                          (Ada_Node => N,
                           Pred     =>
                             New_Comparison
                               (Symbol => Why_Eq,
                                Left   =>
                                  +Get_Valid_Id_From_Object
                                     (Lvalue, Body_Params.Ref_Allowed),
                                Right  => +Valid_Flag)));
                  end if;
               end if;

               case Binder.Kind is
                  when DRecord                   =>

                     --  For objects in record split form, we produce:
                     --  let <v_name>__assume = <init_value> in
                     --   <v__fields> := <v_name>__assume.fields;
                     --   <v__discrs> := <v_name>__assume.discrs; if discr is
                     --                                           mutable
                     --   assume (<v__discrs> = <v_name>__assume.discrs);
                     --     otherwise
                     --   assume (<v__constrained>=
                     --     Is_Constrained (Etype (Lvalue)));
                     --   assume (<v__tag> = <v_name>__assume.tag);
                     --                                        if classwide
                     --   assume (<v__tag> = Ty.__tag); otherwise

                     declare
                        Tmp_Var : constant W_Identifier_Id :=
                          New_Identifier
                            (Name => L_Name & "__assume", Typ => Why_Ty);
                     begin
                        if Binder.Fields.Present then
                           Append
                             (Res,
                              New_Assignment
                                (Ada_Node => N,
                                 Name     => Binder.Fields.Binder.B_Name,
                                 Labels   => Symbol_Sets.Empty_Set,
                                 Value    =>
                                   New_Fields_Access
                                     (Name => +Tmp_Var, Ty => Binder.Typ),
                                 Typ      =>
                                   Get_Typ (Binder.Fields.Binder.B_Name)));
                        end if;

                        if Binder.Discrs.Present then
                           if Binder.Discrs.Binder.Mutable then
                              Append
                                (Res,
                                 New_Assignment
                                   (Ada_Node => N,
                                    Name     => Binder.Discrs.Binder.B_Name,
                                    Labels   => Symbol_Sets.Empty_Set,
                                    Value    =>
                                      New_Discriminants_Access
                                        (Name => +Tmp_Var, Ty => Binder.Typ),
                                    Typ      =>
                                      Get_Typ (Binder.Discrs.Binder.B_Name)));

                              pragma Assert (Binder.Constr.Present);
                           else
                              Append
                                (Res,
                                 New_Assume_Statement
                                   (Ada_Node => N,
                                    Pred     =>
                                      New_Call
                                        (Name => Why_Eq,
                                         Typ  => EW_Bool_Type,
                                         Args =>
                                           (1 => +Binder.Discrs.Binder.B_Name,
                                            2 =>
                                              New_Discriminants_Access
                                                (Name => +Tmp_Var,
                                                 Ty   => Binder.Typ)))));
                           end if;

                           if Binder.Constr.Present then
                              Append
                                (Res,
                                 New_Assume_Statement
                                   (Ada_Node => N,
                                    Pred     =>
                                      New_Call
                                        (Name => Why_Eq,
                                         Typ  => EW_Bool_Type,
                                         Args =>
                                           (+Binder.Constr.Id,
                                            (if Binder.Discrs.Binder.Mutable
                                             then +False_Term
                                             else +True_Term)))));
                           end if;
                        end if;

                        if Binder.Tag.Present then
                           Append
                             (Res,
                              New_Assume_Statement
                                (Ada_Node => N,
                                 Pred     =>
                                   New_Call
                                     (Name => Why_Eq,
                                      Typ  => EW_Bool_Type,
                                      Args =>
                                        (1 => +Binder.Tag.Id,
                                         2 =>
                                           (if Is_Class_Wide_Type
                                                 (Etype (Lvalue))
                                            then
                                              New_Tag_Access
                                                (Domain => EW_Prog,
                                                 Name   => +Tmp_Var,
                                                 Ty     => Binder.Typ)
                                            else
                                              +E_Symb
                                                 (Binder.Typ, WNE_Tag))))));
                        end if;

                        Res :=
                          New_Typed_Binding
                            (Ada_Node => N,
                             Name     => Tmp_Var,
                             Def      => Why_Expr,
                             Context  => Res);
                     end;

                  when UCArray                   =>

                     --  For objects in array split form, we produce:
                     --  let <v_name>__assume = <init_value> in
                     --    <v> := of_array (<v_name>__assume);
                     --    assume (<v__first> = <v_name>__assume.first);
                     --    assume (<v__last> = <v_name>__assume.last);

                     declare
                        Tmp_Var : constant W_Identifier_Id :=
                          New_Identifier
                            (Name => L_Name & "__assume", Typ => Why_Ty);
                     begin
                        Append
                          (Res,
                           New_Assignment
                             (Ada_Node => N,
                              Name     => Binder.Content.B_Name,
                              Labels   => Symbol_Sets.Empty_Set,
                              Value    =>
                                +Array_Convert_To_Base (EW_Prog, +Tmp_Var),
                              Typ      => Get_Typ (Binder.Content.B_Name)));

                        for I in 1 .. Binder.Dim loop
                           Append
                             (Res,
                              New_Assume_Statement
                                (Ada_Node => N,
                                 Pred     =>
                                   New_Call
                                     (Name => Why_Eq,
                                      Typ  => EW_Bool_Type,
                                      Args =>
                                        (1 =>
                                           +Insert_Conversion_To_Rep_No_Bool
                                              (+Binder.Bounds (I).First),
                                         2 =>
                                           +Insert_Conversion_To_Rep_No_Bool
                                              (Get_Array_Attr
                                                 (Expr => +Tmp_Var,
                                                  Attr => Attribute_First,
                                                  Dim  => I))))),
                              New_Assume_Statement
                                (Ada_Node => N,
                                 Pred     =>
                                   New_Call
                                     (Name => Why_Eq,
                                      Typ  => EW_Bool_Type,
                                      Args =>
                                        (1 =>
                                           +Insert_Conversion_To_Rep_No_Bool
                                              (+Binder.Bounds (I).Last),
                                         2 =>
                                           +Insert_Conversion_To_Rep_No_Bool
                                              (Get_Array_Attr
                                                 (Expr => +Tmp_Var,
                                                  Attr => Attribute_Last,
                                                  Dim  => I))))));
                        end loop;

                        Res :=
                          New_Typed_Binding
                            (Ada_Node => N,
                             Name     => Tmp_Var,
                             Def      => Why_Expr,
                             Context  => Res);
                     end;

                  when Pointer                   =>

                     --  For objects in access split form, we produce:
                     --  let <v_name>__assume = <init_value> in
                     --    <v> := <v_name>__assume.value;
                     --  and either:
                     --    assume (<v__is_null> = <v_name>__assume.is_null);
                     --  if the pointer is not mutable, or:
                     --    <v__is_null> := <v_name>__assume.is_null;
                     --  otherwise.

                     declare
                        Tmp_Var : constant W_Identifier_Id :=
                          New_Identifier
                            (Name => L_Name & "__assume", Typ => Why_Ty);
                     begin
                        Append
                          (Res,
                           New_Assignment
                             (Ada_Node => N,
                              Name     => Binder.Value.B_Name,
                              Labels   => Symbol_Sets.Empty_Set,
                              Value    =>
                                +New_Pointer_Value_Access
                                   (Ada_Node => Empty,
                                    Domain   => EW_Term,
                                    Name     => +Tmp_Var,
                                    E        => Etype (Lvalue)),
                              Typ      => Get_Typ (Binder.Value.B_Name)));

                        if Binder.Mutable then
                           Append
                             (Res,
                              New_Assignment
                                (Ada_Node => N,
                                 Name     => Binder.Is_Null,
                                 Labels   => Symbol_Sets.Empty_Set,
                                 Value    =>
                                   New_Pointer_Is_Null_Access
                                     (E => Etype (Lvalue), Name => +Tmp_Var),
                                 Typ      => EW_Bool_Type));
                        else
                           Append
                             (Res,
                              New_Assume_Statement
                                (Ada_Node => N,
                                 Pred     =>
                                   New_Call
                                     (Name => Why_Eq,
                                      Typ  => EW_Bool_Type,
                                      Args =>
                                        (1 => +Binder.Is_Null,
                                         2 =>
                                           New_Pointer_Is_Null_Access
                                             (E    => Etype (Lvalue),
                                              Name => +Tmp_Var)))));
                        end if;

                        Res :=
                          New_Typed_Binding
                            (Ada_Node => N,
                             Name     => Tmp_Var,
                             Def      => Why_Expr,
                             Context  => Res);
                     end;

                  when Regular | Concurrent_Self =>
                     declare
                        L_Id : constant W_Identifier_Id := Binder.Main.B_Name;
                     begin
                        if Is_Mutable_In_Why (Lvalue) then

                           --  Attributes of record objects have the default
                           --  values of their type.

                           Append
                             (Res,
                              New_Assignment
                                (Ada_Node => N,
                                 Name     => L_Id,
                                 Labels   => Symbol_Sets.Empty_Set,
                                 Value    =>
                                   (if Has_Record_Type (Etype (Lvalue))
                                      or else
                                        Full_View_Not_In_SPARK (Etype (Lvalue))
                                    then
                                      New_Tag_And_Ext_Update
                                        (Ada_Node => N,
                                         Name     => Why_Expr,
                                         Ty       => Etype (Lvalue))
                                    else Why_Expr),
                                 Typ      => Why_Ty));

                        else
                           declare
                              Tmp_Var : constant W_Identifier_Id :=
                                New_Identifier
                                  (Name => L_Name & "__assume", Typ => Why_Ty);
                              Eq      : constant W_Pred_Id :=
                                New_Call
                                  (Name => Why_Eq,
                                   Typ  => EW_Bool_Type,
                                   Args =>
                                     (New_Tag_And_Ext_Update
                                        (Ada_Node => N,
                                         Domain   => EW_Prog,
                                         Name     => +Tmp_Var,
                                         Ty       => Etype (Lvalue)),
                                      +L_Id));
                           begin
                              Append
                                (Res,
                                 New_Typed_Binding
                                   (Ada_Node => N,
                                    Name     => Tmp_Var,
                                    Def      => Why_Expr,
                                    Context  =>
                                      New_Assume_Statement
                                        (Ada_Node => N, Pred => Eq)));
                           end;
                        end if;
                     end;

                  when Subp                      =>
                     raise Program_Error;
               end case;

               --  Add bindings for the validity wrapper if any

               Res :=
                 +Bindings_For_Ref_Context
                    (Expr => +Res, Context => Context, Domain => EW_Prog);

               --  Init value at end of local borrowers. This assumes the
               --  dynamic invariant of the value of the borrowed object at the
               --  end of the borrow, so it should be done after all checks at
               --  performed for the assignment so that we do not create an
               --  inconsistency.

               if Is_Local_Borrower (Lvalue) then
                  Append
                    (Res,
                     New_Update_For_Borrow_At_End
                       (Brower => Lvalue, Path => Rexpr));
               end if;
            end if;

            return Res;
         end;

      elsif not Is_Partial_View (Lvalue) and then not Is_Imported (Lvalue) then

         --  Only assume default initialization if we are in a fullview

         pragma Assert (Is_Mutable_In_Why (Lvalue));

         --  Constants cannot be default initialized

         declare
            Binder  : constant Item_Type :=
              Ada_Ent_To_Why.Element (Symbol_Table, Lvalue);
            L_Deref : constant W_Term_Id :=
              +Transform_Identifier
                 (Params => Body_Params,
                  Expr   => Lvalue,
                  Ent    => Lvalue,
                  Domain => EW_Term);

            Constrained_Ty : constant Entity_Id := Etype (Lvalue);
            --  Type of the fullview

            W_Ty : constant W_Type_Id := Type_Of_Node (Lvalue);

            Default_Checks : W_Prog_Id :=
              Compute_Default_Check (N, Constrained_Ty, Body_Params);
            --  Checks for runtime errors in default values

            Init_Assumption : constant W_Pred_Id :=
              Compute_Default_Init
                (Expr =>
                   Insert_Simple_Conversion
                     (Ada_Node => Lvalue, Expr => L_Deref, To => W_Ty),
                 Ty   => Constrained_Ty);
            --  Assume initial value of L

         begin
            --  Generate assumption

            if Default_Checks /= +Void then
               Default_Checks :=
                 New_Ignore (Ada_Node => Lvalue, Prog => Default_Checks);
            end if;

            --  L has its top-level constrained flag True iff its subtype is
            --  constrained.

            if Binder.Kind = DRecord and then Binder.Constr.Present then
               Append
                 (Default_Checks,
                  New_Assume_Statement
                    (Ada_Node => N,
                     Pred     =>
                       New_Comparison
                         (Symbol => Why_Eq,
                          Left   => +Binder.Constr.Id,
                          Right  =>
                            (if Is_Constrained (Constrained_Ty)
                             then True_Term
                             else False_Term))));
            end if;

            --  For entirely private types, L has its top-level initialization
            --  flag True iff its type is entirely initialized.

            if Binder.Init.Present
              and then
                (Default_Initialization (Constrained_Ty)
                 = Full_Default_Initialization
                 or else Has_Mutable_Discriminants (Constrained_Ty)
                 or else Has_Access_Type (Constrained_Ty))
            then
               Append
                 (Default_Checks,
                  New_Assignment
                    (Ada_Node => N,
                     Name     => Binder.Init.Id,
                     Labels   => Symbol_Sets.Empty_Set,
                     Value    => True_Prog,
                     Typ      => EW_Bool_Type));
            end if;

            --  Set the validity field to True, no object is invalid by default

            if Do_Valid then
               pragma Assert (Is_Mutable_In_Why (Lvalue));
               Append
                 (Default_Checks,
                  New_Assignment
                    (Ada_Node => N,
                     Name     =>
                       +Get_Valid_Id_From_Object
                          (Lvalue, Ref_Allowed => False),
                     Labels   => Symbol_Sets.Empty_Set,
                     Value    => +New_Valid_Value_For_Type (Constrained_Ty),
                     Typ      => Get_Validity_Tree_Type (Constrained_Ty)));
            end if;

            --  Initializing an overlay havocs the overlaid object

            if Present (Ultimate_Overlaid_Entity (Lvalue)) then
               Append (Default_Checks, New_Overlay_Assignment (Lvalue));
            end if;

            if Init_Assumption /= True_Pred then
               Append
                 (Default_Checks,
                  New_Assume_Statement
                    (Ada_Node => N, Pred => Init_Assumption));
            end if;

            return Default_Checks;
         end;

      --  If N is a constant overlay, use an UC to assume its value

      elsif Is_Constant_In_SPARK (Lvalue)
        and then Present (Overlaid_Entity (Lvalue))
      then
         pragma Assert (Is_Overlay_Handled_As_UC (Lvalue).Ok);

         declare
            Pref    : constant Node_Id := Prefix (Get_Address_Expr (N));
            Pref_Ty : constant Type_Kind_Id := Type_Of_Node (Pref);
            W_Ty    : constant W_Type_Id := Type_Of_Node (Pref_Ty);
            W_Pref  : constant W_Term_Id :=
              Transform_Term (Pref, W_Ty, Body_Params);
            --  Do not emit checks here, they are already emitted on the
            --  declaration.

            Binder     : constant Item_Type :=
              Ada_Ent_To_Why.Element (Symbol_Table, Lvalue);
            UC_Id      : constant W_Identifier_Id :=
              Get_UC_Function
                (Pref_Ty,
                 Type_Of_Node (Lvalue),
                 Potentially_Invalid => Binder.Valid.Present);
            UC_Call    : constant W_Term_Id :=
              +New_Temp_For_Expr
                 (New_Call
                    (Domain => EW_Term,
                     Name   => UC_Id,
                     Args   => (1 => +W_Pref),
                     Typ    => Get_Typ (UC_Id)),
                  Need_Temp => Binder.Valid.Present);
            Assumption : W_Prog_Id :=
              New_Assume_Statement
                (Ada_Node => N,
                 Pred     =>
                   New_Comparison
                     (Symbol => Why_Eq,
                      Left   => +Binder.Main.B_Name,
                      Right  =>
                        (if Binder.Valid.Present
                         then
                           +New_Function_Valid_Value_Access
                              (Empty, Type_Of_Node (Lvalue), +UC_Call)
                         else UC_Call)));

         begin
            if Binder.Valid.Present then
               Assumption :=
                 Sequence
                   (Left  =>
                      New_Assume_Statement
                        (Ada_Node => N,
                         Pred     =>
                           New_Comparison
                             (Symbol => Why_Eq,
                              Left   => +Binder.Valid.Id,
                              Right  =>
                                +New_Function_Valid_Flag_Access
                                   (Type_Of_Node (Lvalue), +UC_Call))),
                    Right => Assumption);
               Assumption :=
                 Binding_For_Temp (Tmp => UC_Call, Context => Assumption);
            end if;

            return Assumption;
         end;

      else
         return +Void;
      end if;
   end Assignment_Of_Obj_Decl;

   ----------------------------------
   -- Assume_Declaration_Of_Entity --
   ----------------------------------

   procedure Assume_Declaration_Of_Entity
     (E             : Extended_Object_Kind_Id;
      Params        : Transformation_Params;
      Initialized   : Boolean;
      Top_Predicate : Boolean;
      Context       : in out W_Prog_Id)
   is
      Max_Assocs : constant Natural := 100;
      --  If the defining expression of a constant contains more than
      --  Max_Assocs N_Component_Association nodes, its definition will not be
      --  inlined.

      L_Id       : constant W_Expr_Id :=
        (if Is_Protected_Type (E)
         then
           (if Self_Is_Mutable
            then New_Deref (Right => Self_Name, Typ => Get_Typ (Self_Name))
            else +Self_Name)
         else
           Transform_Identifier
             (Params => Params, Expr => E, Ent => E, Domain => EW_Term));
      Do_Valid   : constant Boolean := Object_Has_Valid_Id (E);
      L_Id_Valid : constant W_Term_Id :=
        Get_Valid_Id_From_Object (E, Params.Ref_Allowed);

   begin
      pragma Assert (L_Id /= Why_Empty);

      --  Assume dynamic property of E

      declare
         Init_Id : constant W_Expr_Id :=
           Get_Init_Id_From_Object (E, Params.Ref_Allowed);
         Dyn_Inv : constant W_Prog_Id :=
           New_Assume_Statement
             (Pred =>
                Compute_Dynamic_Inv_And_Initialization
                  (Expr          => +L_Id,
                   Ty            => Etype (E),
                   Valid         => L_Id_Valid,
                   Initialized   =>
                     (if Init_Id /= Why_Empty
                      then +Init_Id
                      elsif Initialized
                      then True_Term
                      else False_Term),
                   Params        => Body_Params,
                   Only_Var      => False_Term,
                   Top_Predicate => Top_Predicate));
      begin
         Append (Context, Dyn_Inv);
      end;

      --  For mutable overlays, assume the dynamic invariant of the overlay for
      --  all values of the root object.

      if Present (Ultimate_Overlaid_Entity (E)) and then Is_Mutable_In_Why (E)
      then
         Assume_Dynamic_Invariant_For_Overlay (E, Body_Params, Context);
      end if;

      --  Constants of access-to-variable types are not constant. Still assume
      --  the value of the is_null field if the declaration is null or an
      --  allocator.

      if Ekind (E) = E_Constant and then Is_Access_Variable (Etype (E)) then
         declare
            FV        : constant Entity_Id :=
              (if Is_Object (E)
                 and then Is_Partial_View (E)
                 and then Entity_In_SPARK (Full_View (E))
               then Full_View (E)
               else E);
            Decl      : constant Node_Id := Enclosing_Declaration (FV);
            Init_Expr : constant Node_Id := Expression (Decl);
         begin
            if Ekind (FV) /= E_In_Parameter and then Present (Init_Expr) then
               case Nkind (Init_Expr) is
                  when N_Null      =>
                     Append
                       (Context,
                        New_Assume_Statement
                          (Pred =>
                             Pred_Of_Boolean_Term
                               (W =>
                                  +New_Pointer_Is_Null_Access
                                     (Etype (E), L_Id))));

                  when N_Allocator =>
                     Append
                       (Context,
                        New_Assume_Statement
                          (Pred =>
                             New_Not
                               (Right =>
                                  Pred_Of_Boolean_Term
                                    (W =>
                                       +New_Pointer_Is_Null_Access
                                          (Etype (E), L_Id)))));

                  when others      =>
                     null;
               end case;
            end if;
         end;

      --  Otherwise, assume value if constant

      elsif Ekind (E) = E_Constant or else Is_Named_Number (E) then
         declare
            Typ  : constant W_Type_Id := Why_Type_Of_Entity (E);
            FV   : constant Entity_Id :=
              (if Is_Object (E)
                 and then Is_Partial_View (E)
                 and then Entity_In_SPARK (Full_View (E))
               then Full_View (E)
               else E);
            Decl : constant Node_Id := Enclosing_Declaration (FV);
         begin
            if Ekind (FV) /= E_In_Parameter
              and then Present (Expression (Decl))
              and then Entity_Comes_From_Source (Original_Node (FV))
              and then
                Number_Of_Assocs_In_Expression (Expression (Decl))
                <= Max_Assocs
              and then not Contains_Volatile_Function_Call (Expression (Decl))
              and then
                not Is_Function_Call_With_Side_Effects (Expression (Decl))
            then
               --  We do not issue checks here. Checks for this declaration
               --  will be issued when verifying its enclosing unit.

               declare
                  Tmp_Var : constant W_Identifier_Id :=
                    New_Temp_Identifier (Typ => Typ);
                  Eq      : constant W_Pred_Id :=
                    New_Call
                      (Name => Why_Eq,
                       Typ  => EW_Bool_Type,
                       Args =>
                         ((if Has_Record_Type (Etype (E))
                             or else Full_View_Not_In_SPARK (Etype (E))
                           then
                             New_Tag_And_Ext_Update
                               (Domain => EW_Prog,
                                Name   => +Tmp_Var,
                                Ty     => Etype (E))
                           else +Tmp_Var),
                          +L_Id));
                  Expr    : W_Prog_Id;

                  --  Context and validity flag to handle potentially invalid
                  --  values.

                  E_Valid_Flag : W_Expr_Id :=
                    (if Do_Valid
                     then +New_Valid_Value_For_Type (Etype (E))
                     else Why_Empty);
                  V_Context    : Ref_Context;

               begin
                  --  Handle the potential propagation of invalid values

                  if Propagates_Validity_Flag (Decl) then
                     Expr :=
                       +Transform_Potentially_Invalid_Expr
                          (Expr          => Expression (Decl),
                           Expected_Type => Typ,
                           Domain        => EW_Pterm,
                           Params        => Body_Params,
                           Context       => V_Context,
                           Valid_Flag    => E_Valid_Flag);
                  else
                     Expr :=
                       Transform_Prog
                         (Expression (Decl),
                          Typ,
                          Body_Params,
                          Checks => False);
                  end if;

                  Expr :=
                    New_Typed_Binding
                      (Name    => Tmp_Var,
                       Def     => Expr,
                       Context => New_Assume_Statement (Pred => Eq));

                  --  Also assume the value of L_Id_Valid

                  if Do_Valid then
                     Expr :=
                       Sequence
                         (Expr,
                          New_Assume_Statement
                            (Pred =>
                               New_Comparison
                                 (Symbol => Why_Eq,
                                  Left   => L_Id_Valid,
                                  Right  => +E_Valid_Flag)));

                     Expr :=
                       +Bindings_For_Ref_Context
                          (Expr    => +Expr,
                           Context => V_Context,
                           Domain  => EW_Prog);
                  end if;

                  if not Has_Dereference (+Expr) then
                     Append (Context, Expr);
                  end if;
               end;
            end if;
         end;

      --  Assume the value of 'Constrained attribute for variables with
      --  defaulted discriminants.

      elsif Ekind (E) = E_Variable then
         declare
            B  : constant Item_Type :=
              Ada_Ent_To_Why.Element (Symbol_Table, E);
            Ty : constant Entity_Id :=
              Get_Ada_Node (+Get_Why_Type_From_Item (B));

         begin
            if B.Kind = DRecord and then B.Constr.Present then
               Append
                 (Context,
                  New_Assume_Statement
                    (Pred =>
                       New_Call
                         (Name => Why_Eq,
                          Typ  => EW_Bool_Type,
                          Args =>
                            (1 => +B.Constr.Id,
                             2 =>
                               (if Is_Constrained (Ty)
                                then +True_Term
                                else +False_Term)))));
            end if;
         end;
      end if;

      --  Assume the value of the is_null field of the at_end_borrow of local
      --  borrowers.

      if Is_Local_Borrower (E) then
         pragma Assert (Initialized and Top_Predicate);

         Append
           (Context,
            New_Assume_Statement
              (Pred =>
                 New_Call
                   (Name => Why_Eq,
                    Typ  => EW_Bool_Type,
                    Args =>
                      (1 =>
                         New_Pointer_Is_Null_Access
                           (E => Retysp (Etype (E)), Name => L_Id),
                       2 =>
                         New_Pointer_Is_Null_Access
                           (E    => Retysp (Etype (E)),
                            Name =>
                              New_Deref
                                (Right => Get_Brower_At_End (E),
                                 Typ   => Get_Typ (Get_Brower_At_End (E))))))),
            Assume_Dynamic_Invariant
              (Expr          =>
                 New_Deref
                   (Right => Get_Brower_At_End (E),
                    Typ   => Get_Typ (Get_Brower_At_End (E))),
               Ty            => Etype (E),
               Initialized   => Initialized,
               Only_Var      => False,
               Top_Predicate => Top_Predicate));

         --  The address of the borrower is necessarily initialized at the end
         --  of the borrow.

         if Obj_Has_Relaxed_Init (E) then
            Append
              (Context,
               New_Assume_Statement
                 (Pred =>
                    Pred_Of_Boolean_Term
                      (New_Init_Attribute_Access
                         (Name =>
                            New_Deref
                              (Right => Get_Brower_At_End (E),
                               Typ   => Get_Typ (Get_Brower_At_End (E))),
                          E    => Retysp (Etype (E))))));
         end if;
      end if;
   end Assume_Declaration_Of_Entity;

   ------------------------------
   -- Assume_Dynamic_Invariant --
   ------------------------------

   function Assume_Dynamic_Invariant
     (Expr          : W_Term_Id;
      Ty            : Type_Kind_Id;
      Initialized   : Boolean := True;
      Valid         : W_Term_Id := Why_Empty;
      Only_Var      : Boolean := True;
      Top_Predicate : Boolean := True) return W_Prog_Id
   is
      Init  : constant W_Term_Id :=
        (if Initialized then True_Term else False_Term);
      O_Var : constant W_Term_Id :=
        (if Only_Var then True_Term else False_Term);
      T     : constant W_Pred_Id :=
        Compute_Dynamic_Inv_And_Initialization
          (Expr          => Expr,
           Ty            => Ty,
           Valid         => Valid,
           Initialized   => Init,
           Only_Var      => O_Var,
           Top_Predicate => Top_Predicate,
           Params        => Body_Params);
   begin
      if T /= True_Pred then
         return New_Assume_Statement (Ada_Node => Ty, Pred => T);
      else
         return +Void;
      end if;
   end Assume_Dynamic_Invariant;

   --------------------------------------------
   -- Assume_Dynamic_Invariant_For_Variables --
   --------------------------------------------

   function Assume_Dynamic_Invariant_For_Variables
     (Vars             : Node_Sets.Set;
      Params           : Transformation_Params;
      Scope            : Entity_Id := Empty;
      Exclude_Top_Pred : Entity_Id := Empty;
      Initialized      : Boolean := False) return W_Prog_Id
   is
      Dynamic_Prop_Inputs : W_Prog_Id := +Void;
      Includes            : Node_Sets.Set := Vars;
      Already_Included    : Node_Sets.Set := Node_Sets.Empty_Set;
      Prop_For_Include    : W_Prog_Id;
      Top_Predicate       : Boolean;
      First_Iter          : Boolean := True;
      Variables           : Flow_Id_Sets.Set;
      --  Set of variable inputs used in the assumed dynamic invariants.
      --  We will also need to assume their dynamic invariant.

   begin
      while not Node_Sets.Is_Empty (Includes) loop
         Prop_For_Include := +Void;
         Flow_Id_Sets.Clear (Variables);
         for Obj of Includes loop

            --  The self reference of a protected subprogram is always
            --  initialized. We only consider protected types in first
            --  iteration. Indeed, later, they will have been added by
            --  Compute_Ada_Node_Set and won't be relevant.

            if First_Iter and then Is_Protected_Type (Obj) then

               Assume_Declaration_Of_Entity
                 (E             => Obj,
                  Params        => Params,
                  Initialized   => True,
                  Top_Predicate => True,
                  Context       => Prop_For_Include);

            --  No need to assume anything if Obj is not an object, if it is
            --  not in SPARK or if it is a local object of the unit.

            elsif not (Nkind (Obj) in N_Entity
                       and then
                         (Is_Object (Obj) or else Is_Named_Number (Obj)))
              or else not Ada_Ent_To_Why.Has_Element (Symbol_Table, Obj)
              or else
                (Present (Scope) and then Is_Declared_In_Unit (Obj, Scope))
            then
               null;
            else
               --  If Obj is the parameter of a predicate function, do not
               --  assume the toplevel predicate for checking absence of RTE
               --  in the predicate function itself.

               Top_Predicate := Exclude_Top_Pred /= Obj;

               Assume_Declaration_Of_Entity
                 (E             => Obj,
                  Params        => Params,
                  Initialized   =>
                    (if Is_Object (Obj)
                       and then Is_Mutable_In_Why (Obj)
                       and then not Initialized
                     then Is_Initialized_In_Scope (Obj, Scope)
                     else True),
                  Top_Predicate => Top_Predicate,
                  Context       => Prop_For_Include);

               --  Add all the variable inputs of the dynamic invariant
               --  to the set of variables to consider.

               Variables_In_Dynamic_Invariant
                 (Etype (Obj), Variables, Current_Subp);
            end if;
         end loop;

         Prepend (Prop_For_Include, Dynamic_Prop_Inputs);
         Node_Sets.Union (Already_Included, Includes);
         Includes := Compute_Ada_Node_Set (+Prop_For_Include);

         --  Add the variable inputs of dynamic predicates to Includes so
         --  that their dynamic invariant can be assumed.

         for Var of Variables loop
            case Var.Kind is
               when Direct_Mapping =>
                  Node_Sets.Include (Includes, Get_Direct_Mapping_Id (Var));

               when Magic_String   =>
                  pragma Assert (Is_Opaque_For_Proof (Var));

               when others         =>
                  raise Program_Error;
            end case;
         end loop;

         Node_Sets.Difference (Includes, Already_Included);
         First_Iter := False;
      end loop;
      return Dynamic_Prop_Inputs;
   end Assume_Dynamic_Invariant_For_Variables;

   ------------------------------------------
   -- Assume_Dynamic_Invariant_For_Overlay --
   ------------------------------------------

   procedure Assume_Dynamic_Invariant_For_Overlay
     (Obj     : Object_Kind_Id;
      Params  : Transformation_Params;
      Context : in out W_Prog_Id)
   is
      Alias    : constant Opt_Object_Kind_Id := Ultimate_Overlaid_Entity (Obj);
      Alias_Id : constant W_Identifier_Id :=
        New_Temp_Identifier
          (Base_Name => "overlaid", Typ => Type_Of_Node (Alias));
      Obj_Term : constant W_Term_Id :=
        +Reconstruct_Item
           (Ada_Ent_To_Why.Element (Symbol_Table, Obj),
            EW_Term,
            Params.Ref_Allowed,
            +Alias_Id);
   begin
      --  No need to consider the validity flag, mutable overlays cannot be
      --  invalid.

      Append
        (Context,
         New_Assume_Statement
           (Pred =>
              New_Universal_Quantif
                (Binders  =>
                   (1 => Binder_Type'(B_Name => Alias_Id, others => <>)),
                 Triggers =>
                   New_Triggers
                     (Triggers =>
                        (1 => New_Trigger (Terms => (1 => +Obj_Term)))),
                 Pred     =>
                   New_Conditional
                     (Condition =>
                        Compute_Dynamic_Invariant
                          (Expr   => +Alias_Id,
                           Params => Params,
                           Ty     => Type_Of_Node (Alias)),
                      Then_Part =>
                        Compute_Dynamic_Invariant
                          (Expr   => Obj_Term,
                           Params => Params,
                           Ty     => Type_Of_Node (Obj))))));
   end Assume_Dynamic_Invariant_For_Overlay;

   -------------------------------
   -- Assume_For_Nested_Package --
   -------------------------------

   procedure Assume_For_Nested_Package
     (E        : Entity_Id;
      Params   : Transformation_Params;
      Assumes  : in out W_Prog_Id;
      For_Decl : Boolean;
      For_Body : Boolean)
   is

      procedure Assume_For_Nested_Package
        (Decls       : List_Id;
         Initialized : Flow_Id_Sets.Set;
         For_Decl    : Boolean;
         For_Body    : Boolean);
      --  Traverse the declaration of a package

      -------------------------------
      -- Assume_For_Nested_Package --
      -------------------------------

      procedure Assume_For_Nested_Package
        (Decls       : List_Id;
         Initialized : Flow_Id_Sets.Set;
         For_Decl    : Boolean;
         For_Body    : Boolean)
      is
         Decl : Node_Id := First (Decls);
      begin
         while Present (Decl) loop
            case Nkind (Decl) is
               when N_Package_Declaration =>

                  --  Traverse package declarations recursively

                  declare
                     P : constant Entity_Id := Unique_Defining_Entity (Decl);
                  begin
                     if not Is_Generic_Unit (P) and then Entity_In_SPARK (P)
                     then
                        Assume_For_Nested_Package
                          (P,
                           Params,
                           Assumes,
                           For_Decl => For_Decl,
                           For_Body => For_Body);
                     end if;
                  end;

               when N_Object_Declaration  =>
                  declare
                     Obj : constant Entity_Id := Defining_Identifier (Decl);
                  begin
                     --  Ignore Part_Of concurrent objects

                     if Is_Part_Of_Concurrent_Object (Obj) then
                        null;

                     --  Assume the value of constants at package declaration

                     elsif Ekind (Obj) = E_Constant
                       and then not Is_Access_Variable (Etype (Obj))
                     then
                        if For_Decl then
                           Assume_Declaration_Of_Entity
                             (E             => Obj,
                              Params        => Params,
                              Initialized   => True,
                              Top_Predicate => True,
                              Context       => Assumes);
                        end if;

                     --  Assume the declaration of variables when the body
                     --  has been elaborated.

                     elsif For_Body then
                        Assume_Declaration_Of_Entity
                          (E             => Obj,
                           Params        => Params,
                           Initialized   =>
                             Initialized.Contains (Direct_Mapping_Id (Obj)),
                           Top_Predicate => True,
                           Context       => Assumes);
                     end if;
                  end;

               when others                =>
                  null;
            end case;
            Next (Decl);
         end loop;
      end Assume_For_Nested_Package;

      Nested_Body : constant Boolean :=
        (if No (Package_Body (E)) then For_Decl else For_Body);
      --  Include the initial condition and initialization of variables in E
      --  if we are traversing its declaration if it has no body or if we are
      --  traversing its body if there is one.

      Init_Conds  : constant Node_Lists.List :=
        Find_Contracts (E, Pragma_Initial_Condition);
      Init_Map    : constant Dependency_Maps.Map :=
        (if Is_Wrapper_Package (E)
         then Dependency_Maps.Empty_Map
         else Parse_Initializes (E, Get_Flow_Scope (E)));
      Initialized : Flow_Id_Sets.Set;

      --  Start of processing for Assume_For_Nested_Package

   begin
      if not For_Decl and then not Nested_Body then
         return;
      end if;

      --  Parse the Initializes contract to get the set of initialized
      --  variables.

      for Clause in Init_Map.Iterate loop
         Initialized.Union
           (Expand_Abstract_State (Dependency_Maps.Key (Clause)));
      end loop;

      --  Traverse visisble and private declarations of the package

      Assume_For_Nested_Package
        (Visible_Declarations_Of_Package (E),
         Initialized,
         For_Decl => For_Decl,
         For_Body => Nested_Body);

      if Present (Private_Declarations_Of_Package (E))
        and then Private_Spec_In_SPARK (E)
      then
         Assume_For_Nested_Package
           (Private_Declarations_Of_Package (E),
            Initialized,
            For_Decl => For_Decl,
            For_Body => Nested_Body);
      end if;

      --  Assume initial condition if any when the body has been elaborated

      if Nested_Body then
         for Init_Cond of Init_Conds loop
            Append
              (Assumes,
               New_Assume_Statement
                 (Pred => Transform_Pred (Init_Cond, EW_Bool_Type, Params)));
         end loop;
      end if;
   end Assume_For_Nested_Package;

   -------------------------------
   -- Assume_Value_Of_Constants --
   -------------------------------

   procedure Assume_Value_Of_Constants
     (Why_Expr : in out W_Prog_Id;
      Scope    : Entity_Id;
      Params   : Transformation_Params)
   is
      Include : constant Node_Sets.Set := Compute_Ada_Node_Set (+Why_Expr);
      Assumes : W_Prog_Id := +Void;
   begin
      for N of Include loop
         if Nkind (N) in N_Entity
           and then
             ((Ekind (N) = E_Constant
               and then not Is_Access_Variable (Etype (N))
               and then not Has_Variable_Input (N)
               and then not Is_Declared_In_Unit (N, Scope))

              --  We only consider here parameters of enclosing
              --  subprograms. Parameters of Scope are handled
              --  specifically.

              or else
                (Ekind (N) in Formal_Kind
                 and then Enclosing_Unit (N) /= Scope))
         then
            Assume_Declaration_Of_Entity
              (E             => N,
               Params        => Params,
               Initialized   => True,
               Top_Predicate => True,
               Context       => Assumes);
         end if;
      end loop;

      Prepend (Assumes, Why_Expr);
   end Assume_Value_Of_Constants;

   -------------------------------
   -- Bind_From_Mapping_In_Expr --
   -------------------------------

   function Bind_From_Mapping_In_Expr
     (Params : Transformation_Params;
      Expr   : W_Expr_Id;
      N      : Node_Id;
      Name   : W_Identifier_Id;
      Domain : EW_Domain;
      As_Old : Boolean := False) return W_Expr_Id
   is
      Res : W_Expr_Id := Expr;
   begin

      --  For potentially invalid expressions, also declare a binding for the
      --  validity flag.

      if Nkind (N) = N_Defining_Identifier and then Object_Has_Valid_Id (N)
      then
         Res :=
           New_Typed_Binding
             (Name    => Name,
              Domain  => Domain,
              Def     =>
                Insert_Simple_Conversion
                  (Domain => Prog_Or_Term_Domain (Domain),
                   Expr   =>
                     (if As_Old
                      then Transform_Attribute_Old (N, Domain, Params)
                      else
                        Transform_Identifier
                          (Params, N, N, Prog_Or_Term_Domain (Domain))),
                   To     => Get_Typ (Name)),
              Context => Res);

         Res :=
           New_Typed_Binding
             (Name    => Get_Valid_Flag_For_Id (Name, Etype (N)),
              Domain  => Domain,
              Def     => +Get_Valid_Id_From_Object (N, Params.Ref_Allowed),
              Context => Res);

      elsif Is_Potentially_Invalid_Expr (N)
        and then not Has_Scalar_Type (Etype (N))
      then
         declare
            Def        : W_Expr_Id;
            Valid_Flag : W_Expr_Id;
            Context    : Ref_Context;
         begin
            Transform_Potentially_Invalid_Expr
              (Expr       => N,
               Domain     => Prog_Or_Term_Domain (Domain),
               Params     => Params,
               Context    => Context,
               W_Expr     => Def,
               Valid_Flag => Valid_Flag,
               As_Old     => As_Old);

            Res :=
              New_Typed_Binding
                (Name    => Name,
                 Domain  => Domain,
                 Def     =>
                   Insert_Simple_Conversion
                     (Domain => Prog_Or_Term_Domain (Domain),
                      Expr   => Def,
                      To     => Get_Typ (Name)),
                 Context => Res);

            Res :=
              New_Typed_Binding
                (Name    => Get_Valid_Flag_For_Id (Name, Etype (N)),
                 Domain  => Domain,
                 Def     => +Valid_Flag,
                 Context => Res);

            Res :=
              Bindings_For_Ref_Context
                (Expr => Res, Context => Context, Domain => Domain);
         end;
      else
         Res :=
           New_Typed_Binding
             (Name    => Name,
              Domain  => Domain,
              Def     =>
                Insert_Simple_Conversion
                  (Domain => Prog_Or_Term_Domain (Domain),
                   Expr   =>
                     (if As_Old
                      then Transform_Attribute_Old (N, Domain, Params)
                      else
                        Transform_Expr_Or_Identifier
                          (N, Prog_Or_Term_Domain (Domain), Params)),
                   To     => Get_Typ (Name)),
              Context => Res);
      end if;

      return Res;
   end Bind_From_Mapping_In_Expr;

   function Bind_From_Mapping_In_Expr
     (Params : Transformation_Params;
      Map    : Ada_To_Why_Ident.Map;
      Expr   : W_Expr_Id;
      Domain : EW_Domain;
      Subset : Node_Sets.Set;
      As_Old : Boolean := False) return W_Expr_Id
   is
      Result : W_Expr_Id := Expr;
      Cu     : Ada_To_Why_Ident.Cursor;

   begin
      for N of Subset loop
         Cu := Map.Find (N);

         if Ada_To_Why_Ident.Has_Element (Cu) then
            Result :=
              Bind_From_Mapping_In_Expr
                (Params => Params,
                 Expr   => Result,
                 N      => N,
                 Name   => Ada_To_Why_Ident.Element (Cu),
                 Domain => Domain,
                 As_Old => As_Old);
         end if;
      end loop;

      return Result;
   end Bind_From_Mapping_In_Expr;

   -------------------------------
   -- Bind_From_Mapping_In_Prog --
   -------------------------------

   function Bind_From_Mapping_In_Prog
     (Params : Transformation_Params;
      Map    : Ada_To_Why_Ident.Map;
      Expr   : W_Prog_Id) return W_Prog_Id
   is
      Result : W_Prog_Id := Expr;

   begin
      for C in Map.Iterate loop
         Result :=
           +Bind_From_Mapping_In_Expr
              (Params => Params,
               Expr   => +Result,
               N      => Ada_To_Why_Ident.Key (C),
               Name   => Ada_To_Why_Ident.Element (C),
               Domain => EW_Prog,
               As_Old => False);
      end loop;

      return Result;
   end Bind_From_Mapping_In_Prog;

   function Bind_From_Mapping_In_Prog
     (Params : Transformation_Params;
      Map    : Loop_Entry_Values;
      Expr   : W_Prog_Id) return W_Prog_Id
   is
      Result : W_Prog_Id := Expr;

   begin
      for C in Map.No_Checks.Iterate loop
         Result :=
           +Bind_From_Mapping_In_Expr
              (Params => Params,
               Expr   => +Result,
               N      => Ada_To_Why_Ident.Key (C),
               Name   => Ada_To_Why_Ident.Element (C),
               Domain => EW_Pterm,
               As_Old => False);
      end loop;

      for C in Map.Regular.Iterate loop
         Result :=
           +Bind_From_Mapping_In_Expr
              (Params => Params,
               Expr   => +Result,
               N      => Ada_To_Why_Ident.Key (C),
               Name   => Ada_To_Why_Ident.Element (C),
               Domain => EW_Prog,
               As_Old => False);
      end loop;

      return Result;
   end Bind_From_Mapping_In_Prog;

   ---------------------------
   -- Call_Never_Terminates --
   ---------------------------

   function Call_Never_Terminates
     (Call : Node_Id; Scope : Entity_Id) return Boolean
   is
      Subp : constant Entity_Id := Get_Called_Entity (Call);
   begin
      return
        Ekind (Subp) = E_Subprogram_Type
        or else
          (Mutually_Recursive (Scope, Subp)
           and then No (Get_Pragma (Subp, Pragma_Subprogram_Variant)))
        or else Present (Controlling_Argument (Call));
   end Call_Never_Terminates;

   ------------------
   -- Can_Be_Moved --
   ------------------

   function Can_Be_Moved (Expr : Node_Or_Entity_Id) return Boolean is
      Typ  : constant Entity_Id := Retysp (Etype (Expr));
      Root : constant Entity_Id :=
        (if Nkind (Expr) = N_Defining_Identifier
         then Expr
         elsif Is_Path_Expression (Expr)
         then Get_Root_Object (Expr)
         else Empty);
   begin
      return
        Contains_Allocated_Parts (Typ)
        and then not Is_Anonymous_Access_Type (Typ)
        and then
          Nkind (Expr) not in N_Attribute_Reference | N_Qualified_Expression
        --  A reference to the Access attribute itself cannot be moved. We
        --  move its prefix instead. Same for a qualified expression.

        and then Present (Root)
        and then not Is_Constant_In_SPARK (Root)
        and then
          (Nkind (Expr) = N_Defining_Identifier
           or else not Traverse_Access_To_Constant (Expr));
   end Can_Be_Moved;

   ---------------------------
   -- Check_No_Memory_Leaks --
   ---------------------------

   function Check_No_Memory_Leaks
     (Ada_Node           : Node_Id;
      N                  : Node_Or_Entity_Id;
      Is_Uncheck_Dealloc : Boolean := False;
      At_End_Of_Scope    : Boolean := False) return W_Prog_Id
   is
      Init_Typ : constant Entity_Id := Retysp (Etype (N));

      --  For Unchecked_Deallocation, we are not interested in the access type
      --  itself, but in the designated type. The fact that the argument of
      --  Unchecked_Deallocation should not be moved is checked already by the
      --  borrow checker. Here we check that all pointers in the designated
      --  value, if any, are moved (null being a special case of moved).

      Typ  : constant Entity_Id :=
        (if Is_Uncheck_Dealloc
         then Retysp (Directly_Designated_Type (Init_Typ))
         else Init_Typ);
      Root : constant Entity_Id :=
        (if Nkind (N) = N_Defining_Identifier then N else Get_Root_Object (N));

      Result : W_Prog_Id := +Void;
      Kind   : constant VC_Kind :=
        (if At_End_Of_Scope
         then VC_Resource_Leak_At_End_Of_Scope
         else VC_Resource_Leak);

   begin
      --  Nothing to check on borrow/observe of anonymous access type. Do not
      --  emit checks for memory leaks for ghost entities that cannot be
      --  enabled at runtime.

      if Contains_Allocated_Parts (Typ)
        and then not Is_Anonymous_Access_Type (Typ)
        and then
          (not Is_Ghost_Entity (Current_Subp)
           or else
             not Is_Non_Exec_Assertion_Level
                   (Ghost_Assertion_Level (Current_Subp)))
        and then
          not (Present (Root)
               and then Is_Ghost_Entity (Root)
               and then
                 Is_Non_Exec_Assertion_Level (Ghost_Assertion_Level (Root)))
      then
         declare
            Val     : constant W_Expr_Id :=
              New_Temp_For_Expr
                (Transform_Expr_Or_Identifier (N, EW_Pterm, Body_Params));
            Val_Typ : constant Type_Kind_Id := Get_Ada_Node (+Get_Type (Val));
            Tree    : constant W_Expr_Id :=
              New_Temp_For_Expr
                (if not Can_Be_Moved (N)
                 then
                   New_Any_Expr
                     (Return_Type => Get_Move_Tree_Type (Val_Typ),
                      Labels      => Symbol_Sets.Empty_Set)
                 elsif Nkind (N) = N_Defining_Identifier
                 then New_Move_Tree_Access_For_Identitier (N)
                 else New_Move_Tree_Access (N, EW_Pterm, Body_Params));
            --  If the value cannot be moved, use a fresh move tree

            Exp_Typ  : constant Type_Kind_Id :=
              (if not Can_Be_Moved (N)
               then Val_Typ
               else Expected_Type_For_Move_Tree (N));
            Is_Moved : constant W_Pred_Id :=
              (if Is_Uncheck_Dealloc
               then
                 New_Conditional
                   (Condition =>
                      New_Not
                        (Right =>
                           Pred_Of_Boolean_Term
                             (New_Pointer_Is_Null_Access (Val_Typ, +Val))),
                    Then_Part =>
                      Compute_Is_Moved_Or_Reclaimed
                        (Expr =>
                           +New_Pointer_Value_Access
                              (E => Val_Typ, Name => +Val, Domain => EW_Pterm),
                         Tree =>
                           +New_Move_Tree_Pointer_Value_Access
                              (Exp_Typ, Tree, EW_Pterm),
                         Ty   => Retysp (Directly_Designated_Type (Exp_Typ))))
               else Compute_Is_Moved_Or_Reclaimed (+Val, +Tree, Exp_Typ));

            --  As resource leaks do not lead to runtime errors, it is possible
            --  that these messages get ignored or even justified by users
            --  in some cases. Thus, it is particularly important that the
            --  corresponding checks have no effect on the rest of analysis,
            --  which we obtain here by enclosing the check in an ignore block.

            Check : constant W_Prog_Id :=
              New_Ignore
                (Prog =>
                   New_Located_Assert (Ada_Node, Is_Moved, Kind, EW_Assert));
         begin
            Result :=
              Binding_For_Temp
                (Tmp     => +Tree,
                 Context => Binding_For_Temp (Tmp => +Val, Context => Check));
         end;
      end if;

      return Result;
   end Check_No_Memory_Leaks;

   -------------------------------------------
   -- Check_No_Memory_Leaks_At_End_Of_Scope --
   -------------------------------------------

   function Check_No_Memory_Leaks_At_End_Of_Scope
     (Decls : List_Id) return W_Prog_Id
   is
      Cur_Decl : Node_Id := First (Decls);
      Result   : W_Statement_Sequence_Id := Void_Sequence;

   begin
      while Present (Cur_Decl) loop
         case Nkind (Cur_Decl) is

            --  Only consider objects in SPARK, so that parts of packages
            --  marked SPARK_Mode Off are ignored.

            when N_Object_Declaration  =>
               if Entity_In_SPARK (Defining_Identifier (Cur_Decl)) then
                  Append
                    (Result,
                     Check_No_Memory_Leaks
                       (Cur_Decl,
                        Defining_Identifier (Cur_Decl),
                        At_End_Of_Scope => True));
               end if;

            --  Objects in local packages should be deallocated before
            --  returning from the enclosing subprogram.

            when N_Package_Declaration =>
               declare
                  Pack : constant Entity_Id :=
                    Unique_Defining_Entity (Cur_Decl);
               begin
                  Append
                    (Result,
                     Check_No_Memory_Leaks_At_End_Of_Scope
                       (Visible_Declarations_Of_Package (Pack)));
                  Append
                    (Result,
                     Check_No_Memory_Leaks_At_End_Of_Scope
                       (Private_Declarations_Of_Package (Pack)));
               end;

            when N_Package_Body        =>
               Append
                 (Result,
                  Check_No_Memory_Leaks_At_End_Of_Scope
                    (Declarations (Cur_Decl)));

            when others                =>
               null;
         end case;
         Next (Cur_Decl);
      end loop;

      return +Result;
   end Check_No_Memory_Leaks_At_End_Of_Scope;

   -------------------------------------
   -- Check_Or_Assume_All_DICs_At_Use --
   -------------------------------------

   procedure Check_Or_Assume_All_DICs_At_Use
     (Ada_Node : Node_Id;
      E        : Type_Kind_Id;
      W_Expr   : W_Term_Id;
      Params   : Transformation_Params;
      Prog     : in out W_Prog_Id;
      Check    : Boolean)
   is
      First_DIC : Boolean := True;

      procedure Check_Or_Assume_DIC_At_Use
        (Default_Init_Param : Formal_Kind_Id; Default_Init_Expr : Node_Id);
      --  Append to Prog a program either checking (if Check is True) or
      --  assuming the DIC of Default_Init_Param if it shall be checked at
      --  use. DICs that are checked at declaration are ignored.

      --------------------------------
      -- Check_Or_Assume_DIC_At_Use --
      --------------------------------

      procedure Check_Or_Assume_DIC_At_Use
        (Default_Init_Param : Formal_Kind_Id; Default_Init_Expr : Node_Id)
      is
         Check_Info : Check_Info_Type := New_Check_Info;

      begin
         --  If the DIC was inherited, add a continuation

         if not First_DIC then
            Check_Info.Continuation.Append
              (Continuation_Type'
                 (Default_Init_Expr,
                  To_Unbounded_String
                    ("for inherited default initial condition")));
         else
            First_DIC := False;
         end if;

         if Needs_DIC_Check_At_Use (Etype (Default_Init_Param)) then

            if Check then
               Prepend
                 (New_Ignore
                    (Ada_Node => Ada_Node,
                     Prog     =>
                       +DIC_Expression
                          (+W_Expr,
                           Default_Init_Param,
                           Default_Init_Expr,
                           Params,
                           EW_Prog)),
                  New_Located_Assert
                    (Ada_Node   => Ada_Node,
                     Kind       => EW_Check,
                     Reason     => VC_Default_Initial_Condition,
                     Pred       =>
                       +DIC_Expression
                          (+W_Expr,
                           Default_Init_Param,
                           Default_Init_Expr,
                           Params,
                           EW_Pred),
                     Check_Info => Check_Info),
                  Prog);
            elsif Prog /= +Void then
               Prepend
                 (New_Assume_Statement
                    (Ada_Node => Ada_Node,
                     Pred     =>
                       +DIC_Expression
                          (+W_Expr,
                           Default_Init_Param,
                           Default_Init_Expr,
                           Params,
                           EW_Pred)),
                  Prog);
            end if;
         end if;
      end Check_Or_Assume_DIC_At_Use;

      procedure Check_Or_Assume_All_DICs_At_Use is new
        Iterate_Applicable_DIC (Check_Or_Assume_DIC_At_Use);

   begin
      Check_Or_Assume_All_DICs_At_Use (E);
   end Check_Or_Assume_All_DICs_At_Use;

   -------------------------
   -- Check_Type_With_DIC --
   -------------------------

   function Check_Type_With_DIC
     (Params : Transformation_Params; Ty : Type_Kind_Id) return W_Prog_Id
   is
      Ty_Ext : constant Entity_Id := Retysp (Ty);

      DIC_Subp  : constant Entity_Id := Partial_DIC_Procedure (Ty);
      DIC_Exprs : constant Node_Lists.List :=
        Get_Exprs_From_Check_Only_Proc (DIC_Subp);
      DIC_Param : constant Entity_Id := First_Formal (DIC_Subp);
      DIC_Check : W_Prog_Id := +Void;

   begin
      --  Generate let x = any Ty
      --               {Default_Init (result) /\ Dynamic_Invariant (result)} in
      --        ignore__ (Def_Init_Cond (x));
      --        assert {Def_Init_Cond (x)}

      --  Add the binder for the reference to the type to the
      --  Symbol_Table.

      Ada_Ent_To_Why.Push_Scope (Symbol_Table);

      declare
         W_Ty     : constant W_Type_Id :=
           (if Has_Relaxed_Init (Ty_Ext)
            then EW_Init_Wrapper (Type_Of_Node (Ty_Ext))
            else Type_Of_Node (Ty_Ext));
         --  The DIC should be checked on the wrapper type if the type is
         --  annotated with Relaxed_Initialization.
         Tmp_Id   : constant W_Identifier_Id :=
           New_Temp_Identifier (Ty_Ext, W_Ty);
         Result   : constant W_Identifier_Id := New_Result_Ident (W_Ty);
         Tmp_Post : constant W_Pred_Id :=
           New_And_Pred
             ((1 =>
                 Compute_Dynamic_Inv_And_Initialization
                   (Expr        => +Result,
                    Ty          => Ty_Ext,
                    Initialized => True_Term,
                    Only_Var    => False_Term,
                    Params      => Params),
               2 =>
                 Compute_Default_Init
                   (Expr             => +Result,
                    Ty               => Ty_Ext,
                    Include_Subtypes => True,
                    Skip_Last_Cond   => True_Term),
               3 => All_DICs_But_Last (Ty_Ext, +Result, Params)));
         --  Assume default initialization of the expression. Do not assume
         --  the Ty_Ext's own DIC if any.

         Tmp_Def : constant W_Prog_Id :=
           New_Any_Expr
             (Ada_Node    => Ty,
              Post        => Tmp_Post,
              Labels      => Symbol_Sets.Empty_Set,
              Return_Type => W_Ty);

      begin
         --  Store the entity for the type variable

         Insert_Tmp_Item_For_Entity (DIC_Param, Tmp_Id);

         for Expr of DIC_Exprs loop
            DIC_Check :=
              Sequence
                ((1 => DIC_Check,
                  2 =>
                    New_Ignore
                      (Prog =>
                         Transform_Prog (Expr => Expr, Params => Params)),
                  3 =>
                    New_Located_Assert
                      (Ada_Node => Expr,
                       Kind     => EW_Check,
                       Reason   => VC_Default_Initial_Condition,
                       Pred     =>
                         Transform_Pred (Expr => Expr, Params => Params))));
         end loop;

         DIC_Check :=
           New_Typed_Binding
             (Name => Tmp_Id, Def => Tmp_Def, Context => DIC_Check);

         Ada_Ent_To_Why.Pop_Scope (Symbol_Table);
      end;

      return DIC_Check;
   end Check_Type_With_DIC;

   ---------------------------------
   --  Check_Type_With_Invariants --
   ---------------------------------

   function Check_Type_With_Invariants
     (Params : Transformation_Params; N : Type_Kind_Id) return W_Prog_Id
   is
      Ty      : constant Entity_Id := Retysp (N);
      Base_Ty : constant Entity_Id := Base_Type (Ty);
      --  For first subtypes, we generate a check if the base type has an
      --  invariant.

      Tmp_Id   : constant W_Identifier_Id :=
        New_Temp_Identifier (Ty, Type_Of_Node (Ty));
      Tmp_Post : constant W_Pred_Id :=
        Compute_Dynamic_Invariant
          (Expr        => +New_Result_Ident (Type_Of_Node (Ty)),
           Ty          => Ty,
           Initialized => True_Term,
           Only_Var    => False_Term,
           Params      => Params);
      Tmp_Def  : constant W_Prog_Id :=
        New_Any_Expr
          (Ada_Node    => N,
           Post        => Tmp_Post,
           Labels      => Symbol_Sets.Empty_Set,
           Return_Type => Type_Of_Node (Ty));

      Inv_RTE   : W_Prog_Id := +Void;
      Inv_Check : W_Prog_Id;

   begin
      --  Generate:
      --  let tmp = any Ty ensure {dynamic_invariant (result)} in
      --  ignore (inv_expr (tmp));  -- only if Ty has an invariant
      --  assume {default_init (tmp)};
      --  assert {inv_expr (tmp)}

      --  If the type itself has an invariant, check for runtime errors in the
      --  type's invariant.

      if Has_Invariants_In_SPARK (Base_Ty) then
         declare
            Inv_Subp  : constant Node_Id := Invariant_Procedure (Ty);
            Inv_Exprs : constant Node_Lists.List :=
              Get_Exprs_From_Check_Only_Proc (Inv_Subp);
            Inv_Param : constant Entity_Id := First_Formal (Inv_Subp);
         begin
            Ada_Ent_To_Why.Push_Scope (Symbol_Table);
            Insert_Tmp_Item_For_Entity (Inv_Param, Tmp_Id);

            for Expr of Inv_Exprs loop
               Inv_RTE :=
                 Sequence
                   (Inv_RTE,
                    New_Ignore
                      (Expr,
                       Transform_Prog
                         (Expr          => Expr,
                          Expected_Type => EW_Bool_Type,
                          Params        => Params)));
            end loop;

            Ada_Ent_To_Why.Pop_Scope (Symbol_Table);
         end;
      end if;

      --  Check that the default values of the type and all its subtypes
      --  respect its invariant.

      declare
         Default_Init : constant W_Pred_Id :=
           Compute_Default_Init
             (+Tmp_Id,
              N,
              Params,
              Include_Subtypes => True,
              Skip_Last_Cond   => True_Term);
         DICs         : constant W_Pred_Id :=
           All_DICs_But_Last (N, +Tmp_Id, Params);
         --  Do not assume N's own DIC if it is checked at declaration as it
         --  might contain a boundary call.

      begin
         Inv_Check :=
           Sequence
             (Left  =>
                New_Assume_Statement (Ty, New_And_Pred (Default_Init, DICs)),
              Right => New_Invariant_Check (N, Ty, +Tmp_Id, True));
      end;

      return
        New_Ignore
          (Ty,
           New_Typed_Binding
             (Name    => Tmp_Id,
              Def     => Tmp_Def,
              Context => Sequence (Inv_RTE, Inv_Check)));
   end Check_Type_With_Invariants;

   ------------------------------
   -- Check_Type_With_Iterable --
   ------------------------------

   function Check_Type_With_Iterable
     (Params : Transformation_Params; Ty : Type_Kind_Id) return W_Prog_Id
   is
      Check_Info  : Check_Info_Type := New_Check_Info;
      Checks      : W_Prog_Id := +Void;
      Cont_Ty_Spk : constant Entity_Id := Retysp (Ty);

      procedure Add_Check
        (Fn        : Entity_Id;
         Args      : W_Expr_Array;
         Typ       : W_Type_Id;
         Check_Inv : Boolean := False);
      --  Add pre-condition check for Fn (Args) : Typ
      --  at the beginning of Checks. If Check_Inv is True, also check the
      --  invariant after the call if any.

      procedure Add_Unknown_Binding
        (Ty_Spk : Entity_Id; Ty_Why : W_Type_Id; V_Name : W_Identifier_Id);
      --  Add new extra unknown value of given type to beginning of checks,
      --  using temporary name.

      procedure Exclude_Recursive (Fn : Entity_Id);
      --  Emit error if primitive is recursive.

      function Fetch_Name
        (Fn : Entity_Id; Domain : EW_Domain := EW_Prog) return W_Identifier_Id;
      --  Fetch the name of the Why entity representing Fn

      function Prim (Nam : Name_Id) return Entity_Id
      is (Get_Iterable_Type_Primitive (Cont_Ty_Spk, Nam));
      --  Short-hand to fetch iterable primitives of container.

      function To_Why_Ty (Ty_Spk : Entity_Id) return W_Type_Id
      is (if Has_Relaxed_Init (Ty_Spk)
          then EW_Init_Wrapper (Type_Of_Node (Ty_Spk))
          else Type_Of_Node (Ty_Spk));
      --  Convert retysp to relevant why type.

      ---------------
      -- Add_Check --
      ---------------

      procedure Add_Check
        (Fn        : Entity_Id;
         Args      : W_Expr_Array;
         Typ       : W_Type_Id;
         Check_Inv : Boolean := False)
      is
         Name : constant W_Identifier_Id := Fetch_Name (Fn);

         --  In some corner-cases, the first argument type
         --  might be a non-trivial ancestor of the container type.

         Arg_Ty  : constant W_Type_Id :=
           To_Why_Ty (Retysp (Etype (First_Formal (Fn))));
         Args_Cv : constant W_Expr_Array :=
           (Args
            with delta
              1 =>
                Insert_Simple_Conversion
                  (Domain => EW_Pterm, Expr => Args (1), To => Arg_Ty));
         Call    : constant W_Prog_Id :=
           New_VC_Call
             (Ada_Node   => Fn,
              Name       => Name,
              Progs      => Args_Cv,
              Reason     => VC_Precondition,
              Typ        => Typ,
              Check_Info => Check_Info);
         Check   : W_Prog_Id := Call;
      begin
         if Check_Inv then
            Check :=
              Insert_Invariant_Check
                (Ada_Node   => Fn,
                 Check_Ty   => Etype (Fn),
                 W_Expr     => Check,
                 Check_Info => Check_Info);
         end if;

         Checks := Sequence (New_Ignore (Prog => Check), Checks);
      end Add_Check;

      -----------------
      -- Add_Unknown --
      -----------------

      procedure Add_Unknown_Binding
        (Ty_Spk : Entity_Id; Ty_Why : W_Type_Id; V_Name : W_Identifier_Id)
      is
         Res_Id : constant W_Identifier_Id := New_Result_Ident (Ty_Why);
         Post   : constant W_Pred_Id :=
           New_And_Pred
             (Left  =>
                Compute_Dynamic_Invariant (+Res_Id, Ty_Spk, Params, True_Term),
              Right =>
                Compute_Type_Invariant
                  (+Res_Id, Ty_Spk, For_Check, Params, Scop => Current_Subp));
      begin
         Checks :=
           New_Typed_Binding
             (Name    => V_Name,
              Def     =>
                New_Any_Expr
                  (Ada_Node    => Ty,
                   Post        => Post,
                   Labels      => Symbol_Sets.Empty_Set,
                   Return_Type => Ty_Why),
              Context => Checks);
      end Add_Unknown_Binding;

      -----------------------
      -- Exclude_Recursive --
      -----------------------

      procedure Exclude_Recursive (Fn : Entity_Id) is
      begin
         if Proof_Module_Cyclic (Fn) then
            Error_Msg_N
              ("iteration primitive shall not be recursive,"
               & " (including implicitly so)",
               Fn);
         end if;
      end Exclude_Recursive;

      ----------------
      -- Fetch_Name --
      ----------------

      function Fetch_Name
        (Fn : Entity_Id; Domain : EW_Domain := EW_Prog) return W_Identifier_Id
      is
      begin
         return
           To_Why_Id
             (E => Fn, Domain => Domain, Selector => Why.Inter.Standard);
      end Fetch_Name;

      --  Start of processing for Check_Type_With_Iterable

   begin
      Ada_Ent_To_Why.Push_Scope (Symbol_Table);

      --  Retrieve all relevant operations for quantifier
      --  processing (last/previous are never relevant).
      declare
         Fn_Has_Elt : constant Entity_Id := Prim (Name_Has_Element);
         Fn_First   : constant Entity_Id := Prim (Name_First);
         Fn_Next    : constant Entity_Id := Prim (Name_Next);
         Fn_Element : constant Entity_Id := Prim (Name_Element);

         --  Retrieve types for container/cursor.
         --  Element type is retrieved only if necessary.

         Curs_Ty_Spk : constant Entity_Id := Retysp (Etype (Fn_First));
         Cont_Ty_Why : constant W_Type_Id := To_Why_Ty (Cont_Ty_Spk);
         Curs_Ty_Why : constant W_Type_Id := To_Why_Ty (Curs_Ty_Spk);

         --  Identifiers for container/cursor

         Cont_Id : constant W_Identifier_Id :=
           New_Temp_Identifier (Cont_Ty_Spk, Cont_Ty_Why);
         Curs_Id : constant W_Identifier_Id :=
           New_Temp_Identifier (Curs_Ty_Spk, Curs_Ty_Why);

         --  Needs an extra check when an
         --  iterable_for_proof annotation is present
         Annot         : Iterable_Annotation;
         Annot_Present : Boolean;

         --  Package arguments for Iterable primitives
         Args_One  : constant W_Expr_Array := (1 => +Cont_Id);
         Args_Both : constant W_Expr_Array := (1 => +Cont_Id, 2 => +Curs_Id);

      begin
         Check_Info.Continuation.Append
           (Continuation_Type'
              (Ty, To_Unbounded_String ("during checks for quantification")));
         Retrieve_Iterable_Annotation (Cont_Ty_Spk, Annot_Present, Annot);

         --  Emit errors for non-recursivity.

         declare
            type Entity_Array is array (Positive range <>) of Entity_Id;
            Primitives : constant Entity_Array :=
              [Fn_First, Fn_Next, Fn_Has_Elt]
              & (if Present (Fn_Element) then [Fn_Element] else [])
              & (if Annot_Present then [Annot.Entity] else []);
         begin
            for C of Primitives loop
               Exclude_Recursive (C);
            end loop;
         end;

         --  Code is in reverse order from generated check sequence
         --    (because of typed bindings).
         --  Shape of why statement:
         --
         --    let Cont = any in
         --    ignore (First-Check (Cont));
         --    (* vv  if Annotation "Model" present  vv *)
         --    ignore (Model-Check (Cont));
         --    (* vv  if Annotation "Contains" present  vv *)
         --    ignore {
         --      let Elt = any in
         --      ignore (Contains-Check (Cont, Elt))
         --    }
         --    let Curs = any in
         --    ignore (Has_Element-Check (Cont, Curs));
         --    assume (Has_Element-Pred (Cons, Curs));
         --    ignore (Next-Check (Cont, Curs));
         --    (* vv  if "Element" specified  vv *)
         --    ignore (Element-Check (Cont, Curs))

         if Present (Fn_Element) then

            --  Check the invariant for elements if quantification can be
            --  done on elements.

            Add_Check
              (Fn_Element,
               Args_Both,
               To_Why_Ty (Retysp (Etype (Fn_Element))),
               Check_Inv => Annot_Present and then Annot.Kind = Contains);
         end if;

         --  Always check the invariant for cursors

         Add_Check (Fn_Next, Args_Both, Curs_Ty_Why, Check_Inv => True);

         declare
            Name : constant W_Identifier_Id :=
              Fetch_Name (Fn_Has_Elt, EW_Pred);

         begin
            Checks :=
              Sequence
                (New_Assume_Statement
                   (Pred =>
                      New_Call
                        (Name => Name,
                         Args =>
                           (Args_Both
                            with delta
                              1 =>
                                Insert_Simple_Conversion
                                  (Domain => EW_Pterm,
                                   Expr   => Args_Both (1),
                                   To     =>
                                     To_Why_Ty
                                       (Retysp
                                          (Etype
                                             (First_Formal (Fn_Has_Elt)))))))),
                 Checks);
         end;

         Add_Check (Fn_Has_Elt, Args_Both, EW_Bool_Type);
         Add_Unknown_Binding (Curs_Ty_Spk, Curs_Ty_Why, Curs_Id);

         if Annot_Present then
            case Annot.Kind is
               when Contains =>
                  declare
                     Checks_Branch : constant W_Prog_Id := Checks;
                     Elt_Ty_Spk    : constant Entity_Id :=
                       Retysp (Etype (Fn_Element));
                     Elt_Ty_Why    : constant W_Type_Id :=
                       To_Why_Ty (Elt_Ty_Spk);
                     Elt_Id        : constant W_Identifier_Id :=
                       New_Temp_Identifier (Elt_Ty_Spk, Elt_Ty_Why);
                  begin
                     Checks := +Void;
                     Add_Check
                       (Annot.Entity,
                        (1 => +Cont_Id, 2 => +Elt_Id),
                        EW_Bool_Type);
                     Add_Unknown_Binding (Elt_Ty_Spk, Elt_Ty_Why, Elt_Id);
                     Checks :=
                       Sequence (New_Ignore (Prog => Checks), Checks_Branch);
                  end;

               when Model    =>
                  declare
                     Model_Ty_Spk : constant Entity_Id :=
                       Retysp (Etype (Annot.Entity));
                     Model_Ty_Why : constant W_Type_Id :=
                       To_Why_Ty (Model_Ty_Spk);
                  begin
                     Add_Check (Annot.Entity, Args_One, Model_Ty_Why);
                  end;
            end case;
         end if;

         Add_Check (Fn_First, Args_One, Curs_Ty_Why, Check_Inv => True);
         Add_Unknown_Binding (Cont_Ty_Spk, Cont_Ty_Why, Cont_Id);
      end;

      Ada_Ent_To_Why.Pop_Scope (Symbol_Table);
      return Checks;
   end Check_Type_With_Iterable;

   ------------------------
   -- Check_Scalar_Range --
   ------------------------

   function Check_Scalar_Range
     (Params : Transformation_Params; N : Node_Id; Base : Type_Kind_Id)
      return W_Prog_Id
   is
      Rng  : constant Node_Id := Get_Range (N);
      Low  : constant Node_Id := Low_Bound (Rng);
      High : constant Node_Id := High_Bound (Rng);

   begin
      --  If the range is static, raises no run-time errors by itself, and a
      --  base type is passed, we need to check that either the range is empty
      --  or the bounds fit in the base type. Do nothing when either of these
      --  conditions can be verified statically.

      if Is_OK_Static_Range (Rng)
        and then Has_OK_Static_Scalar_Subtype (Base)
        and then
          ((if Is_Floating_Point_Type (Base)
            then Expr_Value_R (High) < Expr_Value_R (Low)
            else Expr_Value (High) < Expr_Value (Low))
           or else
             (Is_In_Range (N => Low, Typ => Base)
              and then Is_In_Range (N => High, Typ => Base)))
      then
         return +Void;

      else
         declare
            Why_Base       : constant W_Type_Id :=
              Base_Why_Type_No_Bool (Base);
            Le             : constant W_Identifier_Id :=
              (if Why_Type_Is_Float (Why_Base)
               then MF_Floats (Why_Base).Le
               elsif Why_Type_Is_BitVector (Why_Base)
               then MF_BVs (Why_Base).Ule
               else Int_Infix_Le);
            Low_Expr       : constant W_Term_Id :=
              Transform_Term (Low, Why_Base, Params);
            High_Expr      : constant W_Term_Id :=
              Transform_Term (High, Why_Base, Params);
            First_In_Range : constant W_Pred_Id :=
              New_Call
                (Name =>
                   (if Why_Type_Is_Float (Why_Base)
                    then MF_Floats (Why_Base).Ge
                    elsif Why_Type_Is_BitVector (Why_Base)
                    then MF_BVs (Why_Base).Uge
                    else Int_Infix_Ge),
                 Typ  => EW_Bool_Type,
                 Args =>
                   (+Low_Expr,
                    New_Attribute_Expr
                      (Base, EW_Term, Attribute_First, Params)));
            Last_In_Range  : constant W_Pred_Id :=
              New_Call
                (Name => Le,
                 Typ  => EW_Bool_Type,
                 Args =>
                   (+High_Expr,
                    New_Attribute_Expr
                      (Base, EW_Term, Attribute_Last, Params)));
            First_Le_Last  : constant W_Pred_Id :=
              New_Call
                (Name => Le,
                 Typ  => EW_Bool_Type,
                 Args => (+Low_Expr, +High_Expr));
            Precond        : constant W_Pred_Id :=
              New_Connection
                (Op    => EW_Imply,
                 Left  => First_Le_Last,
                 Right =>
                   New_And_Pred
                     (Left => First_In_Range, Right => Last_In_Range));

            Check_Range : W_Prog_Id;
         begin

            --  We need to check both that the range is OK (either
            --  empty or contained in the range's type) and that there cannot
            --  be any runtime errors during the computation of the bounds.
            --  If the range bounds where computed by the frontend, we assume
            --  that they are correct.

            Check_Range :=
              New_Any_Statement
                (Ada_Node => N,
                 Pre      => Precond,
                 Reason   => VC_Range_Check,
                 Post     => True_Pred);

            if Comes_From_Source (Original_Node (Low))
              and then not Is_OK_Static_Expression (Low)
            then
               Prepend
                 (New_Ignore
                    (Ada_Node => N,
                     Prog     => Transform_Prog (Low, Why_Base, Params)),
                  Check_Range);
            end if;

            if Comes_From_Source (Original_Node (High))
              and then not Is_OK_Static_Expression (High)
            then
               Prepend
                 (New_Ignore
                    (Ada_Node => N,
                     Prog     => Transform_Prog (High, Why_Base, Params)),
                  Check_Range);
            end if;

            return Check_Range;
         end;
      end if;
   end Check_Scalar_Range;

   -------------------------------
   -- Check_Subprogram_Variants --
   -------------------------------

   function Check_Subprogram_Variants
     (Call                  : Node_Id;
      Args                  : W_Expr_Array;
      Params                : Transformation_Params;
      Specialization_Module : Symbol := No_Symbol) return W_Prog_Id
   is
      Callee       : constant Entity_Id := Get_Called_Entity_For_Proof (Call);
      Call_Variant : constant Node_Id :=
        Get_Pragma (Callee, Pragma_Subprogram_Variant);
      Result       : Boolean;
      Explanation  : Unbounded_String;
   begin
      Is_Valid_Recursive_Call (Call, Current_Subp, Result, Explanation);

      if not Result then
         Emit_Static_Proof_Result
           (Call,
            VC_Subprogram_Variant,
            False,
            Current_Subp,
            Explanation => To_String (Explanation));
         return +Void;
      elsif Is_Structural_Subprogram_Variant (Call_Variant) then
         declare
            Variants : constant Node_Id :=
              Get_Pragma (Current_Subp, Pragma_Subprogram_Variant);
            Aggr     : constant Node_Id :=
              Expression (First (Pragma_Argument_Associations (Variants)));
            Variant  : constant Node_Id :=
              First (Component_Associations (Aggr));
         begin
            Structurally_Decreases_In_Call
              (Param       => Entity (Expression (Variant)),
               Call        => Call,
               Result      => Result,
               Explanation => Explanation);
            Emit_Static_Proof_Result
              (Call,
               VC_Subprogram_Variant,
               Result,
               Current_Subp,
               Explanation => To_String (Explanation));
            return +Void;
         end;
      else
         declare
            Enclosing_Variants : constant W_Expr_Array :=
              (if Is_Subprogram_Or_Entry (Current_Subp)
               then Get_Variants_Ids (Current_Subp)
               else
                 Get_Variants_Exprs
                   (E      =>
                      Directly_Enclosing_Subprogram_Or_Entry (Current_Subp),
                    Domain => EW_Pterm,
                    Params => Params));
            --  If the enclosing entity is a subprogram or entry, then we have
            --  introduced constants for the values of its variants at the
            --  beginning of the subprogram.
            --  Otherwise, we are in a package nested directly in a subprogram.
            --  In this case, we can use the expression of the variants, as
            --  it cannot have changed since the beginning of the subprogram.

            Variant_Check : constant W_Identifier_Id :=
              (if Specialization_Module = No_Symbol
               then E_Symb (Callee, WNE_Check_Subprogram_Variants)
               else
                 M_HO_Specializations (Callee) (Specialization_Module)
                   .Variant_Id);
         begin
            return
              New_VC_Call
                (Ada_Node => Call,
                 Name     => Variant_Check,
                 Progs    => Enclosing_Variants & Args,
                 Reason   => VC_Subprogram_Variant,
                 Typ      => EW_Unit_Type);
         end;
      end if;
   end Check_Subprogram_Variants;

   ------------------------------
   -- Check_Subtype_Indication --
   ------------------------------

   function Check_Subtype_Indication
     (Params : Transformation_Params; N : Node_Id; Sub_Type : Type_Kind_Id)
      return W_Prog_Id is
   begin
      if Is_Scalar_Type (Sub_Type) then
         return
           Check_Scalar_Range
             (Params => Params,
              N      => Sub_Type,
              Base   => Etype (Subtype_Mark (N)));
      else
         return +Void;
      end if;
   end Check_Subtype_Indication;

   ---------------------------
   -- Check_UU_Restrictions --
   ---------------------------

   procedure Check_UU_Restrictions (Expr : Node_Id) is
      --  Program_Error is raised in the following cases:
      --  * Evaluation of the predefined equality operator for an unchecked
      --    union type if either of the operands lacks inferable discriminants.
      --  * Evaluation of the predefined equality operator for a type which has
      --    a subcomponent of an unchecked union type whose nominal subtype is
      --    unconstrained.
      --  * Evaluation of a membership test if the subtype_mark denotes a
      --    constrained unchecked union subtype and the expression lacks
      --    inferable discriminants.

      Is_Membership_Test                 : constant Boolean :=
        Nkind (Expr) in N_Membership_Test;
      Left                               : constant Node_Id :=
        (if Nkind (Expr) = N_Function_Call
         then First_Actual (Expr)
         else Left_Opnd (Expr));
      Left_Type                          : constant Entity_Id :=
        Retysp (Etype (Left));
      Ty_Has_Unconstrained_UU_Component  : constant Boolean :=
        Has_UU_Component (Left_Type, Unconstrained_Only => True);
      Ty_Has_UU_Type                     : constant Boolean :=
        Is_Unchecked_Union (Left_Type);
      Left_Lacks_Inferable_Discriminants : constant Boolean :=
        Ty_Has_UU_Type and then not Has_Inferable_Discriminants (Left);
      Use_Predef_Equality                : constant Boolean :=
        (not Is_Membership_Test
         or else Use_Predefined_Equality_For_Type (Left_Type))
        and then
          (not Is_Class_Wide_Type (Left_Type)
           or else
             Use_Predefined_Equality_For_Type
               (Get_Specific_Type_From_Classwide (Left_Type)));
      --  Nothing needs to be done for equalities if we are not using the
      --  predefined one. This should not occur while translating equalities
      --  as ones using primitives will have been rewritten as function calls.
      --  If the equality or membership test is on class-wide types, the
      --  primitive equality of the specific type will be used if any.

      procedure Do_One_Alternative
        (Right           : Node_Id;
         Violation_Found : in out Boolean;
         Ada_Node        : in out Node_Id;
         Explanation     : in out Unbounded_String);
      --  Check if a restriction is broken for a single comparison. If one is
      --  found, Violation_Found is set to true and Ada_Node and Explanation
      --  are updated accordingly.

      ------------------------
      -- Do_One_Alternative --
      ------------------------

      procedure Do_One_Alternative
        (Right           : Node_Id;
         Violation_Found : in out Boolean;
         Ada_Node        : in out Node_Id;
         Explanation     : in out Unbounded_String)
      is
         Right_Is_Type : constant Boolean :=
           Is_Membership_Test
           and then Nkind (Right) in N_Identifier | N_Expanded_Name
           and then Is_Type (Entity (Right));
         --  Either Right is a type and the operation is a membership test or
         --  Right is an expression and it is an equality.

      begin
         --  If the operation is an equality and Right_Type has a
         --  subcomponent of an unchecked union type whose nominal subtype is
         --  unconstrained, we have found a violation of the restrictions.

         if not Right_Is_Type
           and then Use_Predef_Equality
           and then Ty_Has_Unconstrained_UU_Component
         then
            Violation_Found := True;
            Explanation :=
              To_Unbounded_String
                ("operand type has a subcomponent of an unchecked"
                 & " union type whose nominal subtype is"
                 & " unconstrained");

         --  We need inferable discriminants on the left operand if the
         --  operation is a predefined equality or Right is a constrained type.

         elsif Left_Lacks_Inferable_Discriminants
           and then
             (if Right_Is_Type
              then Is_Constrained (Entity (Right))
              else Use_Predef_Equality)
         then
            Violation_Found := True;
            Explanation :=
              To_Unbounded_String
                ("left operand should have inferable discriminants");

         --  We need inferable discriminants on the right operand if the
         --  operation is a predefined equality.

         elsif Ty_Has_UU_Type
           and then Use_Predef_Equality
           and then not Right_Is_Type
           and then not Has_Inferable_Discriminants (Right)
         then
            declare
               Right_String : constant String :=
                 (if Is_Membership_Test
                  then "alternative"
                  else "right operand");
            begin
               Violation_Found := True;
               Explanation :=
                 To_Unbounded_String
                   (Right_String & " should have inferable discriminants");

               --  If we are in a membership test, set the location to the
               --  corresponding alternative.

               if Is_Membership_Test then
                  Ada_Node := Right;
               end if;
            end;
         end if;
      end Do_One_Alternative;

      Violation_Found : Boolean := False;
      Ada_Node        : Node_Id := Expr;
      Explanation     : Unbounded_String := To_Unbounded_String ("");

      --  Start of processing for Check_UU_Restrictions

   begin
      --  Nothing to do if the type does not contain parts with unchecked union
      --  types.

      if not Ty_Has_UU_Type and then not Ty_Has_Unconstrained_UU_Component then
         return;
      end if;

      --  Go over the alternatives and search for violations of the UU
      --  restrictions.

      if Left_Lacks_Inferable_Discriminants
        or else
          (Use_Predef_Equality
           and then (Ty_Has_Unconstrained_UU_Component or Ty_Has_UU_Type))
      then
         if Is_Membership_Test and then Present (Alternatives (Expr)) then
            declare
               Alt : Node_Id := First (Alternatives (Expr));
            begin
               loop
                  Do_One_Alternative
                    (Alt, Violation_Found, Ada_Node, Explanation);
                  Next (Alt);
                  exit when No (Alt) or else Violation_Found;
               end loop;
            end;
         else
            Do_One_Alternative
              ((if Nkind (Expr) = N_Function_Call
                then Next_Actual (Left)
                else Right_Opnd (Expr)),
               Violation_Found,
               Ada_Node,
               Explanation);
         end if;
      end if;

      --  Generate a statically known proof result

      Emit_Static_Proof_Result
        (Ada_Node,
         VC_Unchecked_Union_Restriction,
         not Violation_Found,
         Current_Subp,
         Explanation => To_String (Explanation));
   end Check_UU_Restrictions;

   -------------------------------
   -- Collect_Index_Expressions --
   -------------------------------

   procedure Collect_Index_Expressions
     (Expr      : Node_Id;
      Domain    : EW_Domain;
      Params    : Transformation_Params;
      Context   : in out Ref_Context;
      Index_Map : in out Ada_Node_To_Why_Id.Map)
   is
      procedure Add_Index (Expr : N_Subexpr_Id);
      --  Add an identifier of Expr to Index_Map and a binding to
      --  Context.

      ---------------
      -- Add_Index --
      ---------------

      procedure Add_Index (Expr : N_Subexpr_Id) is
         W_Id : constant W_Identifier_Id :=
           New_Temp_Identifier
             (Typ       =>
                Base_Why_Type_No_Bool (Entity_Id'(Type_Of_Node (Expr))),
              Base_Name => "idx");
      begin
         Index_Map.Insert (Expr, W_Id);

         Context.Append
           (Ref_Type'
              (Mutable => False,
               Name    => W_Id,
               Value   =>
                 Transform_Expr (Expr, Get_Typ (W_Id), Domain, Params)));
      end Add_Index;

      Pref : Node_Id := Expr;
   begin
      loop
         case Nkind (Pref) is
            when N_Identifier | N_Expanded_Name                =>
               exit;

            when N_Type_Conversion
               | N_Unchecked_Type_Conversion
               | N_Qualified_Expression                        =>
               Pref := Expression (Pref);

            when N_Selected_Component | N_Explicit_Dereference =>
               Pref := Prefix (Pref);

            when N_Indexed_Component                           =>
               declare
                  Cursor : Node_Id := First (Expressions (Pref));
               begin
                  while Present (Cursor) loop
                     Add_Index (Cursor);
                     Next (Cursor);
                  end loop;
               end;
               Pref := Prefix (Pref);

            when N_Slice                                       =>
               declare
                  Rng : constant Node_Id := Get_Range (Discrete_Range (Pref));
               begin
                  Add_Index (Low_Bound (Rng));
                  Add_Index (High_Bound (Rng));
               end;
               Pref := Prefix (Pref);

            when others                                        =>
               Ada.Text_IO.Put_Line
                 ("[Collect_Index_Expressions] kind ="
                  & Node_Kind'Image (Nkind (Pref)));
               raise Not_Implemented;
         end case;
      end loop;
   end Collect_Index_Expressions;

   -----------------------------------
   -- Compute_Array_Component_Size --
   -----------------------------------

   procedure Compute_Array_Component_Size
     (Typ          : Type_Kind_Id;
      Domain       : EW_Domain;
      Dynamic_Size : out W_Expr_Id;
      Precise      : out Boolean;
      Explanation  : out Unbounded_String)
   is
      Size_Str  : Unbounded_String;
      Comp_Size : Uint;

   begin
      Precise := True;

      Array_Component_Size (Typ, Comp_Size, Size_Str, Explanation);

      if Present (Comp_Size) then
         Dynamic_Size := New_Integer_Constant (Value => Comp_Size);
      else
         Compute_Size_Of_Type
           (Typ          => Retysp (Component_Type (Typ)),
            Object_Size  => not Is_Packed (Typ),
            Domain       => Domain,
            Dynamic_Size => Dynamic_Size,
            Precise      => Precise,
            Explanation  => Explanation);
      end if;
   end Compute_Array_Component_Size;

   ---------------------------------
   -- Compute_Borrow_At_End_Value --
   ---------------------------------

   procedure Compute_Borrow_At_End_Value
     (Check_Node    : Entity_Id := Empty;
      W_Brower      : W_Term_Id;
      Expr          : N_Subexpr_Id;
      Borrowed_Expr : Opt_N_Subexpr_Id := Empty;
      Reconstructed : out W_Term_Id;
      Checks        : out W_Statement_Sequence_Id)
   is
      Path   : Node_Id := Expr;
      Dummy  : Node_Id := Path;
      Result : W_Expr_Id := +W_Brower;

   begin
      Checks := Void_Sequence;

      while Path /= Borrowed_Expr loop
         declare
            Typ : constant Type_Kind_Id := Retysp (Etype (Path));
         begin
            if Present (Check_Node) and then Has_Predicates (Typ) then
               Continuation_Stack.Append
                 (Continuation_Type'
                    (Ada_Node => Check_Node,
                     Message  =>
                       To_Unbounded_String
                         ("in possible reconstructed values at the end of the"
                          & " borrow")));
               Append
                 (Checks,
                  New_Predicate_Check
                    (Ada_Node => Path, Ty => Typ, W_Expr => +Result));
               Continuation_Stack.Delete_Last;
            end if;
         end;

         --  If Path is a traversal function call, use the borrowed_at_end
         --  function to reconstruct the first parameter from the result
         --  of the call.
         --
         --  If Path is Func (X, Z),
         --  * set Result to Func.borrowed_at_end x z Result
         --  * set Path to X.

         if Nkind (Path) = N_Function_Call then
            declare
               Subp         : constant Entity_Id :=
                 Get_Called_Entity_For_Proof (Path);
               Borrowed_End : constant W_Identifier_Id :=
                 Get_Borrowed_At_End (Subp);
               Context      : Ref_Context;
               Store        : W_Statement_Sequence_Id := Void_Sequence;
               Exc_Store    : W_Statement_Sequence_Id := Void_Sequence;
               Args         : constant W_Expr_Array :=
                 Compute_Call_Args
                   (Call      => Path,
                    Domain    => EW_Term,
                    Context   => Context,
                    Store     => Store,
                    Exc_Store => Exc_Store,
                    Params    => Body_Params);
               pragma Assert (Context.Is_Empty);

            begin
               Result :=
                 New_Call
                   (Domain => EW_Term,
                    Name   => Borrowed_End,
                    Args   => Args & Result,
                    Typ    => Get_Typ (Borrowed_End));
               Path := First_Actual (Path);
            end;

         --  If Path is a 'Access attribute, return Result.all.

         elsif Nkind (Path) = N_Attribute_Reference then
            pragma Assert (Attribute_Name (Path) = Name_Access);

            Result :=
              New_Pointer_Value_Access
                (Ada_Node => Path,
                 E        => Etype (Path),
                 Name     => Result,
                 Domain   => EW_Term);

            Path := Prefix (Path);

         --  If Path is a variable, the computation is over, return.

         elsif Nkind (Path) in N_Identifier | N_Expanded_Name then
            exit;

         --  For other composants of paths (selected components, indexed
         --  components...) reuse Shift_Rvalue to construct an update from
         --  an access.

         else
            Shift_Rvalue
              (N           => Path,
               Expr        => Result,
               Last_Access => Dummy,
               Domain      => EW_Term);
         end if;
      end loop;

      Reconstructed := +Result;
   end Compute_Borrow_At_End_Value;

   -----------------------
   -- Compute_Call_Args --
   -----------------------

   function Compute_Call_Args
     (Call      : Node_Id;
      Domain    : EW_Domain;
      Context   : in out Ref_Context;
      Store     : in out W_Statement_Sequence_Id;
      Exc_Exit  : Boolean := False;
      Exc_Store : in out W_Statement_Sequence_Id;
      Params    : Transformation_Params;
      Use_Tmps  : Boolean := False) return W_Expr_Array
   is
      Subp       : constant Entity_Id := Get_Called_Entity_For_Proof (Call);
      More_Reads : constant Flow_Types.Flow_Id_Sets.Set :=
        Get_Globals_From_Specialized_Parameters
          (Get_Specialized_Parameters (Call, Specialized_Call_Params));
      Binders    : constant Item_Array :=
        Compute_Subprogram_Parameters (Subp, Domain, More_Reads);
      Patterns   : Item_Array := Binders;
      Aliasing   : constant Boolean :=
        (Nkind (Call) in N_Procedure_Call_Statement | N_Entry_Call_Statement
         or else
           (Ekind (Subp) = E_Function
            and then Is_Function_With_Side_Effects (Subp)))
        and then
          Get_Aliasing_Status_For_Proof (Call)
          in Possible_Aliasing .. Unchecked;
      --  If aliasing can occur for this subprogram call, we should introduce
      --  intermediate variables for every parameters in order to avoid
      --  crashing inside Why3.

      Call_Through_Access : constant Boolean :=
        Ekind (Subp) = E_Subprogram_Type;
      pragma
        Assert
          (if Call_Through_Access
           then Nkind (Name (Call)) = N_Explicit_Dereference);
      --  Get_Called_Entity returns the profile on calls through access to
      --  subprograms.

   begin
      Localize_Binders (Patterns);

      declare
         Why_Args :
           W_Expr_Array
             (1
              ..
                Item_Array_Length (Binders)
                + (if Call_Through_Access then 1 else 0));
         --  If the call is done through an access-to-subprogram, we need
         --  an additional parameter for the subprogram object.
         Arg_Cnt  : Positive := 1;
         Bind_Cnt : Positive := Binders'First;

         procedure Compute_Param (Formal : Entity_Id; Actual : Node_Id);
         --  Compute a Why expression for each parameter

         -------------------
         -- Compute_Param --
         -------------------

         procedure Compute_Param (Formal : Entity_Id; Actual : Node_Id) is
            Needs_Havoc : constant Boolean :=
              Present (Formal)
              and then Ekind (Formal) = E_Out_Parameter
              and then
                (Obj_Has_Relaxed_Init (Formal)
                 or else Contains_Relaxed_Init_Parts (Etype (Formal)));
            --  In the case of out parameters that are initialized by proof,
            --  the memory used by the callee may not be initialized at
            --  subprogram start, even if the actual was initialized at
            --  subprogram call. We need to havoc out parameters before the
            --  call to simulate the absence of initial value.
            --  NB. This is because flow analysis does not check that we are
            --  not reading the parts with relaxed init of an out parameter in
            --  the precondition.

            Pattern  : Item_Type := Patterns (Bind_Cnt);
            Formal_T : constant W_Type_Id :=
              Get_Why_Type_From_Item (Binders (Bind_Cnt));
            Is_Self  : constant Boolean :=
              Binders (Bind_Cnt).Kind = Concurrent_Self;
            Use_Var  : constant Boolean :=
            --  True if we should use the item for the actual.

            --  On external calls, we need to reconstruct the object if
            --  it is mutable as protected types can be in split form.

               (if Is_Self
                then not Is_External_Call (Call)

                --  Otherwise, we go through the expression if the actual is
                --  not an identifier, if aliasing can occur, if the formal has
                --  asynchronous writers, if it has a "by copy" type and Subp
                --  might raise exceptions, or if the actual should be
                --  havoc'ed.

                else
                  (Present (Actual)
                   and then Is_Simple_Actual (Actual)
                   and then not Aliasing
                   and then not Has_Async_Writers (Direct_Mapping_Id (Formal))
                   and then not Needs_Havoc
                   and then not (Exc_Exit and then By_Copy (Formal))));

            Subdomain   : constant EW_Domain :=
              (if not Is_Self
                 and then
                   (Is_Scalar_Type (Retysp (Etype (Formal)))
                    or else Is_Access_Type (Retysp (Etype (Formal))))
                 and then Domain = EW_Prog
               then EW_Pterm
               else Domain);
            Actual_Expr : W_Expr_Id;
            --  Expression for the actual

            Actual_Tmp : W_Expr_Id;
            --  Temporary identifier to store the actual expression

            Constr_Expr : constant W_Expr_Id :=
              (if Pattern.Kind = DRecord and then Pattern.Constr.Present
               then New_Constrained_Attribute_Expr (Actual, Domain)
               else Why_Empty);
            --  Expression for the constrained attribute of split records

            Valid_Flag : W_Expr_Id :=
              (if Pattern.Valid.Present
               then +New_Valid_Value_For_Type (Etype (Formal))
               else Why_Empty);
            --  Expression for the Valid attribute of potentially invalid
            --  parameters.

            Need_Store : Boolean;
            Index_Map  : Ada_Node_To_Why_Id.Map;
            --  Map for the identifiers used to store the values of the
            --  potential indexes from Actual before the call. They are used to
            --  generate bindings for these expressions before the call. This
            --  is necessary as the call could modify variables referenced from
            --  these expressions.

         begin
            --  Emit a warning stating the proof enforces initialization of
            --  mutable discriminants if relevant.

            if not Is_Self
              and then Ekind (Formal) = E_Out_Parameter
              and then Has_Mutable_Discriminants (Etype (Formal))
              and then Expr_Has_Relaxed_Init (Actual)
            then
               Warning_Msg_N (Warn_Relaxed_Init_Mutable_Discr, Actual);
            end if;

            --  Compute the expression for the actual

            if Is_Self then
               Actual_Expr :=
                 (if Is_External_Call (Call)
                  then
                    Transform_Expr
                      (Prefix (SPARK_Atree.Name (Call)),
                       Formal_T,
                       Domain,
                       Params)
                  elsif Self_Is_Mutable
                  then
                    New_Deref (Right => Self_Name, Typ => Get_Typ (Self_Name))
                  else +Self_Name);

            --  If both the formal and the actual parameter are potentially
            --  invalid, get both the expression and the valid flag from the
            --  actual at once.

            elsif Pattern.Valid.Present
              and then Is_Potentially_Invalid_Expr (Actual)
            then
               Actual_Expr :=
                 Transform_Potentially_Invalid_Expr
                   (Expr          => Actual,
                    Expected_Type => Formal_T,
                    Domain        => Domain,
                    Params        => Params,
                    Context       => Context,
                    Valid_Flag    => Valid_Flag,
                    No_Checks     => Ekind (Formal) = E_Out_Parameter);

            --  The translation of the Actual is done in the Prog domain
            --  to generate checks inside the expression. The conversion to
            --  the formal type is done in the EW_Pterm domain for scalars
            --  and pointers to avoid range and null exclusion checks. In
            --  all cases, we do not introduce initialization checks but for
            --  the top-level discriminants of a record with mutable
            --  discriminants, as discriminants can be read by the call as
            --  per the SPARK RM.

            elsif Ekind (Formal) = E_Out_Parameter then
               Actual_Expr :=
                 Insert_Checked_Conversion
                   (Ada_Node => Actual,
                    Domain   => Subdomain,
                    Expr     =>
                      Insert_Top_Level_Init_Check
                        (Ada_Node => Actual,
                         E        => Etype (Actual),
                         Name     =>
                           Transform_Expr
                             (Expr              => Actual,
                              Domain            => Domain,
                              Params            => Params,
                              No_Init_Check     => True,
                              No_Validity_Check => True),
                         Domain   => Domain,
                         Do_Check => not Is_Access_Type (Etype (Actual)),
                         Details  =>
                           "mutable discriminants of actual parameters of mode"
                           & " OUT need to be initialized prior to the call"),
                    To       => Formal_T,
                    No_Init  => True);

            --  No value is provided for specialized actuals, as the
            --  parameter is hardcoded in the translation. Unit is provided
            --  instead. We still emit LSP checks if we are in the program
            --  domain.

            elsif Is_Specialized_Actual (Actual, Specialized_Call_Params) then
               Actual_Expr :=
                 (if Domain = EW_Prog
                  then
                    +Sequence
                       (Ada_Node => Actual,
                        Left     =>
                          Checks_For_Subp_Conversion
                            (Ada_Node   => Actual,
                             From       =>
                               (if Nkind (Actual) = N_Attribute_Reference
                                then Entity (Prefix (Actual))
                                else
                                  Specialized_Call_Params.Element
                                    (Entity (Actual))),
                             To         => Etype (Formal),
                             Params     => Params,
                             As_Closure => True),
                        Right    => +Void)
                  else W_Expr_Id'(+Void));

            --  Otherwise, directly use the expected type for the conversion

            else
               Actual_Expr :=
                 Transform_Expr
                   (Expr          => Actual,
                    Domain        => Domain,
                    Params        => Params,
                    Expected_Type => Formal_T);
            end if;

            --  Store the converted actual into a temporary constant to avoid
            --  computing it several times. It also ensures that checks are
            --  emitted even if the expression happens to not be used.
            --  If the formal is not mutable, we do not need a temporary for
            --  the expression as it will be used exactly once, unless the
            --  computed arguments will be reused (Use_Tmps is True).
            --  We don't need a temporary for the self reference of protected
            --  objects is the call is internal.

            if (Item_Is_Mutable (Pattern) or else Use_Tmps)
              and then (not Is_Self or else Is_External_Call (Call))
            then
               declare
                  Tmp_Id : constant W_Identifier_Id :=
                    New_Temp_Identifier
                      (Ada_Node  => Get_Ada_Node (+Actual_Expr),
                       Typ       => Get_Type (Actual_Expr),
                       Base_Name => "compl");
               begin
                  Actual_Tmp := +Tmp_Id;
                  Context.Append
                    (Ref_Type'
                       (Mutable => False,
                        Name    => Tmp_Id,
                        Value   => Actual_Expr));
               end;
            else
               Actual_Tmp := Actual_Expr;
            end if;

            --  Handle the initialization flag. This flag is only present for
            --  out parameters. In general, we initialize it to any boolean as
            --  the initialization is not preserved on entry for out
            --  parameters. We never try to reuse the reference for the
            --  initialization flag of the actual. Indeed, as per Ada's rules,
            --  the top-level init flag of an out parameter is always True on
            --  exit, so we can assign it directly.

            if Pattern.Init.Present then
               Context.Append
                 (Ref_Type'
                    (Mutable => True,
                     Name    => Pattern.Init.Id,
                     Value   =>
                       New_Any_Expr
                         (Return_Type => EW_Bool_Type,
                          Labels      => Symbol_Sets.Empty_Set)));
               Why_Args (Arg_Cnt) := +Pattern.Init.Id;
               Arg_Cnt := Arg_Cnt + 1;
            end if;

            --  Handle the valid flag if any. Do not try to reuse the reference
            --  for the valid flag of the actual.

            if Pattern.Valid.Present then
               if not Item_Is_Mutable (Pattern) then
                  Why_Args (Arg_Cnt) := +Valid_Flag;

               else
                  Context.Append
                    (Ref_Type'
                       (Mutable => True,
                        Name    => Pattern.Valid.Id,
                        Value   => +Valid_Flag));
                  Why_Args (Arg_Cnt) := +Pattern.Valid.Id;
               end if;

               Arg_Cnt := Arg_Cnt + 1;
            end if;

            --  For variable formals, we try to reuse parts of the actual for
            --  the variable parts of the formal if we can.

            if Use_Var and then Item_Is_Mutable (Pattern) then
               declare
                  Actual_Binder : constant Item_Type :=
                    (if Binders (Bind_Cnt).Kind = Concurrent_Self
                     then
                       Item_Type'
                         (Kind     => Concurrent_Self,
                          Init     => <>,
                          Is_Moved => <>,
                          Valid    => <>,
                          Local    => True,
                          Main     =>
                            (B_Name  => Self_Name,
                             Mutable => Self_Is_Mutable,
                             others  => <>))
                     else
                       Ada_Ent_To_Why.Element (Symbol_Table, Entity (Actual)));
               begin
                  Get_Item_From_Var
                    (Pattern    => Pattern,
                     Var        => Actual_Binder,
                     Expr       => Actual_Tmp,
                     Context    => Context,
                     Args       => Why_Args (Arg_Cnt .. Why_Args'Length),
                     Need_Store => Need_Store);
               end;

            --  Otherwise, we create new references and initialize them from
            --  Actual_Tmp.

            else
               Get_Item_From_Expr
                 (Pattern     => Pattern,
                  Expr        => Actual_Tmp,
                  Context     => Context,
                  Args        => Why_Args (Arg_Cnt .. Why_Args'Length),
                  Constr_Expr => Constr_Expr,
                  Need_Store  => Need_Store);
            end if;

            --  If necessary, we havoc the references so that out parameters
            --  are never considered to be initialized.

            if Needs_Havoc then

               --  For records, we only need to havoc the reference for Fields.
               --  It is the first reference if there is one.

               if Pattern.Kind /= DRecord or else Pattern.Fields.Present then
                  Context.Append
                    (Ref_Type'
                       (Mutable => False,
                        Name    =>
                          New_Temp_Identifier
                            (Typ => EW_Unit_Type, Base_Name => "havoc"),
                        Value   => +New_Havoc_Call (+Why_Args (Arg_Cnt))));
               end if;
            end if;

            --  Populate the Index_Map with a mapping per index in Actual.
            --  Add the bindings to Context.

            if not Is_Self
              and then Need_Store
              and then not Is_Null_Owning_Access (Actual)
            then
               --  Do not generate checks for Expr, they have already
               --  been generated when transforming the actual.

               Collect_Index_Expressions
                 (Actual, Term_Domain (Domain), Params, Context, Index_Map);
            end if;

            --  If the item is mutable, compute in Store the statements to
            --  store the content of the temporaries back into the actual.
            --  If the actual is NULL, do not attempt to store the value back
            --  after the call. Use the Index_Map so the indexes used for the
            --  store are computed before the call.

            if Item_Is_Mutable (Pattern)
              and then not Is_Null_Owning_Access (Actual)
            then
               declare
                  Actual_Or_Self : constant Opt_N_Subexpr_Id :=
                    (if Is_Self and then Is_External_Call (Call)
                     then Prefix (SPARK_Atree.Name (Call))
                     else Actual);
                  No_Pred_Checks : constant Boolean :=
                    Is_Self
                    or else
                      Eq_Base (Type_Of_Node (Actual), Type_Of_Node (Formal));
                  Ext_Visible    : constant Boolean :=
                    Has_Extensions_Visible (Subp)
                    or else
                      (not Is_Self
                       and then Is_Class_Wide_Type (Etype (Formal)))
                    or else
                      (not Is_Self
                       and then Nkind (Call) in N_Subprogram_Call
                       and then Present (Controlling_Argument (Call))
                       and then Is_Controlling_Actual (Actual));

               begin
                  Compute_Store
                    (Pattern        => Pattern,
                     Actual         => Actual_Or_Self,
                     Need_Store     => Need_Store,
                     No_Pred_Checks => No_Pred_Checks,
                     Pre_Expr       => +Actual_Tmp,
                     Store          => Store,
                     Params         => Params,
                     Index_Map      => Index_Map,
                     Ext_Visible    => Ext_Visible);

                  --  Also append the store to the exception handler if any

                  if Exc_Exit then

                     --  The store of the self parameter is done as for normal
                     --  return.

                     if No (Formal) then
                        Compute_Store
                          (Pattern        => Pattern,
                           Actual         => Actual_Or_Self,
                           Need_Store     => Need_Store,
                           No_Pred_Checks => No_Pred_Checks,
                           Pre_Expr       => +Actual_Tmp,
                           Store          => Exc_Store,
                           Params         => Params,
                           Index_Map      => Index_Map,
                           Ext_Visible    => Ext_Visible);
                     else
                        Compute_Exceptional_Store
                          (Formal         => Formal,
                           Pattern        => Pattern,
                           Actual         => Actual_Or_Self,
                           Need_Store     => Need_Store,
                           No_Pred_Checks => No_Pred_Checks,
                           Pre_Expr       => +Actual_Tmp,
                           Store          => Exc_Store,
                           Params         => Params,
                           Index_Map      => Index_Map,
                           Ext_Visible    => Ext_Visible);
                     end if;
                  end if;
               end;
            end if;

            Arg_Cnt :=
              Arg_Cnt
              + Item_Array_Length
                  ((1 => Pattern), Ignore_Init_And_Valid => True);

            Bind_Cnt := Bind_Cnt + 1;
         end Compute_Param;

         procedure Iterate_Call is new Iterate_Call_Parameters (Compute_Param);

      begin
         --  For calls through subprogram types, add the subprogram object as
         --  an additional parameter.

         if Call_Through_Access then
            Why_Args (Arg_Cnt) :=
              New_Subprogram_Value_Access
                (Ada_Node => Name (Call),
                 Ty       => Retysp (Etype (Prefix (Name (Call)))),
                 Expr     =>
                   Transform_Expr
                     (Expr   => Prefix (Name (Call)),
                      Domain => Domain,
                      Params => Params),
                 Domain   => Domain);
            Arg_Cnt := Arg_Cnt + 1;
         end if;

         --  If there are no source parameters, add a void parameter and return

         if Binders'Length = 0 then
            return Why_Args & (1 => +Void);
         end if;

         --  In the case of protected subprograms, there is an invisible first
         --  parameter, the protected object itself. We call "Compute_Arg" with
         --  empty arguments to process this case.

         if Need_Self_Binder (Subp) then
            Compute_Param (Empty, Empty);
         end if;

         --  If the call is an operator, directly call Compute_Param on each of
         --  its operands.

         if Nkind (Call) in N_Op then
            declare
               Formal : Entity_Id := First_Formal (Subp);

            begin
               if Nkind (Call) in N_Binary_Op then
                  Compute_Param (Formal, Left_Opnd (Call));
                  Next_Formal (Formal);
               end if;

               Compute_Param (Formal, Right_Opnd (Call));
            end;

         --  Otherwise, iterate through the call parameters

         else
            Iterate_Call (Call);
         end if;

         --  Get values for global inputs of functions

         if Arg_Cnt <= Why_Args'Last then
            Why_Args (Arg_Cnt .. Why_Args'Last) :=
              Get_Logic_Args (Subp, Params.Ref_Allowed, More_Reads);
         end if;

         --  We collect all overlay aliases of any global outputs of the
         --  call and add to Store and Handler a call to havoc them.

         declare
            Call_Outputs : Node_Sets.Set;
            Read_Ids     : Flow_Types.Flow_Id_Sets.Set;
            Write_Ids    : Flow_Types.Flow_Id_Sets.Set;

         begin
            --  We compute the global outputs of the procedure call in
            --  Call_Outputs.

            Flow_Utility.Get_Proof_Globals
              (Subprogram      => Subp,
               Reads           => Read_Ids,
               Writes          => Write_Ids,
               Erase_Constants => True);

            for Write_Id of Write_Ids loop
               case Write_Id.Kind is
                  when Direct_Mapping =>
                     declare
                        Obj : constant Entity_Id :=
                          Get_Direct_Mapping_Id (Write_Id);
                     begin
                        if Is_Object (Obj) then
                           Call_Outputs.Insert (Obj);
                        end if;
                     end;

                  when others         =>
                     null;
               end case;
            end loop;
         end;

         return Why_Args;
      end;
   end Compute_Call_Args;

   ---------------------------
   -- Compute_Default_Check --
   ---------------------------

   function Compute_Default_Check
     (Ada_Node         : Node_Id;
      Ty               : Type_Kind_Id;
      Params           : Transformation_Params;
      At_Declaration   : Boolean := False;
      Include_Subtypes : Boolean := False) return W_Prog_Id
   is

      function Compute_Default_Check_Rec
        (Ada_Node         : Node_Id;
         Ty               : Type_Kind_Id;
         Include_Subtypes : Boolean := False;
         At_Declaration   : Boolean := False) return W_Prog_Id;
      --  Recursively traverse the type to generate the checks

      -------------------------------
      -- Compute_Default_Check_Rec --
      -------------------------------

      function Compute_Default_Check_Rec
        (Ada_Node         : Node_Id;
         Ty               : Type_Kind_Id;
         Include_Subtypes : Boolean := False;
         At_Declaration   : Boolean := False) return W_Prog_Id
      is
         --  If Ty's fullview is in SPARK, go to its underlying type to check
         --  its kind.
         Ty_Ext    : constant Entity_Id := Retysp (Ty);
         Priv_Base : constant Entity_Id := Partial_Base_Type (Ty);

         Checks  : W_Prog_Id := +Void;
         Tmp_Exp : W_Identifier_Id := Why_Empty;
         --  Temporary variable for the type instance of Ty_Ext

         Post : W_Pred_Id := True_Pred;
         --  Post used for the assignment of tmp_exp

         Discrs : constant Natural := Count_Discriminants (Ty_Ext);
         Tmps   : W_Identifier_Array (1 .. Discrs);
         Binds  : W_Prog_Array (1 .. Discrs);
         --  Arrays to store the bindings for discriminants

      begin
         --  If Ty has discriminants, first fill the bindings for them

         Ada_Ent_To_Why.Push_Scope (Symbol_Table);

         if Discrs > 0 then
            Tmp_Exp := New_Temp_Identifier (Ty_Ext, EW_Abstract (Ty_Ext));

            declare
               Discr : Node_Id := First_Discriminant (Ty_Ext);
               Elmt  : Elmt_Id :=
                 (if Is_Constrained (Ty_Ext)
                  then First_Elmt (Discriminant_Constraint (Ty_Ext))
                  else No_Elmt);
               I     : Positive := 1;

            begin
               --  Go through discriminants to create the bindings for
               --  let tmp1 = Discr1.default in <if Ty_Ext is unconstrained>
               --  let tmp1 = Discr1 in         <if Ty_Ext is constrained>
               --  Also fills Post with { result.discr1 = tmp1 /\ .. }

               while Present (Discr) loop
                  Tmps (I) :=
                    New_Temp_Identifier (Discr, Type_Of_Node (Etype (Discr)));

                  Insert_Tmp_Item_For_Entity (Discr, Tmps (I));

                  --  Store constrained value of discriminants

                  if Is_Constrained (Ty_Ext) then
                     Binds (I) :=
                       Transform_Prog
                         (Expr          => Node (Elmt),
                          Expected_Type => Type_Of_Node (Etype (Discr)),
                          Params        => Params);
                     Next_Elmt (Elmt);

                  --  Store default value of discriminants for unconstrained
                  --  record types with default discriminants.

                  elsif not Include_Subtypes then
                     pragma Assert (Has_Defaulted_Discriminants (Ty_Ext));

                     Binds (I) :=
                       Transform_Prog
                         (Expr          => Discriminant_Default_Value (Discr),
                          Expected_Type => Type_Of_Node (Etype (Discr)),
                          Params        => Params);
                  else
                     Binds (I) :=
                       New_Any_Statement
                         (Post        =>
                            Compute_Dynamic_Invariant
                              (Expr        =>
                                 +New_Result_Ident
                                    (Type_Of_Node (Etype (Discr))),
                               Ty          => Etype (Discr),
                               Initialized => True_Term,
                               Params      => Body_Params),
                          Return_Type => Type_Of_Node (Etype (Discr)));
                  end if;

                  --  Add new Equality tmp = result.discr to Post

                  Post :=
                    New_And_Pred
                      (Left  => Post,
                       Right =>
                         New_Comparison
                           (Symbol => Why_Eq,
                            Left   => +Tmps (I),
                            Right  =>
                              Insert_Simple_Conversion
                                (Expr =>
                                   New_Ada_Record_Access
                                     (Name  =>
                                        +New_Result_Ident
                                           (EW_Abstract (Ty_Ext)),
                                      Field => Discr,
                                      Ty    => Ty_Ext),
                                 To   => Type_Of_Node (Etype (Discr)))));

                  Next_Discriminant (Discr);
                  I := I + 1;
               end loop;
            end;
         end if;

         --  If Ty is checked at declaration, do not recheck its predicate
         --  at use.

         if (At_Declaration or else not Needs_Default_Checks_At_Decl (Ty_Ext))
           and then Needs_Default_Predicate_Checks (Ty_Ext)
         then
            declare
               W_Typ : constant W_Type_Id :=
                 EW_Abstract
                   (Ty_Ext, Relaxed_Init => Has_Relaxed_Init (Ty_Ext));
               --  Even if we are checking the default initialization of an
               --  object with relaxed initialization, we only assume for
               --  checking the predicate that the value may have relaxed
               --  initialization if the type itself is marked with relaxed
               --  init. Indeed, otherwise, the predicate assumes complete
               --  initialization.

               Tmp_Exp : constant W_Identifier_Id :=
                 New_Temp_Identifier (Ty_Ext, W_Typ);
               --  Temporary variable for tmp_exp

               --  Create a value of type Ty_Ext that respects the default
               --  initialization value for Ty_Ext, except its default
               --  initial condition when specified. Since we use an
               --  any-expr, the predicate needs to apply to the special
               --  "result" term.

               Default_Init_Pred : constant W_Pred_Id :=
                 Compute_Default_Init
                   (Expr             => +New_Result_Ident (W_Typ),
                    Ty               => Ty_Ext,
                    Params           => Params,
                    Include_Subtypes => Include_Subtypes,
                    Skip_Last_Cond   => True_Term);
               --  DICs are checked assuming that the predicate holds, so we
               --  cannot blindly assume all DICs here.

               DICs : constant W_Pred_Id :=
                 All_DICs_But_Last (Ty_Ext, +New_Result_Ident (W_Typ), Params);
               --  Assume all default initial conditions but the top-level one
               --  if any. If there is an inherited DIC applying to a type
               --  with a predicate, the predicate will be checked when
               --  checking the type itself.

               Default_Init_Prog : constant W_Prog_Id :=
                 New_Any_Expr
                   (Ada_Node    => Ty_Ext,
                    Labels      => Symbol_Sets.Empty_Set,
                    Post        =>
                      New_And_Pred (Left => Default_Init_Pred, Right => DICs),
                    Return_Type => W_Typ);

               --  Generate the predicate check, specifying that it applies
               --  to the default value of a type, so that a special VC kind
               --  is used for better messages.

               Pred_Check : constant W_Prog_Id :=
                 New_Predicate_Check
                   (Ada_Node         => Ada_Node,
                    Ty               => Ty_Ext,
                    W_Expr           => +Tmp_Exp,
                    On_Default_Value => True);

            begin
               Append
                 (Checks,
                  New_Ignore
                    (Prog =>
                       New_Typed_Binding
                         (Name    => Tmp_Exp,
                          Def     => Default_Init_Prog,
                          Context => Pred_Check)));
            end;
         end if;

         --  Default checks for private types are done at declaration

         if not At_Declaration
           and then
             Ekind (Priv_Base) in E_Private_Type | E_Limited_Private_Type
           and then not Has_Unknown_Discriminants (Priv_Base)
         then
            null;

         elsif Is_Scalar_Type (Ty_Ext) then
            if Has_Default_Aspect (Ty_Ext) then
               declare
                  Default_Expr : constant W_Expr_Id :=
                    Transform_Expr
                      (Expr          => Default_Aspect_Value (Ty_Ext),
                       Expected_Type => Base_Why_Type (Ty_Ext),
                       Domain        => EW_Prog,
                       Params        => Params);

                  --  Do not check predicate of default value, it will be done
                  --  later.

                  Range_Check : constant W_Expr_Id :=
                    Insert_Scalar_Conversion
                      (Domain     => EW_Prog,
                       Ada_Node   => Default_Aspect_Value (Ty_Ext),
                       Expr       => Default_Expr,
                       To         => Type_Of_Node (Ty_Ext),
                       Range_Type => Ty_Ext,
                       Check_Kind => RCK_Range,
                       Skip_Pred  => True);
               begin
                  Append (Checks, +Range_Check);
               end;
            end if;

         elsif Is_Array_Type (Ty_Ext)
           and then Ekind (Ty_Ext) /= E_String_Literal_Subtype
         then
            pragma Assert (Is_Constrained (Ty_Ext) or else Include_Subtypes);

            --  Generates:
            --  length (Index_Type1) > 0 /\ .. ->
            --    Default_Component_Value         <if any>
            --    default_checks (Component_Type) <otherwise>

            declare
               Range_Expr : W_Prog_Id := True_Prog;
               Num_Dim    : constant Positive :=
                 Positive (Number_Dimensions (Ty_Ext));
               T_Comp     : W_Prog_Id;

            begin
               --  Generate the condition length (Index_Type1) > 0 /\ ..

               if Is_Constrained (Ty_Ext) then
                  for Dim in 1 .. Num_Dim loop
                     Range_Expr :=
                       New_And_Prog
                         (Left  => Range_Expr,
                          Right =>
                            New_Comparison
                              (Symbol => Int_Infix_Gt,
                               Left   =>
                                 +Build_Length_Expr
                                    (Domain => EW_Prog,
                                     Ty     => Ty_Ext,
                                     Dim    => Dim),
                               Right  =>
                                 New_Integer_Constant (Empty, Uint_0)));
                  end loop;
               end if;

               --  Generate the check for the default value of Component_Type
               --    Default_Component_Value         <if any>
               --    default_checks (Component_Type) <otherwise>

               --  If Ty_Ext has a Default_Component_Value aspect, use it

               if Has_Default_Aspect (Ty_Ext) then
                  T_Comp :=
                    Transform_Prog
                      (Expr          =>
                         Default_Aspect_Component_Value (Ty_Ext),
                       Expected_Type => Type_Of_Node (Component_Type (Ty_Ext)),
                       Params        => Params);

               --  Otherwise, use its Component_Type default value

               else
                  Continuation_Stack.Append
                    (Continuation_Type'
                       (Ada_Node => Component_Type (Ty_Ext),
                        Message  =>
                          To_Unbounded_String
                            ("in default initialization of array component")));
                  T_Comp :=
                    Compute_Default_Check_Rec
                      (Ada_Node => Ada_Node, Ty => Component_Type (Ty_Ext));
                  Continuation_Stack.Delete_Last;
               end if;

               if T_Comp /= +Void then
                  T_Comp :=
                    New_Conditional
                      (Ada_Node  => Ty_Ext,
                       Condition => Range_Expr,
                       Then_Part =>
                         New_Ignore (Component_Type (Ty_Ext), T_Comp));

                  Append (Checks, T_Comp);
               end if;
            end;

         elsif Is_Record_Type_In_Why (Ty_Ext) then

            --  Go through other fields to create the expression
            --  (check_for_f1 expr ->
            --     Field1.default                  <if Field1 has a default>
            --     default_check (Etype (Field1))) <otherwise>
            --  /\ ..
            --  Components of protected types are checked when generating VCs
            --  for the protected type.
            --  If At_Declaration is False, do not generate checks for
            --  components of private types (if they can be default
            --  initialized). For private extension, do not generate checks for
            --  visibly inherited components.
            --  Do not generate checks for hidden components, they will be
            --  checked at the place where they are hidden.

            declare
               Is_Priv_Ext : constant Boolean :=
                 Ekind (Priv_Base) = E_Record_Type_With_Private
                 and then not Has_Unknown_Discriminants (Priv_Base);
               --  True if Priv_Base is a private type extension whose hidden
               --  components are checked at declaration.

               Comp_In_Ext : Boolean;
               Checks_Seq  : W_Statement_Sequence_Id := Void_Sequence;
               T_Comp      : W_Prog_Id;

            begin
               if not Is_Concurrent_Type (Ty_Ext) then
                  for Field of Get_Component_Set (Ty_Ext) loop

                     --  Field is hidden in the extension if either Priv_Base
                     --  does not visibly derive from anything or Field is
                     --  not present in Priv_Base's parent.

                     Comp_In_Ext :=
                       Base_Retysp (Parent_Type (Priv_Base))
                       = Base_Retysp (Priv_Base)
                       or else
                         No
                           (Search_Component_In_Type
                              (Parent_Type (Priv_Base), Field));

                     --  In private extension, if At_Declaration is True
                     --  consider fields hidden in the extension, otherwise
                     --  consider visible fields.

                     if Component_Is_Visible_In_Type (Ty_Ext, Field)
                       and then
                         (not Is_Priv_Ext or else Comp_In_Ext = At_Declaration)
                     then
                        if Present (Expression (Enclosing_Declaration (Field)))
                        then

                           --  If Field has a default expression, use it

                           declare
                              F_Ty   : constant Entity_Id := Etype (Field);
                              Exp_Ty : constant W_Type_Id :=
                                (if Is_Scalar_Type (F_Ty)
                                 then Type_Of_Node (F_Ty)
                                 else
                                   EW_Abstract
                                     (F_Ty, Has_Relaxed_Init (F_Ty)));
                              --  For scalar types, if we have a value, it is
                              --  initialized. Otherwise we only expect a
                              --  partially initialized type if the type of the
                              --  is marked with Relaxed_Initialization.

                           begin
                              T_Comp :=
                                Transform_Prog
                                  (Expr          =>
                                     Expression
                                       (Enclosing_Declaration (Field)),
                                   Expected_Type => Exp_Ty,
                                   Params        => Params);
                           end;

                        --  Otherwise, use its Field's Etype default value

                        else
                           Continuation_Stack.Append
                             (Continuation_Type'
                                (Ada_Node => Field,
                                 Message  =>
                                   To_Unbounded_String
                                     ("in default initialization of "
                                      & "component "
                                      & Pretty_Source_Name (Field))));
                           T_Comp :=
                             Compute_Default_Check_Rec
                               (Ada_Node => Field, Ty => Etype (Field));
                           Continuation_Stack.Delete_Last;
                        end if;

                        if T_Comp /= +Void then
                           T_Comp :=
                             New_Ignore
                               (Ada_Node => Etype (Field), Prog => T_Comp);

                           --  Check values of record fields only if they
                           --  are in the proper variant part.

                           if Discrs > 0 then
                              T_Comp :=
                                New_Conditional
                                  (Condition =>
                                     New_Ada_Record_Check_For_Field
                                       (Empty, +Tmp_Exp, Field, Ty_Ext),
                                   Then_Part => T_Comp);
                           end if;

                           Append (Checks_Seq, T_Comp);
                        end if;
                     end if;
                  end loop;

                  Append (Checks, +Checks_Seq);
               end if;
            end;
         elsif Is_Access_Type (Ty_Ext) and then Can_Never_Be_Null (Ty_Ext) then
            Append
              (Checks,
               New_Located_Assert
                 (Ada_Node => Ada_Node,
                  Pred     => False_Pred,
                  Reason   => VC_Null_Exclusion,
                  Kind     => EW_Assert));
         end if;

         --  If Ty has a DIC and this DIC should be checked at use (it does
         --  not reference the current type instance), check that there is
         --  no runtime error in the DIC and that the DIC holds. The checks
         --  are inserted before Checks.

         if Has_DIC (Ty_Ext) then
            Check_Or_Assume_All_DICs_At_Use
              (Ada_Node,
               Ty_Ext,
               +Tmp_Exp,
               Params,
               Checks,
               Check => not At_Declaration);
         end if;

         --  If Ty has discriminants, introduce the necessary let bindings:
         --  let tmp1 = Discr1.default in <if Ty_Ext is unconstrained>
         --  let tmp1 = Discr1 in         <if Ty_Ext is constrained>
         --  let expr = any <type> ensures { expr.discr1 = tmp1 .. } in
         --    <Checks>

         if Discrs > 0 then

            --  Create bindings for Tmp_Exp
            --  let expr = any <type> ensures { expr.discr1 = tmp1 .. } in

            if Checks /= +Void then
               Checks :=
                 New_Typed_Binding
                   (Name    => Tmp_Exp,
                    Def     =>
                      New_Any_Expr
                        (Ada_Node    => Ty_Ext,
                         Labels      => Symbol_Sets.Empty_Set,
                         Post        => Post,
                         Return_Type => EW_Abstract (Ty_Ext)),
                    Context => Checks);

            end if;

            --  Generate the bindings if we have some fields to check or if
            --  we need to check the bindings themselves.

            if Checks /= +Void or else not Is_Constrained (Ty_Ext) then
               for I in 1 .. Discrs loop
                  Checks :=
                    New_Typed_Binding
                      (Name => Tmps (I), Def => Binds (I), Context => Checks);
               end loop;
            end if;
         end if;

         Ada_Ent_To_Why.Pop_Scope (Symbol_Table);

         return Checks;
      end Compute_Default_Check_Rec;

      Msg    : constant String :=
        "in default value"
        & (if At_Declaration
           then " of private type"
           elsif Nkind (Ada_Node) = N_Component_Association
           then " of box association"
           else "");
      --  If At_Declaration is True, we are checking the default initialization
      --  of a private type. If the Ada node is a component association, then
      --  we are checking a box association.
      Checks : W_Prog_Id;

      --  Start of processing for Compute_Default_Check

   begin
      Continuation_Stack.Append
        (Continuation_Type'
           (Ada_Node => Ada_Node, Message => To_Unbounded_String (Msg)));
      Checks :=
        Compute_Default_Check_Rec
          (Ada_Node         => Ada_Node,
           Ty               => Ty,
           Include_Subtypes => Include_Subtypes,
           At_Declaration   => At_Declaration);
      Continuation_Stack.Delete_Last;
      return Checks;
   end Compute_Default_Check;

   --------------------------
   -- Compute_Default_Init --
   --------------------------

   function Compute_Default_Init
     (Expr             : W_Term_Id;
      Ty               : Type_Kind_Id;
      Params           : Transformation_Params := Body_Params;
      Skip_Last_Cond   : W_Term_Id := False_Term;
      Use_Pred         : Boolean := True;
      Include_Subtypes : Boolean := False) return W_Pred_Id
   is

      Ty_Ext : constant Entity_Id := Retysp (Ty);

      function Default_Init_For_Comp
        (C_Expr : W_Term_Id; C_Ty : Entity_Id; Idx : W_Expr_Array)
         return W_Pred_Id
      with Pre => Is_Type (C_Ty);
      --  @param C_Expr expression for an array component
      --  @param C_Ty array component type
      --  @return predicate for individual array components
      --    <C_Expr> = <Default_Component_Value>  <if Ty has a default aspect>
      --    default_init (<C_Expr>), C_Ty)        <otherwise>

      function Default_Init_For_Field
        (F_Expr : W_Term_Id; F_Ty : Entity_Id; E : Entity_Id) return W_Pred_Id
      with
        Pre =>
          Is_Type (F_Ty)
          and then
            (Ekind (E) = E_Component
             or else Is_Type (E)
             or else Is_Part_Of_Protected_Object (E));
      --  @param F_Expr expression for the component
      --  @param F_Ty component type
      --  @param E node for a record component
      --  @return predicate for individual record components
      --   F_Expr = E.def               <if Field1 has a default>
      --   default_init (F_Expr, F_Ty)) <otherwise>

      function Default_Init_Absent_Field
        (F_Expr : W_Term_Id; F_Ty : Entity_Id; E : Entity_Id) return W_Pred_Id;
      --  Assume that components not present in discriminated records have a
      --  dummy value.

      function Default_Init_For_Discr
        (D_Expr : W_Term_Id; D_Ty : Entity_Id; E : Entity_Id) return W_Pred_Id
      with Pre => Is_Type (D_Ty) and then Ekind (E) = E_Discriminant;
      --  @param D_Expr expression for the discrimiant
      --  @param D_Ty discriminant type
      --  @param E node for a discriminant
      --  @return predicate for individual discrimiant
      --  D_Expr = E.default             <if Ty_Ext is unconstrained>
      --  D_Expr = stored_constraint (E) <otherwise>

      -------------------------------
      -- Default_Init_Absent_Field --
      -------------------------------

      function Default_Init_Absent_Field
        (F_Expr : W_Term_Id; F_Ty : Entity_Id; E : Entity_Id) return W_Pred_Id
      is
         pragma Unreferenced (E);
         Dummy_Expr : W_Term_Id := +Why_Default_Value (EW_Term, F_Ty);

      begin
         if Is_Init_Wrapper_Type (Get_Type (+F_Expr)) then
            Dummy_Expr :=
              Insert_Simple_Conversion
                (Expr => Dummy_Expr, To => Get_Type (+F_Expr));
         end if;

         return
           New_Comparison
             (Symbol => Why_Eq, Left => F_Expr, Right => Dummy_Expr);
      end Default_Init_Absent_Field;

      ---------------------------
      -- Default_Init_For_Comp --
      ---------------------------

      function Default_Init_For_Comp
        (C_Expr : W_Term_Id; C_Ty : Entity_Id; Idx : W_Expr_Array)
         return W_Pred_Id
      is
         pragma Unreferenced (Idx);
         P : W_Pred_Id;
      begin
         if Has_Default_Aspect (Ty_Ext) then
            pragma Assert (Is_Scalar_Type (C_Ty));
            P :=
              New_Comparison
                (Symbol => Why_Eq,
                 Left   =>
                   Insert_Simple_Conversion
                     (Expr => C_Expr, To => Type_Of_Node (C_Ty)),
                 Right  =>
                   Transform_Term
                     (Expr          => Default_Aspect_Component_Value (Ty_Ext),
                      Expected_Type => Type_Of_Node (C_Ty),
                      Params        => Params));

            --  Assume the value of the initialization flag for init wrappers

            if Is_Init_Wrapper_Type (Get_Type (+C_Expr)) then
               P :=
                 New_And_Pred
                   (Left  => P,
                    Right =>
                      Pred_Of_Boolean_Term
                        (+New_Init_Attribute_Access (C_Ty, +C_Expr)));
            end if;
         else
            P :=
              Compute_Default_Init
                (Expr     => C_Expr,
                 Ty       => C_Ty,
                 Params   => Params,
                 Use_Pred => Use_Pred);
         end if;

         return P;
      end Default_Init_For_Comp;

      ----------------------------
      -- Default_Init_For_Discr --
      ----------------------------

      function Default_Init_For_Discr
        (D_Expr : W_Term_Id; D_Ty : Entity_Id; E : Entity_Id) return W_Pred_Id
      is
      begin
         --  If the type is constrained, get the value of discriminants from
         --  the stored constraints.

         if Has_Discriminants (Ty_Ext) and then Is_Constrained (Ty_Ext) then
            return
              New_Comparison
                (Symbol => Why_Eq,
                 Left   =>
                   Insert_Simple_Conversion
                     (Expr => D_Expr, To => Type_Of_Node (D_Ty)),
                 Right  =>
                   Transform_Term
                     (Params        => Params,
                      Expr          => Get_Constraint_For_Discr (Ty_Ext, E),
                      Expected_Type => Type_Of_Node (D_Ty)));

         --  Default initialized objects of an unconstrained record type have
         --  the discriminant's defaults.

         elsif not Include_Subtypes then
            pragma Assert (Has_Defaulted_Discriminants (Ty_Ext));

            return
              New_Comparison
                (Symbol => Why_Eq,
                 Left   =>
                   Insert_Simple_Conversion
                     (Expr => D_Expr, To => Type_Of_Node (D_Ty)),
                 Right  =>
                   Transform_Term
                     (Expr          => Discriminant_Default_Value (E),
                      Expected_Type => Type_Of_Node (D_Ty),
                      Params        => Params));

         --  Discriminants must be initialized

         else
            return
              Compute_Dynamic_Invariant
                (D_Expr,
                 D_Ty,
                 Initialized => True_Term,
                 Params      => Params,
                 Use_Pred    => Use_Pred);
         end if;
      end Default_Init_For_Discr;

      ----------------------------
      -- Default_Init_For_Field --
      ----------------------------

      function Default_Init_For_Field
        (F_Expr : W_Term_Id; F_Ty : Entity_Id; E : Entity_Id) return W_Pred_Id
      is
         P : W_Pred_Id;

      begin
         --  For fields standing for the invisible private part of a type, we
         --  are only concerned with initialization.

         if Is_Type (E) then

            --  If F_Expr has a wrapper for initialization and the type of
            --  E defines full default initialization, set the init flag to
            --  True.

            if Is_Init_Wrapper_Type (Get_Type (+F_Expr))
              and then
                Default_Initialization (Etype (E))
                = Full_Default_Initialization
            then
               P :=
                 Pred_Of_Boolean_Term
                   (New_Record_Access
                      (Name  => F_Expr,
                       Field => E_Symb (E, WNE_Private_Attr_Init),
                       Typ   => EW_Bool_Type));
            else
               P := True_Pred;
            end if;

         --  if Field has a default expression, use it.
         --   <Expr>.rec__field1 = Field1.default

         --  Access type fields cannot have default initialization. Such fields
         --  should not exist in the Ada declaration.

         elsif Present (Expression (Enclosing_Declaration (E))) then
            declare
               Exp_Ty : constant W_Type_Id :=
                 (if Is_Scalar_Type (F_Ty)
                  then Type_Of_Node (F_Ty)
                  else Get_Type (+F_Expr));
               --  For scalar types, if we have a value, it is initialized.
               --  Otherwise we only expect a partially initialized type if
               --  F_Expr is an initialization wrapper.

            begin
               P :=
                 New_Comparison
                   (Symbol => Why_Eq,
                    Left   =>
                      Insert_Simple_Conversion (Expr => F_Expr, To => Exp_Ty),
                    Right  =>
                      New_Tag_And_Ext_Update
                        (Name =>
                           Transform_Term
                             (Expr          =>
                                Expression (Enclosing_Declaration (E)),
                              Expected_Type => Exp_Ty,
                              Params        => Params),
                         Ty   => F_Ty));

               --  For scalars, assume the value of the initialization flag for
               --  init wrappers.

               if Is_Scalar_Type (F_Ty)
                 and then Is_Init_Wrapper_Type (Get_Type (+F_Expr))
               then
                  P :=
                    New_And_Pred
                      (Left  => P,
                       Right =>
                         Pred_Of_Boolean_Term
                           (+New_Init_Attribute_Access (F_Ty, +F_Expr)));
               end if;
            end;

         --  otherwise, use its Field's Etype default value.
         --   default_init (<Expr>.rec__field1, Etype (Field1)))

         else
            P :=
              Compute_Default_Init
                (F_Expr, F_Ty, Params => Params, Use_Pred => Use_Pred);
         end if;

         return P;
      end Default_Init_For_Field;

      function Default_Init_For_Array is new
        Build_Predicate_For_Array (Default_Init_For_Comp);

      function Default_Init_For_Record is new
        Build_Predicate_For_Record
          (Default_Init_For_Discr,
           Default_Init_For_Field,
           Default_Init_Absent_Field,
           Ignore_Private_State => False);

      Tmp        : constant W_Term_Id := New_Temp_For_Expr (Expr);
      Assumption : W_Pred_Id := True_Pred;
      Variables  : Flow_Id_Sets.Set;

      --  Start of processing for Compute_Default_Init

   begin
      --  If Use_Precomputed_Func is true, then we already have generated a
      --  predicate for the default initial value of elements of type Ty_Ext,
      --  except if the type is an itype or if it is standard boolen.

      if Use_Pred
        and then not Include_Subtypes
        and then not Is_Itype (Ty_Ext)
        and then not Is_Standard_Boolean_Type (Ty_Ext)
        and then not Is_Init_Wrapper_Type (Get_Type (+Expr))
      then
         Variables_In_Default_Init (Ty_Ext, Variables);

         declare
            Vars : constant W_Expr_Array :=
              Get_Args_From_Variables (Variables, Params.Ref_Allowed);

            Num_B : constant Positive := 2 + Vars'Length;
            Args  : W_Expr_Array (1 .. Num_B);

         begin
            Args (1) :=
              Insert_Simple_Conversion
                (Domain => EW_Term,
                 Expr   => +Expr,
                 To     => Type_Of_Node (Ty_Ext));
            Args (2) := +Skip_Last_Cond;
            Args (3 .. Num_B) := Vars;

            return
              New_Call
                (Name => E_Symb (Ty_Ext, WNE_Default_Init),
                 Args => Args,
                 Typ  => EW_Bool_Type);
         end;
      elsif Is_Scalar_Type (Ty_Ext) then
         if Has_Default_Aspect (Ty_Ext) then
            declare
               Default_Expr : constant W_Term_Id :=
                 Transform_Term
                   (Expr          => Default_Aspect_Value (Ty_Ext),
                    Expected_Type => Base_Why_Type (Ty_Ext),
                    Params        => Params);
            begin
               Assumption :=
                 New_Comparison
                   (Symbol => Why_Eq,
                    Left   =>
                      Insert_Simple_Conversion
                        (Ada_Node => Empty,
                         Expr     => Tmp,
                         To       => Base_Why_Type (Ty_Ext)),
                    Right  => Default_Expr);
            end;

            --  If Tmp has a wrapper for initialization, set the init flag
            --  to True.

            if Is_Init_Wrapper_Type (Get_Type (+Tmp)) then
               Assumption :=
                 New_And_Pred
                   (Left  => Assumption,
                    Right =>
                      Pred_Of_Boolean_Term
                        (New_Init_Attribute_Access (Ty_Ext, +Tmp)));
            end if;
         end if;
      elsif Is_Array_Type (Ty_Ext)
        and then Ekind (Ty_Ext) /= E_String_Literal_Subtype
      then

         --  Generates:
         --  forall i1 : int ..
         --   in_range (i1) /\ .. ->
         --    get (<Expr>, i1, ...) = <Default_Component_Value>    <if any>
         --    default_init (get (<Expr>, i1, ...), Component_Type) <otherwise>

         Assumption := Default_Init_For_Array (+Expr, Ty_Ext);

         --  If Ty_Ext is constrained, also assume the array bounds

         if Is_Constrained (Ty_Ext) and then not Is_Static_Array_Type (Ty_Ext)
         then
            Assumption :=
              New_And_Pred
                (Left  => New_Bounds_Equality (Expr, Ty_Ext, Params => Params),
                 Right => Assumption);
         end if;

      elsif Is_Access_Subprogram_Type (Ty_Ext) then
         Assumption :=
           Pred_Of_Boolean_Term
             (New_Record_Access
                (Name  => Expr,
                 Field => M_Subprogram_Access.Rec_Is_Null,
                 Typ   => EW_Bool_Type));

      elsif Is_Access_Type (Ty_Ext) then
         Assumption :=
           Pred_Of_Boolean_Term (New_Pointer_Is_Null_Access (Ty_Ext, Expr));

         if Is_Init_Wrapper_Type (Get_Type (+Expr)) then
            Assumption :=
              New_And_Pred
                (Left  =>
                   Pred_Of_Boolean_Term
                     (New_Init_Attribute_Access (Ty_Ext, Tmp)),
                 Right => Assumption);
         end if;

      elsif Is_Simple_Private_Type (Ty_Ext) then

         --  If Tmp has a wrapper for initialization, set the init flag to True
         --  if the type is fully initialized by default.

         if Is_Init_Wrapper_Type (Get_Type (+Tmp))
           and then
             Default_Initialization (Ty_Ext) = Full_Default_Initialization
         then
            Assumption :=
              New_And_Pred
                (Left  => Assumption,
                 Right =>
                   Pred_Of_Boolean_Term
                     (New_Init_Attribute_Access (Ty_Ext, +Tmp)));
         end if;

      elsif Is_Record_Type_In_Why (Ty_Ext) then

         --  Generates:
         --  let tmp1 = <Expr>.rec__disc1 in
         --   <if Ty_Ext as default discrs>
         --  <Expr>.rec__disc1 = Discr1.default  <if Ty_Ext is unconstrained>
         --  <Expr>.rec__disc1 = Discr1 /\ ..    <if Ty_Ext is constrained>
         --  (check_for_field1 expr ->
         --      <Expr>.rec__field1 = Field1.def      <if Field1 has a default>
         --      default_init (<Expr>.rec__field1, Etype (Field1))) <otherwise>
         --  /\ ..

         --  if Ty_Ext is tagged, generate
         --     <Expr>.attr__tag = <Ty_Ext>.__tag

         --  if Ty_Ext is has relaxed initialization and mutable discriminants,
         --  generate
         --     <Expr>.attr__init = true

         if Is_Tagged_Type (Ty_Ext) then
            Assumption :=
              New_And_Pred
                (Left  =>
                   New_Call
                     (Typ  => EW_Bool_Type,
                      Name => Why_Eq,
                      Args =>
                        (1 =>
                           New_Tag_Access
                             (Ada_Node => Ty,
                              Domain   => EW_Term,
                              Name     => +Tmp,
                              Ty       => Ty_Ext),
                         2 => +E_Symb (Ty_Ext, WNE_Tag))),
                 Right => Assumption);
         end if;

         if Is_Init_Wrapper_Type (Get_Type (+Expr))
           and then Has_Mutable_Discriminants (Ty_Ext)
         then
            Assumption :=
              New_And_Pred
                (Left  =>
                   Pred_Of_Boolean_Term
                     (New_Init_Attribute_Access (Ty_Ext, Tmp)),
                 Right => Assumption);
         end if;

         Assumption :=
           New_And_Pred
             (Left  => Assumption,
              Right => Default_Init_For_Record (Expr, Ty_Ext));
      end if;

      --  If Skip_Last_Cond is False, assume the default initial condition for
      --  Ty, when specified as a boolean expression.

      if Has_DIC (Ty) then
         declare
            procedure Assume_DIC
              (Default_Init_Param : Formal_Kind_Id;
               Default_Init_Expr  : Node_Id)
            with
              Pre =>
                Ekind (Default_Init_Param) = E_In_Parameter
                and then Nkind (Default_Init_Expr) in N_Subexpr;

            ----------------
            -- Assume_DIC --
            ----------------

            procedure Assume_DIC
              (Default_Init_Param : Formal_Kind_Id;
               Default_Init_Expr  : Node_Id)
            is
               Init_Id : constant W_Identifier_Id :=
                 New_Temp_Identifier (Default_Init_Param, Get_Type (+Tmp));
               T       : W_Pred_Id;

            begin
               Ada_Ent_To_Why.Push_Scope (Symbol_Table);

               --  Register the temporary identifier Init_Id for
               --  parameter Init_Param in the symbol table. This ensures
               --  both that a distinct name is used each time
               --  (preventing name capture), and that the type of Tmp is
               --  used as the type used to represent Init_Param
               --  (avoiding type conversion).

               Insert_Tmp_Item_For_Entity (Default_Init_Param, Init_Id);

               --  Transform the default init expression into Why3

               T :=
                 Transform_Pred (Expr => Default_Init_Expr, Params => Params);

               --  Relate the name Init_Id used in the default init
               --  expression to the value Tmp for which the predicate is
               --  checked.

               T :=
                 New_Binding
                   (Name    => Init_Id,
                    Def     => Tmp,
                    Context => T,
                    Typ     => Get_Type (+T));

               --  Only take default init condition into account if
               --  Skip_Last_Cond is False.

               T :=
                 New_Conditional
                   (Condition => +W_Expr_Id'(+Skip_Last_Cond),
                    Then_Part => True_Pred,
                    Else_Part => T,
                    Typ       => EW_Bool_Type);

               Assumption := New_And_Pred (Left => Assumption, Right => T);

               Ada_Ent_To_Why.Pop_Scope (Symbol_Table);
            end Assume_DIC;

            procedure Assume_All_DIC is new
              Iterate_Applicable_DIC (Assume_DIC);
         begin
            Assume_All_DIC (Ty);
         end;
      end if;

      if Assumption = True_Pred then
         return True_Pred;
      else
         return Binding_For_Temp (Tmp => Tmp, Context => Assumption);
      end if;
   end Compute_Default_Init;

   ---------------------------
   -- Compute_Default_Value --
   ---------------------------

   function Compute_Default_Value
     (Ada_Node     : Node_Id;
      E            : Type_Kind_Id;
      Relaxed_Init : Boolean;
      Domain       : EW_Domain;
      Params       : Transformation_Params := Body_Params) return W_Expr_Id
   is
      function Compute_Default_Value_Rec
        (E : Type_Kind_Id; Relaxed_Init : Boolean) return W_Term_Id;
      --  Compute the default value in the term domain. DIC are ignored

      -------------------------------
      -- Compute_Default_Value_Rec --
      -------------------------------

      function Compute_Default_Value_Rec
        (E : Type_Kind_Id; Relaxed_Init : Boolean) return W_Term_Id
      is
         function Has_Non_Empty_DIC (Ty : Type_Kind_Id) return Boolean;
         --  Check whether there is at least a non-empty DIC applicable to Ty

         -----------------------
         -- Has_Non_Empty_DIC --
         -----------------------

         function Has_Non_Empty_DIC (Ty : Type_Kind_Id) return Boolean is
            DIC_Found : exception;

            procedure Check_DIC_Is_Non_Empty
              (Default_Init_Param : Formal_Kind_Id;
               Default_Init_Expr  : Node_Id);
            --  If Default_Init_Expr is not the True predicate, raise DIC_Found

            ----------------------------
            -- Check_DIC_Is_Non_Empty --
            ----------------------------

            procedure Check_DIC_Is_Non_Empty
              (Default_Init_Param : Formal_Kind_Id;
               Default_Init_Expr  : Node_Id)
            is
               pragma Unreferenced (Default_Init_Param);
            begin
               if not Compile_Time_Known_Value (Default_Init_Expr)
                 or else not Is_True (Expr_Value (Default_Init_Expr))
               then
                  raise DIC_Found;
               end if;
            end Check_DIC_Is_Non_Empty;

            procedure Check_DICs_Are_Non_Empty is new
              Iterate_Applicable_DIC (Check_DIC_Is_Non_Empty);
         begin
            Check_DICs_Are_Non_Empty (Ty);
            return False;
         exception
            when DIC_Found =>
               return True;
         end Has_Non_Empty_DIC;

         Ty   : constant Entity_Id := Retysp (E);
         W_Ty : constant W_Type_Id := EW_Abstract (Ty, Relaxed_Init);
         Def  : W_Term_Id;

         --  Start of processing for Compute_Default_Value_Rec

      begin
         if Is_Scalar_Type (Ty) then
            if Has_Default_Aspect (Ty) then
               Def :=
                 Transform_Term
                   (Expr          => Default_Aspect_Value (Ty),
                    Expected_Type => W_Ty,
                    Params        => Params);
            else
               Def := +E_Symb (Ty, WNE_Dummy, Relaxed_Init);
            end if;

         elsif Is_Array_Type (Ty) then
            declare
               Comp_Ty      : constant Entity_Id :=
                 Retysp (Component_Type (Ty));
               Comp_Relaxed : constant Boolean :=
                 Has_Init_Wrapper (Comp_Ty)
                 and then (Relaxed_Init or else Has_Relaxed_Init (Comp_Ty));
               Comp_Default : W_Term_Id;

            begin
               --  Use the Default_Component_Value if any

               if Has_Default_Aspect (Ty) then
                  Comp_Default :=
                    Transform_Term
                      (Expr          => Default_Aspect_Component_Value (Ty),
                       Expected_Type => EW_Abstract (Comp_Ty, Comp_Relaxed),
                       Params        => Params);

               --  Otherwise, compute a default value from the type

               else
                  Comp_Default :=
                    Compute_Default_Value_Rec (Comp_Ty, Comp_Relaxed);
               end if;

               --  Create an array with the same element at all indexes

               declare
                  Dim    : constant Positive :=
                    Positive (Number_Dimensions (Ty));
                  Bounds : W_Expr_Array (1 .. 2 * Dim);
                  Count  : Positive := 1;
               begin
                  for D in 1 .. Dim loop
                     Add_Attr_Arg
                       (EW_Term,
                        Bounds,
                        Ty,
                        Attribute_First,
                        D,
                        Count,
                        Params);
                     Add_Attr_Arg
                       (EW_Term, Bounds, Ty, Attribute_Last, D, Count, Params);
                  end loop;

                  Def :=
                    +New_Const_Call
                       (Domain => EW_Term,
                        Elt    => +Comp_Default,
                        Bounds => Bounds,
                        Typ    => W_Ty);

                  --  For unconstrained arrays, reconstruct the array

                  if not Is_Static_Array_Type (Ty) then
                     Def :=
                       +Array_Convert_From_Base
                          (Domain => EW_Term,
                           Ty     => Ty,
                           Ar     => +Def,
                           Bounds => Bounds);
                  end if;
               end;
            end;

         elsif Is_Access_Type (Ty) then
            Def := +E_Symb (Ty, WNE_Null_Pointer);

         elsif Is_Simple_Private_Type (Ty) then
            Def := +E_Symb (Ty, WNE_Dummy, Relaxed_Init);

         else
            pragma Assert (Is_Record_Type_In_Why (Ty));
            declare
               Root         : constant Entity_Id := Root_Retysp (Ty);
               Num_Discr    : constant Natural := Count_Discriminants (Ty);
               Num_Fields   : constant Natural :=
                 Count_Why_Regular_Fields (Ty);
               Discr_Assocs : W_Field_Association_Array (1 .. Num_Discr);
               Discr_Ids    : W_Identifier_Array (1 .. Num_Discr);
               Discr_Vals   : W_Term_Array (1 .. Num_Discr);
               Field_Assocs : W_Field_Association_Array (1 .. Num_Fields);
               Count        : Natural := 1;

            begin
               --  Get the discriminants from the type constraints

               if Num_Discr > 0 then
                  pragma Assert (Present (Discriminant_Constraint (Ty)));

                  declare
                     Discr : Entity_Id := First_Discriminant (Ty);
                     Elmt  : Elmt_Id :=
                       First_Elmt (Discriminant_Constraint (Ty));
                  begin
                     while Present (Discr) loop
                        Discr_Ids (Count) :=
                          New_Temp_Identifier
                            (Ada_Node  => Discr,
                             Base_Name => Short_Name (Discr),
                             Typ       => EW_Abstract (Etype (Discr)));
                        Discr_Vals (Count) :=
                          Transform_Term
                            (Params        => Params,
                             Expr          => Node (Elmt),
                             Expected_Type => EW_Abstract (Etype (Discr)));
                        Discr_Assocs (Count) :=
                          New_Field_Association
                            (Domain => EW_Term,
                             Field  =>
                               To_Why_Id
                                 (E      => Discr,
                                  Domain => EW_Term,
                                  Rec    => Root,
                                  Typ    => EW_Abstract (Etype (Discr))),
                             Value  => +Discr_Ids (Count));
                        Count := Count + 1;
                        Next_Elmt (Elmt);
                        Next_Discriminant (Discr);
                     end loop;
                  end;
               end if;

               if Num_Fields > 0 then

                  --  To translate the default values of the fields, we might
                  --  need the entities of discriminants.

                  Ada_Ent_To_Why.Push_Scope (Symbol_Table);

                  for Discr_Id of Discr_Ids loop
                     Insert_Tmp_Item_For_Entity
                       (Get_Ada_Node (+Discr_Id), Discr_Id);
                  end loop;

                  Count := 1;
                  for Comp of Get_Component_Set (Ty) loop

                     --  Use a dummy value for the private part of the type

                     if Is_Type (Comp) then
                        declare
                           W_Comp_Ty : constant W_Type_Id :=
                             New_Named_Type
                               (Name =>
                                  Get_Name
                                    (E_Symb
                                       (Comp,
                                        WNE_Private_Type,
                                        Relaxed_Init => Relaxed_Init)));
                        begin
                           Field_Assocs (Count) :=
                             New_Field_Association
                               (Domain => EW_Term,
                                Field  =>
                                  To_Why_Id
                                    (E            => Comp,
                                     Domain       => EW_Term,
                                     Rec          => Ty,
                                     Typ          => W_Comp_Ty,
                                     Relaxed_Init => Relaxed_Init),
                                Value  =>
                                  +E_Symb
                                     (Comp, WNE_Private_Dummy, Relaxed_Init));
                        end;
                     else
                        declare
                           Comp_Ty      : constant Entity_Id :=
                             Retysp (Etype (Comp));
                           Comp_Relaxed : constant Boolean :=
                             Has_Init_Wrapper (Comp_Ty)
                             and then
                               (Relaxed_Init
                                or else Has_Relaxed_Init (Comp_Ty));
                           W_Comp_Ty    : constant W_Type_Id :=
                             EW_Abstract (Comp_Ty, Comp_Relaxed);
                           Comp_Default : W_Term_Id;

                        begin
                           --  Use the default value of the component
                           --  declaration if any.

                           if Present
                                (Expression (Enclosing_Declaration (Comp)))
                           then
                              Comp_Default :=
                                New_Tag_And_Ext_Update
                                  (Name =>
                                     Transform_Term
                                       (Expr          =>
                                          Expression
                                            (Enclosing_Declaration (Comp)),
                                        Expected_Type => W_Comp_Ty,
                                        Params        => Params),
                                   Ty   => Comp_Ty);

                           --  Otherwise, compute a default value from the type

                           else
                              Comp_Default :=
                                Compute_Default_Value_Rec
                                  (Comp_Ty, Comp_Relaxed);
                           end if;

                           Field_Assocs (Count) :=
                             New_Field_Association
                               (Domain => EW_Term,
                                Field  =>
                                  To_Why_Id
                                    (E            => Comp,
                                     Domain       => EW_Term,
                                     Rec          => Ty,
                                     Typ          => W_Comp_Ty,
                                     Relaxed_Init => Relaxed_Init),
                                Value  => +Comp_Default);
                        end;
                     end if;

                     Count := Count + 1;
                  end loop;

                  Ada_Ent_To_Why.Pop_Scope (Symbol_Table);
               end if;

               Def :=
                 +New_Ada_Record_Aggregate
                    (Domain       => EW_Term,
                     Discr_Assocs => Discr_Assocs,
                     Field_Assocs => Field_Assocs,
                     Ty           => Ty,
                     Relaxed_Init => Relaxed_Init);

               --  Introduce bindings for discrminants

               for I in 1 .. Num_Discr loop
                  Def :=
                    New_Typed_Binding
                      (Name    => Discr_Ids (I),
                       Def     => Discr_Vals (I),
                       Context => Def);
               end loop;
            end;
         end if;

         --  If Ty has a default initial condition, it will be ignored.
         --  Warn the user.

         if Has_DIC (Ty) and then Has_Non_Empty_DIC (Ty) then
            Warning_Msg_N (Warn_DIC_Ignored, Ada_Node, Names => [Ty]);
         end if;
         return Def;
      end Compute_Default_Value_Rec;

      --  Start of processing for Compute_Default_Value

   begin
      --  In the term domain, go through the type to compute the default value

      if Domain = EW_Term then
         return +Compute_Default_Value_Rec (E, Relaxed_Init);

      --  In the program domain, generate an any program with the default
      --  init assumption as a postcondition. This is more precise than the
      --  term translation as it includes DIC of private types.

      else
         pragma Assert (Domain in EW_Prog | EW_Pterm);

         declare
            W_Ty   : constant W_Type_Id := EW_Abstract (E, Relaxed_Init);
            Result : W_Prog_Id :=
              New_Simpl_Any_Prog
                (T    => W_Ty,
                 Pred =>
                   Compute_Default_Init (+New_Result_Ident (W_Ty), E, Params));

         begin
            --  If necessary, also generate the checks for the default
            --  initialization of the value.

            if Domain = EW_Prog then
               Result :=
                 Sequence
                   (Left  =>
                      New_Ignore
                        (Ada_Node,
                         Compute_Default_Check (Ada_Node, E, Params)),
                    Right => Result);
            end if;

            return +Result;
         end;
      end if;
   end Compute_Default_Value;

   --------------------------------------------
   -- Compute_Dynamic_Inv_And_Initialization --
   --------------------------------------------

   function Compute_Dynamic_Inv_And_Initialization
     (Expr           : W_Term_Id;
      Ty             : Type_Kind_Id;
      Params         : Transformation_Params;
      Initialized    : W_Term_Id := True_Term;
      Valid          : W_Term_Id := Why_Empty;
      Only_Var       : W_Term_Id := True_Term;
      Top_Predicate  : Boolean := True;
      All_Global_Inv : Boolean := True) return W_Pred_Id
   is
      Dyn_Pred : W_Pred_Id :=
        Compute_Dynamic_Invariant
          (Expr           => Expr,
           Ty             => Ty,
           Valid          => Valid,
           Initialized    => Initialized,
           Params         => Params,
           Only_Var       => Only_Var,
           Top_Predicate  => (if Top_Predicate then True_Term else False_Term),
           All_Global_Inv => All_Global_Inv);

   begin
      --  If Expr has relaxed initialization and Initialized is True, assume
      --  the initialization of objects which are ultimately scalar and the
      --  predicate of Ty if any.
      --  For now, objects with relaxed initialization are always valid.

      if Is_Init_Wrapper_Type (Get_Type (+Expr)) then
         declare
            Init_Pred : W_Pred_Id := True_Pred;
         begin
            if Has_Scalar_Full_View (Ty) then

               --  Inputs of scalar types do not use the init wrapper
               pragma Assert (Top_Predicate);

               Init_Pred :=
                 +Compute_Is_Initialized
                    (Ty,
                     +Expr,
                     Params,
                     EW_Pred,
                     Exclude_Components => Relaxed);
            elsif Has_Predicates (Ty) then
               Init_Pred :=
                 Compute_Dynamic_Predicate
                   (Expr          => Expr,
                    Ty            => Ty,
                    Top_Predicate =>
                      (if Top_Predicate then True_Term else False_Term));
            end if;

            if Has_Mutable_Discriminants (Ty) or else Is_Access_Type (Ty) then
               Init_Pred :=
                 New_And_Pred
                   (Left  => Init_Pred,
                    Right =>
                      Pred_Of_Boolean_Term
                        (New_Init_Attribute_Access (Ty, +Expr)));
            end if;

            if not Is_True_Boolean (+Init_Pred) then
               Dyn_Pred :=
                 New_And_Pred
                   (Dyn_Pred,
                    New_Conditional
                      (Condition => Pred_Of_Boolean_Term (Initialized),
                       Then_Part => Init_Pred));
            end if;
         end;
      end if;

      return Dyn_Pred;
   end Compute_Dynamic_Inv_And_Initialization;

   -------------------------------
   -- Compute_Dynamic_Invariant --
   -------------------------------

   function Compute_Dynamic_Invariant
     (Expr           : W_Term_Id;
      Ty             : Type_Kind_Id;
      Params         : Transformation_Params;
      Initialized    : W_Term_Id := True_Term;
      Valid          : W_Term_Id := Why_Empty;
      Only_Var       : W_Term_Id := True_Term;
      Top_Predicate  : W_Term_Id := True_Term;
      All_Global_Inv : Boolean := True;
      Use_Pred       : Boolean := True) return W_Pred_Id
   is
      T                 : W_Pred_Id;
      New_Incompl_Acc   : Ada_To_Why_Ident.Map;
      New_Incompl_Acc_R : Ada_To_Why_Ident.Map;
   begin
      --  Current_Subp is used as a scope to determine which local invariants
      --  should be included in the dynamic invariant. It should be set.

      pragma Assert (Present (Current_Subp));

      Compute_Dynamic_Invariant
        (Expr              => Expr,
         Ty                => Ty,
         Params            => Params,
         Initialized       => Initialized,
         Valid             => Valid,
         Only_Var          => Only_Var,
         Top_Predicate     => Top_Predicate,
         All_Global_Inv    =>
           (if All_Global_Inv then True_Term else False_Term),
         Inv_Scop          => Current_Subp,
         Inv_Subp          => (if All_Global_Inv then Empty else Current_Subp),
         Use_Pred          => Use_Pred,
         New_Preds_Module  => Why_Empty,
         T                 => T,
         Loc_Incompl_Acc   => Ada_To_Why_Ident.Empty_Map,
         New_Incompl_Acc   => New_Incompl_Acc,
         Loc_Incompl_Acc_R => Ada_To_Why_Ident.Empty_Map,
         New_Incompl_Acc_R => New_Incompl_Acc_R,
         Expand_Incompl    => True);

      pragma Assert (New_Incompl_Acc.Is_Empty);
      pragma Assert (New_Incompl_Acc_R.Is_Empty);
      return T;
   end Compute_Dynamic_Invariant;

   procedure Compute_Dynamic_Invariant
     (Expr              : W_Term_Id;
      Ty                : Type_Kind_Id;
      Params            : Transformation_Params;
      Initialized       : W_Term_Id;
      Valid             : W_Term_Id;
      Only_Var          : W_Term_Id;
      Top_Predicate     : W_Term_Id;
      All_Global_Inv    : W_Term_Id;
      Inv_Scop          : Node_Id;
      Inv_Subp          : Node_Id;
      Use_Pred          : Boolean;
      New_Preds_Module  : W_Module_Id;
      T                 : out W_Pred_Id;
      Loc_Incompl_Acc   : Ada_To_Why_Ident.Map;
      New_Incompl_Acc   : in out Ada_To_Why_Ident.Map;
      Loc_Incompl_Acc_R : Ada_To_Why_Ident.Map;
      New_Incompl_Acc_R : in out Ada_To_Why_Ident.Map;
      Expand_Incompl    : Boolean)
   is

      function Invariant_For_Access
        (Expr : W_Term_Id; Ty : Entity_Id) return W_Pred_Id;
      --  Generates:
      --  (not <Expr>.is_null -> Dynamic_Invariant <Expr>.value)

      function Invariant_For_Comp
        (C_Expr : W_Term_Id;
         C_Ty   : Entity_Id;
         E      : Entity_Id;
         Idx    : W_Expr_Array) return W_Pred_Id
      with Pre => No (E) or Idx'Length = 0;
      --  @param C_Expr expression for a component
      --  @param C_Ty component type
      --  @param E record field for record component
      --  @param Idx array indices for array component
      --  @return predicate for individual components
      --          Dynamic_Invariant <C_Expr>
      --              /\ C_Expr.rec__constrained = <Is_Constrained (C_Ty)>

      function Invariant_For_Absent_Comp
        (C_Expr : W_Term_Id; C_Ty : Entity_Id; E : Entity_Id) return W_Pred_Id;
      --  Assume that components not present in discriminated records have a
      --  dummy value.

      function Invariant_For_Comp
        (C_Expr : W_Term_Id; C_Ty : Entity_Id; Idx : W_Expr_Array)
         return W_Pred_Id
      is (Invariant_For_Comp (C_Expr, C_Ty, Empty, Idx));

      function Invariant_For_Comp
        (C_Expr : W_Term_Id; C_Ty : Entity_Id; E : Entity_Id) return W_Pred_Id
      is (Invariant_For_Comp (C_Expr, C_Ty, E, (1 .. 0 => <>)));

      -------------------------------
      -- Invariant_For_Absent_Comp --
      -------------------------------

      function Invariant_For_Absent_Comp
        (C_Expr : W_Term_Id; C_Ty : Entity_Id; E : Entity_Id) return W_Pred_Id
      is
         pragma Unreferenced (E);
         Dummy_Expr : W_Term_Id := +Why_Default_Value (EW_Term, C_Ty);

      begin
         if Is_Init_Wrapper_Type (Get_Type (+C_Expr)) then
            Dummy_Expr :=
              Insert_Simple_Conversion
                (Expr => Dummy_Expr, To => Get_Type (+C_Expr));
         end if;

         return
           New_Comparison
             (Symbol => Why_Eq, Left => C_Expr, Right => Dummy_Expr);
      end Invariant_For_Absent_Comp;

      --------------------------
      -- Invariant_For_Access --
      --------------------------

      function Invariant_For_Access
        (Expr : W_Term_Id; Ty : Entity_Id) return W_Pred_Id
      is
         Value_Dyn_Inv : W_Pred_Id;
      begin
         --  ??? we can assume the value of constrained attribute if any

         Compute_Dynamic_Invariant
           (Expr              =>
              New_Pointer_Value_Access
                (Ada_Node => Empty, E => Ty, Name => Expr),
            Ty                => Directly_Designated_Type (Ty),
            Only_Var          => False_Term,
            Top_Predicate     => True_Term,
            All_Global_Inv    => All_Global_Inv,
            Inv_Scop          => Inv_Scop,
            Inv_Subp          => Inv_Subp,
            Initialized       => True_Term,
            Valid             => Why_Empty,
            Params            => Params,
            Use_Pred          => Use_Pred,
            New_Preds_Module  => New_Preds_Module,
            T                 => Value_Dyn_Inv,
            Loc_Incompl_Acc   => Loc_Incompl_Acc,
            New_Incompl_Acc   => New_Incompl_Acc,
            Loc_Incompl_Acc_R => Loc_Incompl_Acc_R,
            New_Incompl_Acc_R => New_Incompl_Acc_R,
            Expand_Incompl    => False);
         --  Do not expand incomplete types inside access types to avoid
         --  hitting circularity.

         if Value_Dyn_Inv /= True_Pred then
            return
              New_Conditional
                (Condition =>
                   New_Not
                     (Right =>
                        Pred_Of_Boolean_Term
                          (New_Pointer_Is_Null_Access
                             (E => Ty, Name => +Expr))),
                 Then_Part => Value_Dyn_Inv);
         else
            return True_Pred;
         end if;
      end Invariant_For_Access;

      ------------------------
      -- Invariant_For_Comp --
      ------------------------

      function Invariant_For_Comp
        (C_Expr : W_Term_Id;
         C_Ty   : Entity_Id;
         E      : Entity_Id;
         Idx    : W_Expr_Array) return W_Pred_Id
      is
         C_Valid : constant W_Term_Id :=
           (if No (Valid)
            then Why_Empty
            elsif No (E)
            then
              +New_Validity_Tree_Array_Access
                 (+Valid, Idx, Retysp (Ty), EW_Term)
            elsif Ekind (E) = E_Discriminant
              or else Comp_Has_Only_Valid_Values (E, Retysp (Ty)).Ok
            then Why_Empty
            else +New_Validity_Tree_Record_Access (+Valid, E, Retysp (Ty)));
         T_Comp  : W_Pred_Id;
      begin
         --  Recursively call Compute_Dynamic_Invariant on the composite type's
         --  components. Additional parameters are unchanged expect for
         --  Only_Var set to false (as a constant subcomponent of a variable
         --  toplevel object needs to be considered as variable too) and
         --  Top_Predicate set to true (as the decision to include or not
         --  the top predicate does not apply to subcomponents).
         --  Also discriminants and components of protected types are always
         --  initialized.

         Compute_Dynamic_Invariant
           (Expr              => C_Expr,
            Ty                => C_Ty,
            Initialized       =>
              (if (Present (E) and then Ekind (E) = E_Discriminant)
                 or else Is_Protected_Type (Retysp (Ty))
               then True_Term
               else Initialized),
            Valid             => C_Valid,
            Only_Var          => False_Term,
            Top_Predicate     => True_Term,
            All_Global_Inv    => All_Global_Inv,
            Inv_Scop          => Inv_Scop,
            Inv_Subp          => Inv_Subp,
            Params            => Params,
            Use_Pred          => Use_Pred,
            New_Preds_Module  => New_Preds_Module,
            T                 => T_Comp,
            Loc_Incompl_Acc   => Loc_Incompl_Acc,
            New_Incompl_Acc   => New_Incompl_Acc,
            Loc_Incompl_Acc_R => Loc_Incompl_Acc_R,
            New_Incompl_Acc_R => New_Incompl_Acc_R,
            Expand_Incompl    => Expand_Incompl);

         --  Components necessarily have the tag of their type

         if Is_Tagged_Type (Retysp (C_Ty)) then
            pragma Assert (not Is_Class_Wide_Type (Retysp (C_Ty)));
            T_Comp :=
              New_And_Pred
                (T_Comp,
                 New_Comparison
                   (Symbol => Why_Eq,
                    Left   =>
                      +New_Tag_Access
                         (Domain => EW_Term,
                          Name   => +C_Expr,
                          Ty     => Retysp (C_Ty)),
                    Right  => +E_Symb (E => C_Ty, S => WNE_Tag)));
         end if;

         return T_Comp;
      end Invariant_For_Comp;

      function Invariant_For_Array is new
        Build_Predicate_For_Array (Invariant_For_Comp);

      function Invariant_For_Record is new
        Build_Predicate_For_Record
          (Invariant_For_Comp,
           Invariant_For_Comp,
           Invariant_For_Absent_Comp);

      --  If Ty's fullview is in SPARK, go to its underlying type to check its
      --  kind.

      Ty_Spec      : constant Entity_Id :=
        (if Is_Class_Wide_Type (Ty)
         then Get_Specific_Type_From_Classwide (Ty)
         else Ty);
      Ty_Ext       : constant Entity_Id := Retysp (Ty_Spec);
      Relaxed_Init : constant Boolean := Get_Relaxed_Init (Get_Type (+Expr));
      Pred_Main_Ty : constant W_Type_Id :=
        (if Relaxed_Init
         then EW_Abstract (Ty_Ext, Relaxed_Init => True)
         else Type_Of_Node (Ty_Ext));

      Variables : Flow_Id_Sets.Set;

      --  Start of processing for Compute_Dynamic_Invariant

   begin
      --  If Use_Pred is true, then we already have generated a predicate
      --  for the dynamic invariant of elements of type Ty_Ext, except if the
      --  type is an itype or if it is standard boolean. We also avoid using
      --  the predicate for objects in split form as it would introduce an
      --  unnecessary conversion harmful to provers.
      --  Never use the predicate if there is a validity flag.

      if Use_Pred
        and then not Is_Itype (Ty_Ext)
        and then not Is_Standard_Boolean_Type (Ty_Ext)
        and then Eq_Base (Pred_Main_Ty, Get_Type (+Expr))
        and then No (Valid)
      then

         --  The generated predicate uses an empty scope for type invariants

         Variables_In_Dynamic_Invariant (Ty_Ext, Variables, Scop => Empty);

         declare
            Vars  : constant W_Expr_Array :=
              Get_Args_From_Variables (Variables, Params.Ref_Allowed);
            Num_B : constant Positive := 5 + Vars'Length;
            Args  : W_Expr_Array (1 .. Num_B);

         begin
            Args (1) := +Expr;
            Args (2) := +Initialized;
            Args (3) := +Only_Var;
            Args (4) := +Top_Predicate;
            Args (5) := +All_Global_Inv;
            Args (6 .. Num_B) := Vars;

            T :=
              New_Call
                (Name =>
                   E_Symb
                     (E            => Ty_Ext,
                      S            => WNE_Dynamic_Invariant,
                      Relaxed_Init => Relaxed_Init),
                 Args => Args,
                 Typ  => EW_Bool_Type);

            --  If Inv_Scop is set, add possible locally assumed type
            --  invariants. If Inv_Subp is also set, add globally assumed type
            --  invariants as they won't be included in the predicate (as
            --  All_Global_Inv is False). Include components as the traversal
            --  stops here.

            if Present (Inv_Scop) then
               T :=
                 New_And_Pred
                   (Left  => T,
                    Right =>
                      Compute_Type_Invariant
                        (Expr,
                         Ty_Ext,
                         Locally_Assumed,
                         Params,
                         Use_Pred => Use_Pred,
                         Scop     => Inv_Scop,
                         Subp     => Inv_Subp));
            end if;

            return;
         end;
      end if;

      --  Dynamic property of the type itself

      if Type_Is_Modeled_As_Base (Ty_Ext)
        or else
          (Use_Split_Form_For_Type (Ty_Ext)
           and then Get_Type_Kind (Get_Type (+Expr)) /= EW_Abstract)
      then
         T :=
           +New_Dynamic_Property
              (Domain => EW_Pred,
               Ty     => Ty_Ext,
               Expr   => +Expr,
               Params => Params);

         --  If a scalar variable is not initialized or invalid, then its
         --  dynamic property may be false. As initialization is checked
         --  separately by flow analysis, we can assume that the variable is in
         --  the type bounds as long as it does not introduce any unsoundness
         --  (the range is not empty). We can skip this if the range is
         --  statically non-empty.

         if T /= True_Pred
           and then
             not (Has_Discrete_Type (Ty_Ext)
                  and then Has_OK_Static_Scalar_Subtype (Ty_Ext)
                  and then
                    UI_Le
                      (Expr_Value (Type_Low_Bound (Ty_Ext)),
                       Expr_Value (Type_High_Bound (Ty_Ext))))
         then
            declare
               Why_Rep_Type : constant W_Type_Id := Base_Why_Type (Ty_Ext);
               Le_Op        : constant W_Identifier_Id :=
                 (if Why_Type_Is_Float (Why_Rep_Type)
                  then MF_Floats (Why_Rep_Type).Le
                  elsif Why_Type_Is_BitVector (Why_Rep_Type)
                  then MF_BVs (Why_Rep_Type).Ule
                  else Int_Infix_Le);
               First        : constant W_Expr_Id :=
                 Insert_Simple_Conversion
                   (Domain => EW_Term,
                    Expr   =>
                      New_Attribute_Expr
                        (Ty     => Ty_Ext,
                         Domain => EW_Term,
                         Attr   => Attribute_First,
                         Params => Params),
                    To     => Why_Rep_Type);
               Last         : constant W_Expr_Id :=
                 Insert_Simple_Conversion
                   (Domain => EW_Term,
                    Expr   =>
                      New_Attribute_Expr
                        (Ty     => Ty_Ext,
                         Domain => EW_Term,
                         Attr   => Attribute_Last,
                         Params => Params),
                    To     => Why_Rep_Type);
               Fst_Le_Last  : constant W_Pred_Id :=
                 New_Call
                   (Name => Le_Op, Typ => EW_Bool_Type, Args => (First, Last));
               Init_Flag    : constant W_Pred_Id :=
                 New_And_Pred
                   (Left  =>
                      Pred_Of_Boolean_Term
                        (if Is_Init_Wrapper_Type (Get_Type (+Expr))
                         then New_Init_Attribute_Access (Ty_Ext, +Expr)
                         else Initialized),
                    Right =>
                      (if Present (Valid)
                       then Pred_Of_Boolean_Term (Valid)
                       else True_Pred));
               --  For scalars, the validity flag is a boolean, it can be used
               --  directly.
            begin
               T :=
                 New_Conditional
                   (Condition => New_Or_Pred (Init_Flag, Fst_Le_Last),
                    Then_Part => T,
                    Typ       => EW_Bool_Type);
            end;
         end if;

      elsif Is_Access_Subprogram_Type (Ty_Ext) then

         --  Assume the contract of the access-to-subprogram type if any

         T :=
           New_Dynamic_Property_For_Subprogram
             (Ty => Ty_Ext, Expr => Expr, Params => Params);

         --  Only assume that an object with null exclusion is not null if it
         --  is initialized. This is the case in most cases, since access types
         --  are initialized by default. However, out parameters might not be
         --  valid values of the type.

         if Can_Never_Be_Null (Ty_Ext) then
            T :=
              New_And_Pred
                (Left  =>
                   New_Conditional
                     (Condition => Pred_Of_Boolean_Term (Initialized),
                      Then_Part =>
                        New_Not
                          (Right =>
                             Pred_Of_Boolean_Term
                               (New_Record_Access
                                  (Name  => Expr,
                                   Field => M_Subprogram_Access.Rec_Is_Null,
                                   Typ   => EW_Bool_Type))),
                      Typ       => EW_Bool_Type),
                 Right => T);
         end if;

      elsif Is_Access_Type (Ty_Ext) then

         --  Only assume that an object with null exclusion is not null if it
         --  is initialized. This is the case in most cases, since access types
         --  are initialized by default. However, out parameters might not be
         --  valid values of the type.

         if Can_Never_Be_Null (Ty_Ext) then
            T :=
              New_Conditional
                (Condition => Pred_Of_Boolean_Term (Initialized),
                 Then_Part =>
                   New_Not
                     (Right =>
                        Pred_Of_Boolean_Term
                          (New_Pointer_Is_Null_Access
                             (E => Ty_Ext, Name => Expr))),
                 Typ       => EW_Bool_Type);

         --  Access to object types have an invariant which fix the designated
         --  value when the pointer is null (so null pointers are logically
         --  equal). Assume it here.

         else
            T :=
              New_Call
                (Name =>
                   E_Symb
                     (Ty_Ext,
                      WNE_Dynamic_Property,
                      Relaxed_Init => Get_Relaxed_Init (Get_Type (+Expr))),
                 Args => (1 => +Expr));
         end if;

      --  Do not assume bounds of arrays and discriminants if Only_Var is
      --  statically True.

      elsif Is_True_Boolean (+Only_Var) then
         T := True_Pred;

      elsif Is_Array_Type (Ty_Ext) and then not Is_Static_Array_Type (Ty_Ext)
      then
         T :=
           +New_Dynamic_Property
              (Domain => EW_Pred,
               Ty     => Ty_Ext,
               Expr   => +Expr,
               Params => Params);

         --  For arrays, also assume the value of its bounds

         if Is_Constrained (Ty_Ext)
           or else Is_Fixed_Lower_Bound_Array_Subtype (Ty_Ext)
         then
            declare
               Constrained : constant Boolean := Is_Constrained (Ty_Ext);
               Index       : Node_Id := First_Index (Ty_Ext);
               I           : Positive := 1;
            begin
               while Present (Index) loop

                  --  If Ty is constrained or Index has a fixed lower bound,
                  --  assume the value of Ty'First.

                  if Constrained
                    or else Is_Fixed_Lower_Bound_Index_Subtype (Etype (Index))
                  then
                     declare
                        Rng      : constant Node_Id := Get_Range (Index);
                        Rng_Ty   : constant W_Type_Id :=
                          Base_Why_Type_No_Bool (Etype (Index));
                        Low_Expr : constant W_Expr_Id :=
                          Transform_Expr
                            (Low_Bound (Rng), Rng_Ty, EW_Term, Params);
                        First_Eq : constant W_Pred_Id :=
                          New_Call
                            (Name => Why_Eq,
                             Typ  => EW_Bool_Type,
                             Args =>
                               (1 =>
                                  +Insert_Conversion_To_Rep_No_Bool
                                     (Get_Array_Attr
                                        (Expr => Expr,
                                         Attr => Attribute_First,
                                         Dim  => I)),
                                2 => Low_Expr));
                     begin

                        T := New_And_Pred (Left => T, Right => First_Eq);

                        --  If Ty is constrained also assume the value of
                        --  Ty'Last.

                        if Constrained then
                           declare
                              High_Expr : constant W_Expr_Id :=
                                Transform_Expr
                                  (High_Bound (Rng), Rng_Ty, EW_Term, Params);
                              Last_Eq   : constant W_Pred_Id :=
                                New_Call
                                  (Name => Why_Eq,
                                   Typ  => EW_Bool_Type,
                                   Args =>
                                     (1 =>
                                        +Insert_Conversion_To_Rep_No_Bool
                                           (Get_Array_Attr
                                              (Expr => Expr,
                                               Attr => Attribute_Last,
                                               Dim  => I)),
                                      2 => High_Expr));
                           begin
                              T := New_And_Pred (Left => T, Right => Last_Eq);
                           end;
                        end if;
                     end;
                  end if;

                  Next_Index (Index);
                  I := I + 1;
               end loop;
            end;
         end if;

         T :=
           New_Conditional
             (Condition => Pred_Of_Boolean_Term (Only_Var),
              Then_Part => True_Pred,
              Else_Part => T,
              Typ       => EW_Bool_Type);

      elsif Has_Discriminants (Ty_Ext) and then Is_Constrained (Ty_Ext) then
         T :=
           New_Conditional
             (Condition => Pred_Of_Boolean_Term (Only_Var),
              Then_Part => True_Pred,
              Else_Part =>
                +New_Dynamic_Property
                   (Domain => EW_Pred,
                    Ty     => Ty_Ext,
                    Expr   => +Expr,
                    Params => Params),
              Typ       => EW_Bool_Type);
      else
         T := True_Pred;
      end if;

      --  Add possible dynamic predicate. If the type defines at least partial
      --  default initialization, the predicate is checked at default
      --  initialization so it can be assumed to always hold. Otherwise, the
      --  predicate is only valid for initialized data. In all cases, only
      --  assume the predicate of the type itself when the top predicate should
      --  be included. Otherwise, assume the predicate of the first ancestor
      --  only.
      --  Do not assume the predicate on composite initialization wrappers.
      --  It will be part of the 'Initialized attribute instead.

      if not Is_Init_Wrapper_Type (Get_Type (+Expr))
        or else Has_Scalar_Full_View (Ty_Ext)
      then
         declare
            Relaxed_Init          : constant Boolean :=
              Is_Init_Wrapper_Type (Get_Type (+Expr));
            Typ_Pred              : constant W_Pred_Id :=
              Compute_Dynamic_Predicate (Expr, Ty_Ext, Params, Top_Predicate);
            Pred_Check_At_Default : constant Boolean :=
              Needs_Default_Predicate_Checks (Ty_Ext);
            Init_Flag             : constant W_Pred_Id :=
              Pred_Of_Boolean_Term
                (if Relaxed_Init
                 then
                   +Compute_Is_Initialized
                      (Ty_Ext,
                       +Expr,
                       Params,
                       EW_Term,
                       No_Predicate_Check => True,
                       Exclude_Components => Relaxed)
                 else Initialized);
            Check_Pred            : constant W_Pred_Id :=
              (if Pred_Check_At_Default and then not Relaxed_Init
               then Typ_Pred
               else
                 New_Conditional
                   (Condition => Init_Flag,
                    Then_Part => Typ_Pred,
                    Typ       => EW_Bool_Type));

         begin
            if not Is_True_Boolean (+Typ_Pred) then

               --  For now, types with predicates cannot be potentially invalid

               pragma Assert (No (Valid));

               T := New_And_Pred (Left => T, Right => Check_Pred);
            end if;
         end;
      end if;

      --  Add possible globally assumed type invariant. Only deal with the
      --  top-level invariants as invariants of components will be added in
      --  recursive calls.

      if not Is_False_Boolean (+All_Global_Inv) then
         declare
            Type_Inv : W_Pred_Id :=
              Compute_Type_Invariant
                (Expr,
                 Ty_Ext,
                 Globally_Assumed,
                 Params,
                 Include_Comp => False,
                 Use_Pred     => Use_Pred);
         begin
            if not Is_True_Boolean (+Type_Inv) then
               if not Is_True_Boolean (+All_Global_Inv) then
                  Type_Inv :=
                    New_Conditional
                      (Condition => Pred_Of_Boolean_Term (All_Global_Inv),
                       Then_Part => Type_Inv,
                       Typ       => EW_Bool_Type);
               end if;

               T := New_And_Pred (Left => T, Right => Type_Inv);
            end if;
         end;
      end if;

      --  If Inv_Scop is set, add possible locally assumed type invariants. If
      --  Inv_Subp is also set, add globally assumed type invariants as they
      --  won't be included in the predicate (as All_Global_Inv is False).
      --  Only deal with the top-level invariants as invariants of components
      --  will be added in recursive calls.

      if Present (Inv_Scop) then
         T :=
           New_And_Pred
             (Left  => T,
              Right =>
                Compute_Type_Invariant
                  (Expr,
                   Ty_Ext,
                   Locally_Assumed,
                   Params,
                   Include_Comp => False,
                   Use_Pred     => Use_Pred,
                   Scop         => Inv_Scop,
                   Subp         => Inv_Subp));
      end if;

      --  If Ty_Ext is tagged, assume that objects of dynamic type Ty_Ext have
      --  an empty extension.

      if Is_Tagged_Type (Ty_Ext) then
         T :=
           New_And_Pred
             (Left  => T,
              Right =>
                New_Conditional
                  (Condition =>
                     New_Comparison
                       (Symbol => Why_Eq,
                        Left   =>
                          +New_Tag_Access
                             (Domain => EW_Term, Name => +Expr, Ty => Ty_Ext),
                        Right  => +E_Symb (Ty_Ext, WNE_Tag)),
                   Then_Part =>
                     New_Comparison
                       (Symbol => Why_Eq,
                        Left   =>
                          +New_Ext_Access
                             (Name =>
                                New_Fields_Access
                                  (Name => +Expr, Ty => Ty_Ext),
                              Ty   => Ty_Ext),
                        Right  => +E_Symb (Ty_Ext, WNE_Null_Extension))));
      end if;

      --  Compute dynamic invariant for its components

      if Is_Array_Type (Ty_Ext)
        and then Ekind (Ty_Ext) /= E_String_Literal_Subtype
      then
         --  Add the well_formed property of the array type

         T := New_And_Pred (Left => T, Right => New_Well_Formed_Pred (Expr));

         --  Generates:
         --  forall i1 .. in : int. in_range i1 /\ .. /\ in_range in ->
         --    Dynamic_Invariant (get <Expr> i1 .. in)

         T :=
           New_And_Pred
             (Left => T, Right => Invariant_For_Array (Expr, Ty_Ext));

      elsif Is_Record_Type (Ty_Ext)
        or else Is_Incomplete_Or_Private_Type (Ty_Ext)
        or else Is_Concurrent_Type (Ty_Ext)
      then

         --  Generates:
         --  (check_for_f1 <Expr> -> Dynamic_Invariant <Expr>.rec__f1)
         --  /\ .. /\ (check_for_fn <Expr> -> Dynamic_Invariant <Expr>.rec__fn)
         --  As discriminants may occur in bounds of types of other fields,
         --  store them in the Symbol_Table.

         T :=
           New_And_Pred
             (Left => T, Right => Invariant_For_Record (Expr, Ty_Ext));

         --  Take into account the potential dynamic property of hardcoded
         --  types.

         if Is_Hardcoded_Entity (Root_Retysp (Ty_Ext)) then
            T :=
              New_And_Pred
                (Left  => T,
                 Right =>
                   Dynamic_Property_For_Hardcoded_Type
                     (Root_Retysp (Ty_Ext), Expr));
         end if;

      elsif Is_Access_Type (Ty_Ext)
        and then not Is_Access_Subprogram_Type (Ty_Ext)
        and then
          Type_Needs_Dynamic_Invariant (Directly_Designated_Type (Ty_Ext))
      then

         --  If the designated type is incomplete and its dynamic invariant is
         --  entirely static, it will be assumed as part of the incomplete type
         --  declaration. Ignore it here.

         if Designates_Incomplete_Type (Repr_Pointer_Type (Ty_Ext))
           and then
             Type_Has_Static_Constraints (Directly_Designated_Type (Ty_Ext))
         then
            null;

         --  For types designating an incomplete type, we cannot always assume
         --  the dynamic property of the designated type as they may be
         --  recursive. If Expand_Incompl is false, we use specific dynamic
         --  predicates stored in Incompl_Access_Dyn_Inv_Map. If there is no
         --  such predicate and New_Preds_Module is not empty, generate a new
         --  temp for them and store them inside New_Incompl_Acc. Usually, the
         --  first time a dynamic predicate will be computed for a type, it
         --  will be declared, so New_Preds_Module should not be empty and
         --  predicates will be created which can be reused later.
         --  Theoretically, it could happen that we are not able to generate
         --  these predicates for Itypes which do not have a preliminary
         --  declaration. We have never seen a case where this happens though.

         elsif Designates_Incomplete_Type (Repr_Pointer_Type (Ty_Ext))
           and then not Expand_Incompl
         then

            --  Search the dynamic invariant for Ty_Ext in the local maps first
            --  so that we get the local name if there is one.

            declare
               use Ada_To_Why_Ident;
               Rep_Ty_Ext  : Type_Kind_Id := Repr_Pointer_Type (Ty_Ext);
               Des_Ty      : Type_Kind_Id :=
                 Retysp (Directly_Designated_Type (Ty_Ext));
               Dyn_Inv_Pos : Ada_To_Why_Ident.Cursor;
               Inserted    : Boolean;

            begin
               --  If Rep_Ty_Ext is an Itype, it might depend on discriminants
               --  of an enclosing record type. In this case, we will not be
               --  able to express the discriminant or bound contraints of its
               --  designated type in a separate predicate. We do this
               --  generation here and generate the separate predicate for the
               --  Etype.

               if Is_Itype (Rep_Ty_Ext)
                 and then
                   (Has_Discriminants (Des_Ty) or else Has_Array_Type (Des_Ty))
                 and then Is_Constrained (Des_Ty)
                 and then
                   not Is_Constrained
                         (Directly_Designated_Type (Etype (Rep_Ty_Ext)))
               then
                  T :=
                    New_And_Pred
                      (Left  => T,
                       Right =>
                         New_Conditional
                           (Condition =>
                              New_Not
                                (Right =>
                                   Pred_Of_Boolean_Term
                                     (New_Pointer_Is_Null_Access
                                        (E => Rep_Ty_Ext, Name => Expr))),
                            Then_Part =>
                              +New_Dynamic_Property
                                 (Domain => EW_Pred,
                                  Ty     => Des_Ty,
                                  Expr   =>
                                    +New_Pointer_Value_Access
                                       (Ada_Node => Types.Empty,
                                        E        => Rep_Ty_Ext,
                                        Name     => +Expr,
                                        Domain   => EW_Term),
                                  Params => Params)));
                  Rep_Ty_Ext := Etype (Rep_Ty_Ext);
                  Des_Ty := Retysp (Directly_Designated_Type (Rep_Ty_Ext));
               end if;

               Dyn_Inv_Pos :=
                 (if Relaxed_Init
                  then Loc_Incompl_Acc_R.Find (Des_Ty)
                  else Loc_Incompl_Acc.Find (Des_Ty));

               if not Has_Element (Dyn_Inv_Pos) then
                  Dyn_Inv_Pos :=
                    (if Relaxed_Init
                     then New_Incompl_Acc_R.Find (Des_Ty)
                     else New_Incompl_Acc.Find (Des_Ty));

                  --  Search in the global map

                  if not Has_Element (Dyn_Inv_Pos) then
                     Dyn_Inv_Pos :=
                       (if Relaxed_Init
                        then Incompl_Access_Dyn_Inv_Map_R.Find (Des_Ty)
                        else Incompl_Access_Dyn_Inv_Map.Find (Des_Ty));

                     --  If it was not found and we are allowed to introduce
                     --  new declarations (New_Preds_Module is set), introduce
                     --  it. We store it both inside Incompl_Access_Dyn_Inv_Map
                     --  and inside New_Incompl_Acc for further treatment.

                     if not Has_Element (Dyn_Inv_Pos)
                       and then New_Preds_Module /= Why_Empty
                     then
                        declare
                           Pred_Name : constant W_Identifier_Id :=
                             New_Identifier
                               (Name   =>
                                  New_Temp_Identifier
                                    (Base_Name => "dynamic_invariant"),
                                Module => New_Preds_Module,
                                Typ    => EW_Bool_Type);
                        begin
                           if Relaxed_Init then
                              Incompl_Access_Dyn_Inv_Map_R.Insert
                                (Des_Ty, Pred_Name);
                              New_Incompl_Acc_R.Insert
                                (Des_Ty,
                                 To_Local (Pred_Name),
                                 Dyn_Inv_Pos,
                                 Inserted);
                           else
                              Incompl_Access_Dyn_Inv_Map.Insert
                                (Des_Ty, Pred_Name);
                              New_Incompl_Acc.Insert
                                (Des_Ty,
                                 To_Local (Pred_Name),
                                 Dyn_Inv_Pos,
                                 Inserted);
                           end if;
                        end;
                     end if;
                  end if;
               end if;

               --  If we have a predicate, call it

               if Has_Element (Dyn_Inv_Pos) then

                  --  The generated predicate uses an empty scope for type
                  --  invariants.

                  Variables_In_Dynamic_Invariant
                    (Des_Ty, Variables, Scop => Types.Empty);

                  declare
                     Vars    : constant W_Expr_Array :=
                       Get_Args_From_Variables (Variables, Params.Ref_Allowed);
                     Num_B   : constant Positive := 5 + Vars'Length;
                     Args    : W_Expr_Array (1 .. Num_B);
                     Main_Ty : constant W_Type_Id :=
                       (if Relaxed_Init
                        then EW_Abstract (Des_Ty, Relaxed_Init => True)
                        else Type_Of_Node (Des_Ty));
                     Inv     : W_Pred_Id;

                  begin
                     --  Use the same parameters as for direct translation of
                     --  designated values.
                     --  All_Global_Inv should not matter here as no part of
                     --  SPARK code should see a pointer to an incomplete type
                     --  with a type invariant which might be relaxed.

                     Args (1) :=
                       Insert_Simple_Conversion
                         (Domain => EW_Term,
                          Expr   =>
                            +New_Pointer_Value_Access
                               (Name => Expr, E => Ty_Ext),
                          To     => Main_Ty);
                     Args (2) := +True_Term;
                     Args (3) := +False_Term;
                     Args (4) := +True_Term;
                     Args (5) := +All_Global_Inv;
                     Args (6 .. Num_B) := Vars;

                     Inv :=
                       New_Call
                         (Name => Element (Dyn_Inv_Pos),
                          Args => Args,
                          Typ  => EW_Bool_Type);

                     --  If Inv_Scop is set, add possible locally assumed type
                     --  invariants. If Inv_Subp is also set, add globally
                     --  assumed type invariants as they won't be included in
                     --  the predicate (as All_Global_Inv is False). Include
                     --  components as the traversal stops here.

                     if Present (Inv_Scop) then
                        Inv :=
                          New_And_Pred
                            (Left  => Inv,
                             Right =>
                               Compute_Type_Invariant
                                 (New_Pointer_Value_Access
                                    (Name => Expr, E => Ty_Ext),
                                  Des_Ty,
                                  Locally_Assumed,
                                  Params,
                                  Use_Pred => Use_Pred,
                                  Scop     => Inv_Scop,
                                  Subp     => Inv_Subp));
                     end if;

                     T :=
                       New_And_Pred
                         (Left  => T,
                          Right =>
                            New_Conditional
                              (Condition =>
                                 New_Not
                                   (Right =>
                                      Pred_Of_Boolean_Term
                                        (New_Pointer_Is_Null_Access
                                           (E => Ty_Ext, Name => Expr))),
                               Then_Part => Inv));
                  end;

               --  Theoretically, it could happen that we are in a context
               --  where we were not able to generate the separate predicate,
               --  typically for Itypes. We have never seen a case where this
               --  happens in practice though, so for now we assert that this
               --  never happens.

               else
                  pragma Assert (False);
               end if;
            end;
         else
            T :=
              New_And_Pred
                (Left => T, Right => Invariant_For_Access (Expr, Ty_Ext));
         end if;
      end if;
   end Compute_Dynamic_Invariant;

   -------------------------------
   -- Compute_Dynamic_Predicate --
   -------------------------------

   function Compute_Dynamic_Predicate
     (Expr          : W_Term_Id;
      Ty            : Type_Kind_Id;
      Params        : Transformation_Params := Body_Params;
      Top_Predicate : W_Term_Id := True_Term) return W_Pred_Id
   is
      Res : W_Pred_Id := True_Pred;

      procedure Add_One_Dynamic_Predicate
        (Type_Instance : Formal_Kind_Id; Pred_Expression : Node_Id);
      --  Add the current dynamic predicate as a conjuct in Res

      -------------------------------
      -- Add_One_Dynamic_Predicate --
      -------------------------------

      procedure Add_One_Dynamic_Predicate
        (Type_Instance : Formal_Kind_Id; Pred_Expression : Node_Id)
      is
         Dyn_Pred  : W_Pred_Id;
         My_Params : Transformation_Params := Params;
      begin
         --  We set the Gen_Marker param to GM_Toplevel to instruct
         --  the translation to generate pretty-printing labels for
         --  the parts of the predicate. We also indicate that the
         --  predicate is effectively inlined here by using the
         --  GP_Inlined_Marker (this last part avoids using the
         --  location of the predicate to place the error message,
         --  which is not desired here).

         My_Params.Gen_Marker := GM_Toplevel;
         Dyn_Pred :=
           Dynamic_Predicate_Expression
             (Expr       => Expr,
              Pred_Param => Type_Instance,
              Pred_Expr  => Pred_Expression,
              Params     => My_Params);

         --  Ignore the top-level predicate if needed

         if Is_False_Boolean (+Top_Predicate)
           and then Retysp (Etype (Type_Instance)) = Retysp (Ty)
         then
            return;
         elsif not Is_True_Boolean (+Top_Predicate)
           and then Retysp (Etype (Type_Instance)) = Retysp (Ty)
         then
            Dyn_Pred :=
              New_Conditional
                (Condition => Pred_Of_Boolean_Term (Top_Predicate),
                 Then_Part => Dyn_Pred);
         end if;

         Res :=
           New_Label
             (Labels => Symbol_Sets.To_Set (NID (GP_Inlined_Marker)),
              Def    => New_And_Pred (Left => Dyn_Pred, Right => Res));
      end Add_One_Dynamic_Predicate;

      procedure Add_All_Dynamic_Predicates is new
        Iterate_Applicable_Predicates (Add_One_Dynamic_Predicate);

      Rep_Ty : constant Entity_Id := Retysp (Ty);
   begin
      Add_All_Dynamic_Predicates (Rep_Ty);

      --  Assume that the object is initialized if it is necessary to check the
      --  predicate.

      if Has_Predicates (Rep_Ty)
        and then Predicate_Requires_Initialization (Rep_Ty)
        and then Is_Init_Wrapper_Type (Get_Type (+Expr))
      then
         Res :=
           New_And_Pred
             (Left  =>
                +Compute_Is_Initialized
                   (E                  => Rep_Ty,
                    Name               => +Expr,
                    Params             => Params,
                    Domain             => EW_Pred,
                    Exclude_Components => Relaxed,
                    No_Predicate_Check => True),
              Right => Res);
      end if;

      return Res;
   end Compute_Dynamic_Predicate;

   -------------------------------
   -- Compute_Exceptional_Store --
   -------------------------------

   procedure Compute_Exceptional_Store
     (Formal         : Formal_Kind_Id;
      Pattern        : Item_Type;
      Actual         : N_Subexpr_Id;
      Need_Store     : Boolean;
      No_Pred_Checks : Boolean;
      Pre_Expr       : W_Expr_Id;
      Store          : in out W_Statement_Sequence_Id;
      Params         : Transformation_Params;
      Index_Map      : Ada_Node_To_Why_Id.Map;
      Ext_Visible    : Boolean) is
   begin
      --  Parameters of a "by reference" type are handled like in normal return

      if By_Reference (Formal) then
         Compute_Store
           (Pattern        => Pattern,
            Actual         => Actual,
            Need_Store     => Need_Store,
            No_Pred_Checks => No_Pred_Checks,
            Pre_Expr       => Pre_Expr,
            Store          => Store,
            Params         => Params,
            Index_Map      => Index_Map,
            Ext_Visible    => Ext_Visible,
            Exceptional    => True);
         return;

      --  If there can be an exception, then parameters of a "by copy" type
      --  should have a temporary reference. They are not modified by the call
      --  so no store is needed.

      elsif By_Copy (Formal) then
         return;
      end if;

      --  Add a continuation locating the potential checks on the copy-back

      Continuation_Stack.Append
        (Continuation_Type'
           (Ada_Node => Actual,
            Message  =>
              To_Unbounded_String
                ("in value of subprogram parameter after the call")
              & " when an exception is raised"));

      --  Parameters which are not "by copy" might have been modified by the
      --  call in a way which makes them uninitialized. We havoc them. No
      --  checks are performed.

      declare
         Actual_T      : constant W_Type_Id := Type_Of_Node (Actual);
         Result_Id     : constant W_Identifier_Id :=
           New_Result_Ident (Actual_T);
         Post          : constant W_Pred_Id :=
           Compute_Dynamic_Inv_And_Initialization
             (Expr        => +Result_Id,
              Ty          => Etype (Actual),
              Params      => Params,
              Initialized => False_Term);
         --  The validity status does not matter as the object is only assumed
         --  valid if it is initialized.
         Unknown_Value : constant W_Prog_Id :=
           New_Any_Expr
             (Ada_Node    => Actual,
              Post        => Post,
              Return_Type => Actual_T,
              Labels      => Symbol_Sets.Empty_Set);

      begin
         Append
           (Store,
            New_Assignment
              (Ada_Node  => Actual,
               Lvalue    => Actual,
               Expr      => Unknown_Value,
               Do_Check  => No_Checks,
               Index_Map => Index_Map));
      end;

      --  Also havoc the validity flag of the actual if any. The object will
      --  be considered as unintialized, but the check could be accepted.

      if Present (Actual) and then Is_Potentially_Invalid_Expr (Actual) then
         Append
           (Store,
            New_Validity_Tree_Assignment
              (LHS       => Actual,
               New_Tree  =>
                 New_Any_Expr
                   (Return_Type => Get_Validity_Tree_Type (Etype (Actual)),
                    Labels      => Symbol_Sets.Empty_Set),
               Params    => Params,
               Index_Map => Index_Map));
      end if;

      --  If discriminants are mutable we need to assume preservation
      --  of the discriminants if the actual is constrained.

      if Pattern.Kind = DRecord
        and then Pattern.Discrs.Present
        and then Pattern.Discrs.Binder.Mutable
      then
         declare
            Discr_Name : constant W_Identifier_Id :=
              Pattern.Discrs.Binder.B_Name;
            Assumption : W_Pred_Id;
         begin
            --  If the formal has mutable discriminants,
            --  store in Assumption that its discriminants
            --  cannot have been modified if the actual is
            --  constrained.

            Assumption :=
              New_Call
                (Typ  => EW_Bool_Type,
                 Name => Why_Eq,
                 Args =>
                   (1 =>
                      New_Deref
                        (Right => Discr_Name, Typ => Get_Typ (Discr_Name)),
                    2 =>
                      New_Discriminants_Access
                        (Name => Pre_Expr, Ty => Pattern.Typ)));

            Assumption :=
              New_Conditional
                (Condition =>
                   +New_Constrained_Attribute_Expr
                      (Domain => EW_Term, Prefix => Actual),
                 Then_Part => Assumption);

            Append (Store, New_Assume_Statement (Pred => Assumption));
         end;

         --  Objects with relaxed initialization should be considered to be
         --  potentially unintialized by the call. However, we do not have
         --  top level initialization flags for types with mutable
         --  discriminants (and access types, but such parameters are either by
         --  copy or by reference). Introduce an unprovable initialization
         --  check at the point of call if the actual is unconstrained instead.

         if Is_Simple_Actual (Actual)
           and then Obj_Has_Relaxed_Init (Entity (Actual))
         then
            --  Emit a warning stating the proof enforces initialization of
            --  mutable discriminants.

            Warning_Msg_N (Warn_Relaxed_Init_Mutable_Discr, Actual);

            Append
              (Store,
               New_Ignore
                 (Prog =>
                    New_Located_Assert
                      (Ada_Node   => Actual,
                       Pred       =>
                         +New_Constrained_Attribute_Expr
                            (Domain => EW_Term, Prefix => Actual),
                       Reason     => VC_Initialization_Check,
                       Kind       => EW_Assert,
                       Check_Info =>
                         New_Check_Info
                           (Details =>
                              "mutable discriminants of actual parameters are "
                              & "considered to be uninitialized if the call "
                              & "propagates an exception"))));
         end if;
      end if;

      --  Pop the continuation

      Continuation_Stack.Delete_Last;
   end Compute_Exceptional_Store;

   ----------------------------------
   -- Compute_Guard_For_Exceptions --
   ----------------------------------

   function Compute_Guard_For_Exceptions
     (Choices : List_Id; Exc_Id : W_Identifier_Id; Domain : EW_Domain)
      return W_Expr_Id
   is
      Exc  : Node_Id := First (Choices);
      Cond : W_Expr_Id := New_Literal (Value => EW_False, Domain => Domain);
   begin
      while Present (Exc) loop
         case Nkind (Exc) is
            when N_Identifier | N_Expanded_Name =>
               Cond :=
                 New_Or_Expr
                   (Cond,
                    New_Comparison
                      (Why_Eq, +Exc_Id, +To_Why_Id (Entity (Exc)), Domain),
                    Domain);

            when others                         =>
               raise Program_Error;
         end case;
         Next (Exc);
      end loop;
      return Cond;
   end Compute_Guard_For_Exceptions;

   -----------------------------------
   -- Compute_Is_Moved_Or_Reclaimed --
   -----------------------------------

   function Compute_Is_Moved_Or_Reclaimed
     (Expr : W_Term_Id; Tree : W_Term_Id; Ty : Type_Kind_Id) return W_Pred_Id
   is
      Typ : constant W_Type_Id :=
        (if Has_Init_Wrapper (Ty)
         then EW_Init_Wrapper (Type_Of_Node (Ty))
         else Type_Of_Node (Ty));
      Val : constant W_Term_Id :=
        Insert_Simple_Conversion (Expr => Expr, To => Typ);
   begin
      return
        New_Call
          (Name => E_Symb (Ty, WNE_Is_Moved_Or_Reclaimed),
           Args => (+Tree, +Val));
   end Compute_Is_Moved_Or_Reclaimed;

   ----------------------------------------
   -- Compute_Is_Reclaimed_For_Ownership --
   ----------------------------------------

   function Compute_Is_Reclaimed_For_Ownership
     (Expr : W_Term_Id; Ty : Type_Kind_Id; For_Check : Boolean)
      return W_Pred_Id
   is
      Reclamation_Entity : Entity_Id;
      Kind               : Reclamation_Kind;
      Check_Param        : Item_Type;

   begin
      --  Get the check function for Ty if any

      Get_Reclamation_Entity
        (Retysp (Ty), Reclamation_Entity, Kind, For_Check);

      --  If no check functions or constants are supplied, consider
      --  the value is never reclaimed. It can still have been moved.

      if No (Reclamation_Entity) then
         return False_Pred;

      elsif Kind = Reclaimed_Value then
         pragma Assert (Ekind (Reclamation_Entity) = E_Constant);
         return
           +New_Ada_Equality
              (Typ    => Retysp (Ty),
               Domain => EW_Pred,
               Left   =>
                 Insert_Simple_Conversion
                   (Expr   => +Expr,
                    Domain => EW_Term,
                    To     => Type_Of_Node (Reclamation_Entity)),
               Right  =>
                 Transform_Identifier
                   (Params => Logic_Params,
                    Expr   => Reclamation_Entity,
                    Ent    => Reclamation_Entity,
                    Domain => EW_Term));

      else
         pragma Assert (Ekind (Reclamation_Entity) = E_Function);
         declare
            Check_Params : constant Item_Array :=
              Compute_Subprogram_Parameters (Reclamation_Entity, EW_Term);
         begin
            pragma Assert (Check_Params'Length = 1);
            Check_Param := Check_Params (Check_Params'First);
         end;

         return
           New_Comparison
             (Symbol => Why_Eq,
              Left   =>
                (if Kind = Is_Reclaimed then True_Term else False_Term),
              Right  =>
                New_Call
                  (Name =>
                     +Transform_Identifier
                        (Params => Logic_Params,
                         Expr   => Reclamation_Entity,
                         Ent    => Reclamation_Entity,
                         Domain => EW_Term),
                   Args =>
                     (1 =>
                        Insert_Simple_Conversion
                          (Expr   => +Expr,
                           Domain => EW_Term,
                           To     => Get_Why_Type_From_Item (Check_Param))),
                   Typ  => EW_Bool_Type));
      end if;
   end Compute_Is_Reclaimed_For_Ownership;

   -----------------------------------
   -- Compute_Record_Component_Size --
   -----------------------------------

   procedure Compute_Record_Component_Size
     (Comp         : Entity_Id;
      Typ          : Type_Kind_Id;
      Domain       : EW_Domain;
      Dynamic_Size : out W_Expr_Id;
      Precise      : out Boolean;
      Explanation  : out Unbounded_String)
   is
      Size_Str  : Unbounded_String;
      Comp_Size : Uint;

   begin
      Precise := True;

      Record_Component_Size (Typ, Comp, Comp_Size, Size_Str, Explanation);

      if Present (Comp_Size) then
         Dynamic_Size := New_Integer_Constant (Value => Comp_Size);
      else
         Compute_Size_Of_Type
           (Typ          => Retysp (Etype (Comp)),
            Object_Size  => not Is_Packed (Typ),
            Domain       => Domain,
            Dynamic_Size => Dynamic_Size,
            Precise      => Precise,
            Explanation  => Explanation);
      end if;
   end Compute_Record_Component_Size;

   ----------------------------
   -- Compute_Size_Of_Object --
   ----------------------------

   procedure Compute_Size_Of_Object
     (Expr         : Node_Or_Entity_Id;
      Domain       : EW_Domain;
      Params       : Transformation_Params;
      Dynamic_Size : out W_Expr_Id;
      Precise      : out Boolean;
      Explanation  : out Unbounded_String)
   is

      procedure Compute_Size_From_Type (Typ : Type_Kind_Id);
      --  Compute the size of a standalone object or dereference
      --  Expr of type Typ.
      --  Set Precise to False if the translation uses an abstract object. In
      --  this case also set Explanation.

      ----------------------------
      -- Compute_Size_From_Type --
      ----------------------------

      procedure Compute_Size_From_Type (Typ : Type_Kind_Id) is
      begin
         --  If Typ is constrained, use its Object_Size

         if not Is_Composite_Type (Typ) or else Is_Constrained (Typ) then
            Compute_Size_Of_Type
              (Typ          => Typ,
               Object_Size  => True,
               Domain       => Domain,
               Dynamic_Size => Dynamic_Size,
               Precise      => Precise,
               Explanation  => Explanation);

         --  For unconstrained arrays, compute the size from the number of
         --  elements if possible.

         elsif Is_Array_Type (Typ)
           and then Array_Size_Is_Sum_Of_Components (Typ)
         then
            declare
               Arr_Expr : constant W_Expr_Id :=
                 New_Temp_For_Expr
                   (Transform_Expr_Or_Identifier
                      (Expr, Term_Domain (Domain), Params));

            begin
               Compute_Array_Component_Size
                 (Typ, Domain, Dynamic_Size, Precise, Explanation);

               for I in 1 .. Natural (Number_Dimensions (Typ)) loop
                  Dynamic_Size :=
                    New_Call
                      (Domain => Domain,
                       Name   => Int_Infix_Mult,
                       Args   =>
                         (1 => Dynamic_Size,
                          2 =>
                            Build_Length_Expr
                              (Domain => Domain, Expr => Arr_Expr, Dim => I)),
                       Typ    => EW_Int_Type);
               end loop;

               Dynamic_Size :=
                 Binding_For_Temp
                   (Domain  => Domain,
                    Tmp     => Arr_Expr,
                    Context => Dynamic_Size);
            end;

         --  Otherwise, use Attr_Size_Of_Object

         elsif Is_Array_Type (Typ) then
            declare
               Arr_Expr : constant W_Expr_Id :=
                 New_Temp_For_Expr
                   (Transform_Expr_Or_Identifier
                      (Expr, Term_Domain (Domain), Params));
               Bounds   :
                 W_Expr_Array (1 .. Positive (Number_Dimensions (Typ)) * 2);
               Pos      : Positive := 1;
            begin
               for I in 1 .. Natural (Number_Dimensions (Typ)) loop
                  Add_Attr_Arg
                    (Domain, Bounds, Arr_Expr, Attribute_First, I, Pos);
                  Add_Attr_Arg
                    (Domain, Bounds, Arr_Expr, Attribute_Last, I, Pos);
               end loop;

               Dynamic_Size :=
                 Binding_For_Temp
                   (Domain  => Domain,
                    Tmp     => Arr_Expr,
                    Context =>
                      New_Call
                        (Domain => Domain,
                         Name   => E_Symb (Typ, WNE_Attr_Size_Of_Object),
                         Args   => Bounds,
                         Typ    => EW_Int_Type));
               Precise := False;
               Explanation :=
                 To_Unbounded_String
                   (Pretty_Source_Name (Typ) & " is unconstrained");
            end;
         else
            pragma Assert (Has_Discriminants (Typ));
            Dynamic_Size :=
              New_Call
                (Domain => Domain,
                 Name   => E_Symb (Typ, WNE_Attr_Size_Of_Object),
                 Args   =>
                   (1 =>
                      New_Discriminants_Access
                        (Name =>
                           Transform_Expr_Or_Identifier
                             (Expr, Term_Domain (Domain), Params),
                         Ty   => Typ)),
                 Typ    => EW_Int_Type);
            Precise := False;
            Explanation :=
              To_Unbounded_String
                (Pretty_Source_Name (Typ) & " is unconstrained");
         end if;
      end Compute_Size_From_Type;

      Typ         : constant Entity_Id := Retysp (Etype (Expr));
      Static_Size : Uint;

   begin
      Precise := True;

      case Nkind (Expr) is
         when N_Identifier | N_Expanded_Name | N_Defining_Identifier =>
            declare
               Obj : constant Entity_Id :=
                 (if Nkind (Expr) = N_Defining_Identifier
                  then Expr
                  else Entity (Expr));
            begin
               pragma
                 Assert (Ekind (Obj) in Formal_Kind | E_Constant | E_Variable);

               --  Use the Size aspect of Var if it is supplied

               Static_Size := Get_Attribute_Value (Obj, Attribute_Size);

               if Present (Static_Size) then
                  Dynamic_Size := New_Integer_Constant (Value => Static_Size);

               --  For objects with mutable discriminants, use the object size
               --  of the type if they are unconstrained.

               elsif Has_Mutable_Discriminants (Retysp (Etype (Expr))) then

                  pragma Assert (Nkind (Expr) in N_Subexpr);

                  if Attr_Constrained_Statically_Known (Expr) then
                     if Attribute_Constrained_Static_Value (Expr) then
                        Compute_Size_From_Type (Typ);
                     else
                        Compute_Size_Of_Type
                          (Typ,
                           True,
                           Domain,
                           Dynamic_Size,
                           Precise,
                           Explanation);
                     end if;
                  else
                     Compute_Size_From_Type (Typ);

                     declare
                        Typ_Size    : W_Expr_Id;
                        Typ_Expl    : Unbounded_String;
                        Typ_Precise : Boolean;
                     begin
                        Compute_Size_Of_Type
                          (Typ, True, Domain, Typ_Size, Typ_Precise, Typ_Expl);
                        Dynamic_Size :=
                          New_Conditional
                            (Domain    => Domain,
                             Condition =>
                               New_Constrained_Attribute_Expr (Expr, Domain),
                             Then_Part => Dynamic_Size,
                             Else_Part => Typ_Size,
                             Typ       => EW_Int_Type);

                        if not Typ_Precise then
                           Explanation :=
                             (if Precise
                              then ""
                              else To_String (Explanation) & " and ")
                             & Typ_Expl;
                           Precise := False;
                        end if;
                     end;
                  end if;

               --  Otherwise compute the size from the subtype of the object

               else
                  Compute_Size_From_Type (Typ);
               end if;

               if not Precise and then Ekind (Obj) in E_Constant | E_Variable
               then
                  Explanation :=
                    "object does not have a Size aspect and " & Explanation;
               end if;
            end;

         when N_Explicit_Dereference                                 =>
            Compute_Size_From_Type (Typ);

         when N_Selected_Component                                   =>
            declare
               R_Typ : constant Type_Kind_Id := Retysp (Etype (Prefix (Expr)));
               Comp  : constant Entity_Id := Entity (Selector_Name (Expr));
            begin
               Compute_Record_Component_Size
                 (Comp, R_Typ, Domain, Dynamic_Size, Precise, Explanation);
            end;

         when N_Indexed_Component                                    =>
            declare
               A_Typ : constant Type_Kind_Id := Retysp (Etype (Prefix (Expr)));

            begin
               Compute_Array_Component_Size
                 (A_Typ, Domain, Dynamic_Size, Precise, Explanation);
            end;

         when N_Slice                                                =>
            declare
               Typ : constant Type_Kind_Id := Retysp (Etype (Prefix (Expr)));

            begin
               pragma Assert (Array_Size_Is_Sum_Of_Components (Typ));

               --  The size of a slice is always computed
               --  dynamically for now.

               Compute_Array_Component_Size
                 (Typ, Domain, Dynamic_Size, Precise, Explanation);

               Dynamic_Size :=
                 New_Call
                   (Domain => Domain,
                    Name   => Int_Infix_Mult,
                    Args   =>
                      (1 => Dynamic_Size,
                       2 =>
                         Build_Length_Expr
                           (Domain => Domain,
                            First  =>
                              +Transform_Term
                                 (Expr          =>
                                    Low_Bound (Discrete_Range (Expr)),
                                  Expected_Type => EW_Int_Type,
                                  Params        => Params),
                            Last   =>
                              +Transform_Term
                                 (Expr          =>
                                    High_Bound (Discrete_Range (Expr)),
                                  Expected_Type => EW_Int_Type,
                                  Params        => Params))),
                    Typ    => EW_Int_Type);
            end;

         --  'Result is handled as a constant standalone object.
         --  It is always constrained and cannot have a Size annotation.

         when N_Attribute_Reference                                  =>
            pragma
              Assert
                (Get_Attribute_Id (Attribute_Name (Expr)) = Attribute_Result);
            Compute_Size_From_Type (Typ);

         --  Only parts of objects are supported for now

         when others                                                 =>
            raise Program_Error;
      end case;
   end Compute_Size_Of_Object;

   --------------------------
   -- Compute_Size_Of_Type --
   --------------------------

   procedure Compute_Size_Of_Type
     (Typ          : Type_Kind_Id;
      Object_Size  : Boolean;
      Domain       : EW_Domain;
      Dynamic_Size : out W_Expr_Id;
      Precise      : out Boolean;
      Explanation  : out Unbounded_String)
   is
      Static_Size : Uint;

   begin
      Precise := True;

      --  If Typ has a static Size or Object_Size, use it

      Static_Size :=
        Get_Attribute_Value
          (Typ,
           (if Object_Size then Attribute_Object_Size else Attribute_Size));

      if Present (Static_Size) then
         Dynamic_Size := New_Integer_Constant (Value => Static_Size);

      --  For arrays, try to reconstruct the size from the component size
      --  if possible.

      elsif Is_Constrained (Typ)
        and then Is_Array_Type (Typ)
        and then Array_Size_Is_Sum_Of_Components (Typ)
      then
         Compute_Array_Component_Size
           (Typ, Domain, Dynamic_Size, Precise, Explanation);

         for I in 1 .. Natural (Number_Dimensions (Typ)) loop
            Dynamic_Size :=
              New_Call
                (Domain => Domain,
                 Name   => Int_Infix_Mult,
                 Args   =>
                   (1 => Dynamic_Size,
                    2 =>
                      Build_Length_Expr
                        (Domain => Domain, Ty => Typ, Dim => I)),
                 Typ    => EW_Int_Type);
         end loop;

      --  Use the constants declared in the type's module

      elsif Object_Size then
         Dynamic_Size :=
           New_Call
             (Domain => Domain,
              Name   => E_Symb (Typ, WNE_Attr_Object_Size),
              Typ    => EW_Int_Type);
         Precise := False;
         Explanation :=
           To_Unbounded_String
             ("Object_Size of " & Pretty_Source_Name (Typ) & " is missing");
      else
         Dynamic_Size := New_Attribute_Expr (Typ, Domain, Attribute_Size);
         Precise := False;
         Explanation :=
           To_Unbounded_String
             ("Size of " & Pretty_Source_Name (Typ) & " is missing");
      end if;
   end Compute_Size_Of_Type;

   -------------------
   -- Compute_Store --
   -------------------

   procedure Compute_Store
     (Pattern        : Item_Type;
      Actual         : Opt_N_Subexpr_Id;
      Need_Store     : Boolean;
      No_Pred_Checks : Boolean;
      Pre_Expr       : W_Expr_Id;
      Store          : in out W_Statement_Sequence_Id;
      Params         : Transformation_Params;
      Index_Map      : Ada_Node_To_Why_Id.Map;
      Ext_Visible    : Boolean;
      Exceptional    : Boolean := False)
   is
      Do_Valid : constant Boolean :=
        Present (Actual) and then Is_Potentially_Invalid_Expr (Actual);

   begin
      --  Add a continuation locating the potential checks on the copy-back

      if Present (Actual) then
         Continuation_Stack.Append
           (Continuation_Type'
              (Ada_Node => Actual,
               Message  =>
                 To_Unbounded_String
                   ("in value of subprogram parameter after the call")
                 & (if Exceptional
                    then " when an exception is raised"
                    else "")));
      end if;

      --  If needed, recompute the actual expression and store it in Actual.
      --  No need to preserve the tag as it cannot have been modified by the
      --  call (as the formal is split). The extension might have been
      --  modified if Ext_Visible is True.

      if Need_Store then
         declare
            Reconstructed_Arg : constant W_Prog_Id :=
              Reconstruct_Actual_From_Item
                (Pattern   => Pattern,
                 Actual    => Actual,
                 No_Checks => False,
                 Pre_Expr  => Pre_Expr);

         begin
            Append
              (Store,
               New_Assignment
                 (Ada_Node    => Actual,
                  Lvalue      => Actual,
                  Expr        => Reconstructed_Arg,
                  Do_Check    => Only_Vars,
                  Preserv_Tag => False,
                  Index_Map   => Index_Map));
         end;

      --  If no store is needed, we might still need to reset the move tree
      --  associated to Actual if the assignment is a move.

      elsif Present (Actual)
        and then Contains_Allocated_Parts (Etype (Actual))
        and then not Is_Anonymous_Access_Type (Etype (Actual))
      then
         pragma Assert (not Traverse_Access_To_Constant (Actual));
         Append
           (Store,
            New_Move_Tree_Assignment
              (Lvalue    => Actual,
               Expr      =>
                 New_Any_Expr
                   (Return_Type =>
                      Get_Move_Tree_Type
                        (Expected_Type_For_Move_Tree (Actual)),
                    Labels      => Symbol_Sets.Empty_Set),
               Index_Map => Index_Map));

      --  There might not be an actual for the self parameter of protected
      --  object.

      elsif No (Actual)
        and then Pattern.Kind = Concurrent_Self
        and then Contains_Allocated_Parts (Pattern.Main.Ada_Node)
      then
         declare
            Prot : constant Entity_Id := Pattern.Main.Ada_Node;
            Typ  : constant W_Type_Id := Get_Move_Tree_Type (Prot);
            pragma Assert (Ekind (Prot) = E_Protected_Type);

         begin
            Append
              (Store,
               New_Assignment
                 (Name   => Concurrent_Self_Move_Tree_Id (Prot),
                  Value  =>
                    New_Any_Expr
                      (Return_Type => Typ, Labels => Symbol_Sets.Empty_Set),
                  Typ    => Typ,
                  Labels => Symbol_Sets.Empty_Set));
         end;
      end if;

      --  If the formal has a validity flag that is not propagated to the
      --  actual, introduce a validity check.

      if Pattern.Valid.Present and then not Propagates_Validity_Flag (Actual)
      then
         Append
           (Store,
            New_Located_Assert
              (Ada_Node => Actual,
               Pred     =>
                 +New_Is_Valid_Call_For_Expr
                    (Tree   =>
                       +Get_Valid_Id_From_Item (Pattern, Params.Ref_Allowed),
                     Ty     => Get_Ada_Type_From_Item (Pattern),
                     Expr   => Pre_Expr,
                     Domain => EW_Pred),
               Reason   => VC_Validity_Check,
               Kind     => EW_Assert));
      end if;

      --  Handle the validity flag on the actual if any. It might be necessary
      --  to slide it if the parameter is an array.

      if Do_Valid then
         declare
            Valid_Flag : W_Prog_Id :=
              (if Propagates_Validity_Flag (Actual)
                 and then Pattern.Valid.Present
               then +Get_Valid_Id_From_Item (Pattern, Params.Ref_Allowed)
               else +New_Valid_Value_For_Type (Etype (Actual)));

         begin
            --  For array types, it might be necessary to slide the validity
            --  tree if the actual was slided on input of the call.

            if Pattern.Valid.Present
              and then Has_Array_Type (Etype (Actual))
              and then
                Needs_Slide (Etype (Actual), Get_Ada_Type_From_Item (Pattern))
            then
               Valid_Flag :=
                 +New_Validity_Tree_Slide
                    (Tree   => +Valid_Flag,
                     Expr   => Pre_Expr,
                     To     => Type_Of_Node (Actual),
                     Domain => EW_Prog,
                     Params => Params);
            end if;

            Append
              (Store,
               New_Validity_Tree_Assignment
                 (LHS       => Actual,
                  New_Tree  => Valid_Flag,
                  Params    => Params,
                  Index_Map => Index_Map));
         end;
      end if;

      --  Handle the initialization flag on the actual if any

      if Present (Actual) and then Is_Simple_Actual (Actual) then
         declare
            Actual_Binder : constant Item_Type :=
              Ada_Ent_To_Why.Element (Symbol_Table, Entity (Actual));

         begin
            --  Assign the initialization flag if any

            if Actual_Binder.Init.Present then

               --  On exceptional paths, get the flag from the parameter if
               --  any. Ada does not mandate initialization in that case.

               if Exceptional and then Pattern.Init.Present then
                  Append
                    (Store,
                     New_Assignment
                       (Ada_Node => Actual,
                        Name     => Actual_Binder.Init.Id,
                        Value    =>
                          New_Deref
                            (Right => Pattern.Init.Id,
                             Typ   => Get_Typ (Pattern.Init.Id)),
                        Typ      => EW_Bool_Type,
                        Labels   => Symbol_Sets.Empty_Set));

               --  Otherwise, the parameter has been initialized

               else
                  Append
                    (Store,
                     New_Assignment
                       (Ada_Node => Actual,
                        Name     => Actual_Binder.Init.Id,
                        Value    => True_Prog,
                        Typ      => EW_Bool_Type,
                        Labels   => Symbol_Sets.Empty_Set));
               end if;
            end if;
         end;
      end if;

      --  If discriminants are mutable we need to assume preservation
      --  of the discriminants if the actual is constrained.

      if Pattern.Kind = DRecord
        and then Pattern.Discrs.Present
        and then Pattern.Discrs.Binder.Mutable
      then
         declare
            Discr_Name : constant W_Identifier_Id :=
              Pattern.Discrs.Binder.B_Name;
            Assumption : W_Pred_Id;
         begin
            --  If the formal has mutable discriminants,
            --  store in Assumption that its discriminants
            --  cannot have been modified if the actual is
            --  constrained.

            Assumption :=
              New_Call
                (Typ  => EW_Bool_Type,
                 Name => Why_Eq,
                 Args =>
                   (1 =>
                      New_Deref
                        (Right => Discr_Name, Typ => Get_Typ (Discr_Name)),
                    2 =>
                      New_Discriminants_Access
                        (Name => Pre_Expr, Ty => Pattern.Typ)));

            Assumption :=
              New_Conditional
                (Condition =>
                   +New_Constrained_Attribute_Expr
                      (Domain => EW_Term, Prefix => Actual),
                 Then_Part => Assumption);

            Append (Store, New_Assume_Statement (Pred => Assumption));
         end;
      end if;

      --  If the parameter has a tagged type and its extension is not visible
      --  in the callee, assume that it is preserved.

      if not Ext_Visible
        and then Pattern.Kind = DRecord
        and then Is_Tagged_Type (Pattern.Typ)
      then
         declare
            Fields_Name : constant W_Identifier_Id :=
              Pattern.Fields.Binder.B_Name;
         begin
            Append
              (Store,
               New_Assume_Statement
                 (Pred =>
                    New_Comparison
                      (Symbol => Why_Eq,
                       Left   =>
                         +New_Ext_Access
                            (Name =>
                               New_Fields_Access
                                 (Name => Pre_Expr, Ty => Pattern.Typ),
                             Ty   => Pattern.Typ),
                       Right  =>
                         +New_Ext_Access
                            (Name =>
                               New_Deref
                                 (Right => Fields_Name,
                                  Typ   => Get_Typ (Fields_Name)),
                             Ty   => Pattern.Typ))));
         end;
      end if;

      --  If needed, perform the check for a dynamic predicate and null
      --  exclusion of access types on OUT and
      --  IN OUT parameters on return from the call. This check is not done
      --  as part of the conversion from formal to actual parameter, as
      --  the check done in conversions also involves invariant properties
      --  of the type (array bounds, record discriminants, etc.). Thus,
      --  conversion is done with Insert_Simple_Conversion in domain
      --  EW_Pterm, which does not introduce checks, and the required
      --  check for dynamic predicate is introduced here.

      --  The case of scalar types is different, as the conversion from
      --  formal to actual on OUT and IN OUT parameters is performed with
      --  checks, using Insert_Checked_Conversion in domain EW_Prog, so do
      --  not repeat the check here.

      declare
         Need_Pred_Check_On_Store : constant Boolean :=
           not No_Pred_Checks
           and then not Is_Scalar_Type (Retysp (Etype (Actual)))
           and then Item_Is_Mutable (Pattern);
      begin
         if Present (Actual) and then Need_Pred_Check_On_Store then
            declare
               Postfetch_Actual : constant W_Prog_Id :=
                 Transform_Prog (Actual, Params, Checks => False);

            begin
               --  Generate a predicate check if the actual has a predicate

               if Has_Predicates (Retysp (Etype (Actual))) then
                  Append
                    (Store,
                     New_Predicate_Check
                       (Actual, Etype (Actual), +Postfetch_Actual));
               end if;

               --  Generate a null exclusion check if the actual cannot be
               --  null but the formal can.

               if Is_Access_Type (Retysp (Etype (Actual)))
                 and then Can_Never_Be_Null (Retysp (Etype (Actual)))
                 and then
                   not Can_Never_Be_Null (Get_Ada_Type_From_Item (Pattern))
                 and then Pattern.Mutable
               then
                  Append
                    (Store,
                     New_Binding
                       (Ada_Node => Actual,
                        Name     =>
                          New_Identifier
                            (Domain => EW_Prog,
                             Name   => "_",
                             Typ    => Get_Type (+Postfetch_Actual)),
                        Def      =>
                          New_VC_Call
                            (Ada_Node => Actual,
                             Name     =>
                               To_Program_Space
                                 (E_Symb
                                    (Etype (Actual), WNE_Assign_Null_Check)),
                             Progs    => (1 => +Postfetch_Actual),
                             Reason   => VC_Null_Exclusion,
                             Typ      => Get_Type (+Postfetch_Actual)),
                        Context  => +Void,
                        Typ      => EW_Unit_Type));
               end if;
            end;
         end if;
      end;

      --  Pop the continuation if any

      if Present (Actual) then
         Continuation_Stack.Delete_Last;
      end if;
   end Compute_Store;

   -----------------------
   -- Compute_Tag_Check --
   -----------------------

   function Compute_Tag_Check
     (Call : Node_Id; Params : Transformation_Params) return W_Prog_Id
   is
      Controlling_Arg : constant Node_Id := Controlling_Argument (Call);
      Control_Tag     : W_Expr_Id := Why_Empty;
      Check           : W_Pred_Id := True_Pred;
      Needs_Check     : Boolean := False;

      procedure One_Param (Formal : Entity_Id; Actual : Node_Id)
      with
        Pre  => Needs_Check = Present (Control_Tag),
        Post => Needs_Check = Present (Control_Tag);
      --  Compute a Why expression for each parameter

      ---------------
      -- One_Param --
      ---------------

      procedure One_Param (Formal : Entity_Id; Actual : Node_Id) is
         pragma Unreferenced (Formal);
         New_Check : W_Pred_Id;
      begin
         if not Is_Controlling_Actual (Actual) or else Actual = Controlling_Arg
         then
            return;
         end if;

         --  We have found a controlling argument different from the first one.
         --  We need a check. If it's the first time we come here, we need to
         --  compute the reference tag first

         if not Needs_Check then
            Needs_Check := True;
            declare
               Tmp : constant W_Expr_Id :=
                 Transform_Expr (Controlling_Arg, EW_Term, Params);
            begin
               Control_Tag :=
                 New_Tag_Access
                   (Ada_Node => Controlling_Arg,
                    Domain   => EW_Term,
                    Name     => Tmp,
                    Ty       => Get_Ada_Node (+Get_Type (Tmp)));
            end;
         end if;
         declare
            Tmp : constant W_Expr_Id :=
              Transform_Expr (Actual, EW_Term, Params);
         begin
            New_Check :=
              New_Call
                (Name => Why_Eq,
                 Typ  => EW_Bool_Type,
                 Args =>
                   (1 => Control_Tag,
                    2 =>
                      New_Tag_Access
                        (Name     => Tmp,
                         Ada_Node => Actual,
                         Domain   => EW_Term,
                         Ty       => Get_Ada_Node (+Get_Type (Tmp)))));
         end;

         Check := New_And_Pred (Left => Check, Right => New_Check);
      end One_Param;

      procedure Iterate_Call is new Iterate_Call_Parameters (One_Param);

      --  Start of processing for Compute_Tag_Check

   begin
      if No (Controlling_Arg) or else Call_Simulates_Contract_Dispatch (Call)
      then
         return +Void;
      end if;

      Iterate_Call (Call);
      if Needs_Check then
         return
           New_Located_Assert
             (Ada_Node => Call,
              Pred     => Check,
              Reason   => VC_Tag_Check,
              Kind     => EW_Assert);
      else
         return +Void;
      end if;
   end Compute_Tag_Check;

   --------------------------------------
   -- Compute_Top_Level_Type_Invariant --
   --------------------------------------

   function Compute_Top_Level_Type_Invariant
     (Expr     : W_Term_Id;
      Ty       : Type_Kind_Id;
      Params   : Transformation_Params := Body_Params;
      Use_Pred : Boolean := True) return W_Pred_Id
   is
      --  If Ty's fullview is in SPARK, go to its underlying type to check its
      --  kind.

      Rep_Ty : constant Entity_Id := Retysp (Ty);

   begin
      if Has_Invariants_In_SPARK (Rep_Ty) then

         --  If Use_Pred is true, then we already have generated a predicate
         --  for the type invariant of elements of type Ty.

         if Use_Pred then
            return New_Type_Invariant_Call (Rep_Ty, Expr, Params);
         else
            return
              Type_Invariant_Expression
                (Expr     => Expr,
                 Inv_Subp => Invariant_Procedure (Rep_Ty),
                 Params   => Params);
         end if;
      else
         return True_Pred;
      end if;
   end Compute_Top_Level_Type_Invariant;

   ----------------------------
   -- Compute_Type_Invariant --
   ----------------------------

   function Compute_Type_Invariant
     (Expr         : W_Term_Id;
      Ty           : Type_Kind_Id;
      Kind         : Invariant_Kind;
      Params       : Transformation_Params := Body_Params;
      Scop         : Entity_Id := Empty;
      Subp         : Entity_Id := Empty;
      Include_Comp : Boolean := True;
      Use_Pred     : Boolean := True) return W_Pred_Id
   is
      function Include_Inv (Ty : Type_Kind_Id) return Boolean
      with Pre => Has_Invariants_In_SPARK (Ty);
      --  Return True if the top-level invariant of Ty shall be considered

      function Comp_Has_Included_Inv (Ty : Type_Kind_Id) return Test_Result;
      --  Return Pass if Ty or one of its ancestors has a considered invariant

      function Invariant_For_Comp
        (C_Expr : W_Term_Id; C_Ty : Entity_Id; E : Entity_Id) return W_Pred_Id;
      --  @param C_Expr expression for a component
      --  @param C_Ty component type
      --  @param E not referenced
      --  @return predicate for individual components

      function Invariant_For_Comp
        (C_Expr : W_Term_Id; C_Ty : Entity_Id; Dummy : W_Expr_Array)
         return W_Pred_Id
      is (Invariant_For_Comp (C_Expr, C_Ty, Empty));

      ---------------------------
      -- Comp_Has_Included_Inv --
      ---------------------------

      function Comp_Has_Included_Inv (Ty : Type_Kind_Id) return Test_Result is
         Current : Entity_Id := Ty;
         Parent  : Entity_Id;
      begin
         loop
            if Has_Invariants_In_SPARK (Current) and then Include_Inv (Current)
            then
               return Pass;
            end if;

            Parent := Retysp (Etype (Current));
            exit when Current = Parent;
            Current := Parent;
         end loop;
         return Continue;
      end Comp_Has_Included_Inv;

      -----------------
      -- Include_Inv --
      -----------------

      function Include_Inv (Ty : Type_Kind_Id) return Boolean
      is (if Invariant_Assumed_In_Main (Ty)
          then
            Kind = Globally_Assumed
            or else
              (Present (Subp)
               and then Kind = Locally_Assumed
               and then not Invariant_Relaxed_For_Subprogram (Ty, Subp))
          elsif Present (Scop) and then Invariant_Assumed_In_Scope (Ty, Scop)
          then Kind = Locally_Assumed
          else
            Kind = For_Check
            and then
              (No (Subp)
               or else not Invariant_Relaxed_For_Subprogram (Ty, Subp)));

      ------------------------
      -- Invariant_For_Comp --
      ------------------------

      function Invariant_For_Comp
        (C_Expr : W_Term_Id; C_Ty : Entity_Id; E : Entity_Id) return W_Pred_Id
      is (Compute_Type_Invariant
            (C_Expr, C_Ty, Kind, Params, Scop => Scop, Subp => Subp));

      function Invariant_For_Array is new
        Build_Predicate_For_Array (Invariant_For_Comp);

      function Invariant_For_Record is new
        Build_Predicate_For_Record (Invariant_For_Comp, Invariant_For_Comp);

      function Type_Contains_Included_Inv is new
        Traverse_Subcomponents (Comp_Has_Included_Inv);

      Rep_Ty : constant Entity_Id := Retysp (Ty);
      --  If Ty's fullview is in SPARK, go to its underlying type to check its
      --  kind.

      Pred : W_Pred_Id := True_Pred;

      --  Start of processing for Compute_Type_Invariant

   begin
      --  Check for invariants on the type and its ancestors

      declare
         Current : Entity_Id := Rep_Ty;
         Parent  : Entity_Id;
      begin
         loop
            if Has_Invariants_In_SPARK (Current) and then Include_Inv (Current)
            then
               Pred :=
                 New_And_Pred
                   (Left  => Pred,
                    Right =>
                      Compute_Top_Level_Type_Invariant
                        (Insert_Simple_Conversion
                           (Expr => Expr, To => Type_Of_Node (Current)),
                         Current,
                         Params,
                         Use_Pred => Use_Pred));
            end if;

            Parent := Retysp (Etype (Current));
            exit when Current = Parent;
            Current := Parent;
         end loop;
      end;

      --  Check for invariants on components

      if Include_Comp then

         --  For array types, produce:
         --  (forall i1, i2 .... in_range1 (i1) /\ inrange2 (i2) /\ ... ->
         --      invariant (a (i1, i2, ...)))

         if Is_Array_Type (Rep_Ty) then

            Pred :=
              New_And_Pred
                (Left => Pred, Right => Invariant_For_Array (Expr, Rep_Ty));

         --  For record types, produce:
         --  invariant (r.d1) /\ ...
         --      /\ (check_for_f1 (r) -> invariant (r.f1)) /\ ...

         elsif Is_Incomplete_Or_Private_Type (Rep_Ty)
           or else Is_Record_Type (Rep_Ty)
           or else Is_Concurrent_Type (Rep_Ty)
         then

            Pred :=
              New_And_Pred
                (Left => Pred, Right => Invariant_For_Record (Expr, Rep_Ty));

         --  For access types, produce:
         --      not r.is_null -> invariant (r.pointer_value)
         --
         --  We do not consider access to incomplete types. Indeed, these
         --  access types cannot contain types for which an invariant check
         --  is needed (see tool limitations). Supporting access to incomplete
         --  type here would require either disallowing or handling recursive
         --  structures.

         elsif Is_Access_Type (Rep_Ty)
           and then not Is_Access_Subprogram_Type (Rep_Ty)
         then

            --  Introduce a sanity checking to make sure that we are not
            --  missing any invariant on access-to-incomplete types.

            if Designates_Incomplete_Type (Rep_Ty) then

               if Type_Contains_Included_Inv
                    (Directly_Designated_Type (Rep_Ty))
               then
                  pragma
                    Assert (Kind = Locally_Assumed and then Present (Subp));
                  Error_Msg_N
                    ("& cannot be used in SPARK",
                     Subp,
                     Names         => [Rep_Ty],
                     Kind          => Error_Kind,
                     Continuations =>
                       ["access to incomplete or private type which needs"
                        & " an invariant check is not yet supported"]);
               end if;

            else
               declare
                  C_Expr   : constant W_Term_Id :=
                    New_Pointer_Value_Access
                      (Ada_Node => Empty, E => Rep_Ty, Name => Expr);
                  Comp_Inv : constant W_Pred_Id :=
                    Invariant_For_Comp
                      (C_Expr, Directly_Designated_Type (Rep_Ty), Empty);
               begin
                  if Comp_Inv /= True_Pred then
                     Pred :=
                       New_And_Pred
                         (Left  => Pred,
                          Right =>
                            New_Conditional
                              (Condition =>
                                 New_Not
                                   (Right =>
                                      Pred_Of_Boolean_Term
                                        (New_Pointer_Is_Null_Access
                                           (E => Rep_Ty, Name => +Expr))),
                               Then_Part => Comp_Inv));
                  end if;
               end;
            end if;
         end if;
      end if;

      return Pred;
   end Compute_Type_Invariant;

   ------------------------------
   -- Count_Numerical_Variants --
   ------------------------------

   function Count_Numerical_Variants (E : Callable_Kind_Id) return Natural is
      Variants : constant Node_Id := Get_Pragma (E, Pragma_Subprogram_Variant);
   begin
      if Present (Variants)
        and then not Is_Structural_Subprogram_Variant (Variants)
      then
         return
           Natural
             (List_Length
                (Component_Associations
                   (Expression
                      (First (Pragma_Argument_Associations (Variants))))));
      else
         return 0;
      end if;
   end Count_Numerical_Variants;

   --------------------
   -- DIC_Expression --
   --------------------

   function DIC_Expression
     (Expr               : W_Expr_Id;
      Default_Init_Param : Formal_Kind_Id;
      Default_Init_Expr  : Node_Id;
      Params             : Transformation_Params;
      Domain             : EW_Domain) return W_Expr_Id
   is
      Result   : W_Expr_Id;
      Need_Tmp : constant Boolean :=
        Expr /= Why_Empty and then Get_Kind (+Expr) not in W_Identifier;
      --  Only introduce a new identifier for Expr if it is not already an
      --  identifier. Expr might be empty if the expression does not reference
      --  the current type instance.
      DIC_Id   : constant W_Identifier_Id :=
        (if Need_Tmp
         then New_Temp_Identifier (Default_Init_Param, Get_Type (+Expr))
         else +Expr);

   begin
      Ada_Ent_To_Why.Push_Scope (Symbol_Table);

      --  Register the temporary identifier DIC_Id for parameter
      --  Default_Init_Param in the symbol table. This ensures both that a
      --  distinct name is used each time (preventing name capture), and that
      --  the type of Expr is used as the type used to represent
      --  Default_Init_Param (avoiding type conversion).

      if DIC_Id /= Why_Empty then
         Insert_Tmp_Item_For_Entity (Default_Init_Param, DIC_Id);
      end if;

      --  Transform the DIC expression into Why3

      Result :=
        Transform_Expr
          (Expr => Default_Init_Expr, Params => Params, Domain => Domain);

      --  Relate the name DIC_Id used in the DOC expression to the value Expr
      --  for which the DIC is checked.
      if Need_Tmp then
         Result :=
           New_Binding
             (Name    => DIC_Id,
              Def     => Expr,
              Context => Result,
              Typ     => Get_Type (+Result),
              Domain  => Domain);
      end if;

      Ada_Ent_To_Why.Pop_Scope (Symbol_Table);

      return Result;
   end DIC_Expression;

   ------------------------------
   -- Discrete_Choice_Is_Range --
   ------------------------------

   function Discrete_Choice_Is_Range (Choice : Node_Id) return Boolean is
      Is_Range : Boolean;
   begin
      case Nkind (Choice) is
         when N_Subtype_Indication | N_Range =>
            Is_Range := True;

         when N_Identifier | N_Expanded_Name =>
            if Is_Type (Entity (Choice)) then
               Is_Range := True;
            else
               Is_Range := False;
            end if;

         when N_Others_Choice                =>
            Is_Range := True;

         when others                         =>
            Is_Range := False;
      end case;
      return Is_Range;
   end Discrete_Choice_Is_Range;

   ----------------------------------
   -- Dynamic_Predicate_Expression --
   ----------------------------------

   function Dynamic_Predicate_Expression
     (Expr       : W_Term_Id;
      Pred_Param : Formal_Kind_Id;
      Pred_Expr  : Node_Id;
      Params     : Transformation_Params) return W_Pred_Id
   is
      Result  : W_Pred_Id;
      Pred_Id : constant W_Identifier_Id :=
        New_Temp_Identifier (Pred_Param, Get_Type (+Expr));

   begin
      Ada_Ent_To_Why.Push_Scope (Symbol_Table);

      --  Register the temporary identifier Pred_Id for parameter Pred_Param in
      --  the symbol table. This ensures both that a distinct name is used each
      --  time (preventing name capture), and that the type of Expr is used as
      --  the type used to represent Pred_Param (avoiding type conversion).

      Insert_Tmp_Item_For_Entity (Pred_Param, Pred_Id);

      --  Transform the predicate expression into Why3

      Result := Transform_Pred (Expr => Pred_Expr, Params => Params);

      --  Relate the name Pred_Id used in the predicate expression to the
      --  value Expr for which the predicate is checked.

      Result :=
        New_Binding
          (Name    => Pred_Id,
           Def     => Expr,
           Context => Result,
           Typ     => Get_Type (+Result));

      Ada_Ent_To_Why.Pop_Scope (Symbol_Table);

      return Result;
   end Dynamic_Predicate_Expression;

   --------------------------------------
   -- Emit_Dynamic_Accessibility_Check --
   --------------------------------------

   procedure Emit_Dynamic_Accessibility_Check
     (Returned_Expr : N_Subexpr_Id; Subp : E_Function_Id)
   is
      Param : constant Entity_Id := First_Formal (Subp);

      Seen : Node_Sets.Set;
      --  Remember already processed locally declared objects.

      function Compute_Check
        (Path : N_Subexpr_Id; Under_Access : Boolean) return Boolean;
      --  Approximate the accessibility level check on the return statement in
      --  the following way:
      --    * If we are in a part of a named access type, then no checks are
      --      necessary.
      --    * If we have a call to traversal function inside the declaration of
      --      a local object on the path to the ultimate root of E, then the
      --      accessibility check will fail.
      --    * If we have a call to traversal function inside the return
      --      expression, the accessibility of the result will be the result
      --      accessibility. It is still possible that a failed accessibility
      --      check will occur in the body of the traversal function if its
      --      first parameter is local, so continue the verification.
      --    * Otherwise, we are in a part of the parameter. For all references
      --      of the 'Access attribute on the path linking Returned_Expr to the
      --      traversed parameter, check that its prefix contains at least a
      --      dereference so that we can statically know that the accessibility
      --      check on the return statement will succeed.
      --      As an exception to this rule, it is OK to return a reference of
      --      the 'Access attribute if the returned expression is rooted
      --      directly at the traversed parameter and this parameter is
      --      aliased.

      -------------------
      -- Compute_Check --
      -------------------

      function Compute_Check
        (Path : N_Subexpr_Id; Under_Access : Boolean) return Boolean is
      begin
         --  We are in a part of a named access type. This type is necessarily
         --  declared above the scope of the caller, since it can be found from
         --  the type of the first parameter, so the accessibility check is
         --  guaranteed to succeed.

         if Is_Access_Type (Retysp (Etype (Path)))
           and then not Is_Anonymous_Access_Type (Etype (Path))
         then
            return True;
         end if;

         case Nkind (Path) is
            when N_Expanded_Name | N_Identifier                       =>
               --  If we take the address of a local object, which returns
               --  something with local accessibility, the overall check might
               --  fail.

               if Under_Access then
                  return False;
               else
                  declare
                     Root : constant Entity_Id := Get_Root_Object (Path);
                  begin
                     --  If we have reached the traversed parameter (or
                     --  something which was already checked), this is fine.

                     if Root = Param or else Seen.Contains (Root) then
                        return True;

                     --  Otherwise, continue verification on the initialization
                     --  expression of the root object.

                     else
                        Seen.Insert (Root);
                        return
                          Compute_Check
                            (Expression (Enclosing_Declaration (Root)),
                             Under_Access => False);
                     end if;
                  end;
               end if;

            when N_Attribute_Reference                                =>
               pragma Assert (Attribute_Name (Path) = Name_Access);
               pragma Assert (not Under_Access);

               --  Use Under_Access to record that we are in the prefix of a
               --  reference to the 'Access attribute and we should check for a
               --  dereference.

               return Compute_Check (Prefix (Path), Under_Access => True);

            when N_Explicit_Dereference                               =>

               --  We have found a dereference. The previously encountered
               --  accesses (if any) are fine.

               return Compute_Check (Prefix (Path), Under_Access => False);

            when N_Function_Call                                      =>

               --  We have found a function call. If we are not inside the
               --  return statement, the master of the call is local, we will
               --  have an accessibility check.

               pragma Assert (Is_Traversal_Function_Call (Path));
               if Get_Root_Object (Returned_Expr) /= Get_Root_Object (Path)
               then
                  return False;
               end if;

               --  If the first formal is aliased, an accessibility check might
               --  have been deferred to the call site. We need to check that
               --  it is OK to call Actual'Access in this context.

               pragma Assert (not Under_Access);
               return
                 Compute_Check
                   (First_Actual (Path),
                    Under_Access =>
                      Is_Aliased
                        (First_Formal (Get_Called_Entity_For_Proof (Path))));

            when N_Indexed_Component | N_Selected_Component | N_Slice =>
               return Compute_Check (Prefix (Path), Under_Access);

            when N_Qualified_Expression
               | N_Type_Conversion
               | N_Unchecked_Type_Conversion                          =>
               return Compute_Check (Expression (Path), Under_Access);

            when N_If_Expression | N_Case_Expression                  =>
               return
                 (for all P of Terminal_Alternatives (Path) =>
                    Compute_Check (P, Under_Access));

            when others                                               =>
               raise Program_Error;
         end case;
      end Compute_Check;

   begin
      --  Do not generate a check if the returned expression is a part of the
      --  traversed parameter and this parameter is aliased. In this case the
      --  accessibility check is deferred to the call site.

      if Get_Root_Object (Returned_Expr, Through_Traversal => False) = Param
        and then Is_Aliased (Param)
      then
         return;
      end if;

      Emit_Static_Proof_Result
        (Node   => Returned_Expr,
         Kind   => VC_Dynamic_Accessibility_Check,
         Proved => Compute_Check (Returned_Expr, Under_Access => False),
         E      => Subp);
   end Emit_Dynamic_Accessibility_Check;

   ---------------------------------
   -- Expected_Type_For_Move_Tree --
   ---------------------------------

   function Expected_Type_For_Move_Tree
     (N : Node_Or_Entity_Id) return Type_Kind_Id is
   begin
      if Nkind (N) = N_Defining_Identifier then
         return
           Retysp
             (Get_Ada_Type_From_Item
                (Ada_Ent_To_Why.Element (Symbol_Table, N)));
      else
         return Expected_Type_Of_Prefix (N, Skip_Slice => True);
      end if;
   end Expected_Type_For_Move_Tree;

   -----------------------------
   -- Expected_Type_Of_Prefix --
   -----------------------------

   function Expected_Type_Of_Prefix
     (N : N_Subexpr_Id; Skip_Slice : Boolean := False) return Type_Kind_Id is
   begin
      case Nkind (N) is
         --  The frontend may introduce an unchecked type conversion on the
         --  variable assigned to, in particular for inlining. Reach through
         --  the variable assigned in that case.

         when N_Unchecked_Type_Conversion    =>
            return Expected_Type_Of_Prefix (Expression (N));

         when N_Type_Conversion              =>
            return Expected_Type_Of_Prefix (Expression (N));

         when N_Identifier | N_Expanded_Name =>
            declare
               Ent : constant Entity_Id := Entity (N);
            begin
               if Is_Protected_Component_Or_Discr_Or_Part_Of (Ent) then
                  return Type_Of_Node (Etype (Ent));
               else
                  return
                    Retysp
                      (Get_Ada_Type_From_Item
                         (Ada_Ent_To_Why.Element (Symbol_Table, Ent)));
               end if;
            end;

         when N_Slice                        =>
            if Skip_Slice then
               return Expected_Type_Of_Prefix (Prefix (N));
            else
               return Retysp (Etype (N));
            end if;

         when N_Indexed_Component            =>
            return
              Retysp (Component_Type (Expected_Type_Of_Prefix (Prefix (N))));

         when N_Selected_Component           =>
            declare
               Pref : constant Entity_Id :=
                 Expected_Type_Of_Prefix (Prefix (N));
               Comp : constant Entity_Id :=
                 Search_Component_In_Type (Pref, Entity (Selector_Name (N)));

            begin
               --  There might be no such component in the expected type of
               --  the prefix if there is a view conversion in the prefix and
               --  Comp is a component of a tagged extension.

               if No (Comp) then
                  return
                    Retysp
                      (Etype
                         (Search_Component_In_Type
                            (Etype (Prefix (N)), Entity (Selector_Name (N)))));
               else
                  return Retysp (Etype (Comp));
               end if;
            end;

         when N_Explicit_Dereference         =>
            declare
               Pref   : constant Entity_Id :=
                 Expected_Type_Of_Prefix (Prefix (N));
               Des_Ty : constant Entity_Id := Directly_Designated_Type (Pref);
            begin
               return Retysp (Des_Ty);
            end;

         when N_Function_Call                =>
            return Retysp (Etype (N));

         when others                         =>
            Ada.Text_IO.Put_Line
              ("[Expected_Type] kind =" & Node_Kind'Image (Nkind (N)));
            raise Not_Implemented;
      end case;
   end Expected_Type_Of_Prefix;

   function Expected_Type_Of_Prefix (N : N_Subexpr_Id) return W_Type_Id is
      Relaxed_Init : constant Boolean := Expr_Has_Relaxed_Init (N);
   begin
      case Nkind (N) is
         --  The frontend may introduce an unchecked type conversion on the
         --  variable assigned to, in particular for inlining. Reach through
         --  the variable assigned in that case.

         when N_Unchecked_Type_Conversion    =>
            return Expected_Type_Of_Prefix (Expression (N));

         when N_Type_Conversion              =>
            return Expected_Type_Of_Prefix (Expression (N));

         when N_Identifier | N_Expanded_Name =>
            declare
               Ent : constant Entity_Id := Entity (N);
            begin
               if Is_Protected_Component_Or_Discr_Or_Part_Of (Ent) then
                  return Type_Of_Node (Etype (Ent));
               else
                  return
                    Get_Why_Type_From_Item
                      (Ada_Ent_To_Why.Element (Symbol_Table, Ent));
               end if;
            end;

         when N_Explicit_Dereference
            | N_Slice
            | N_Indexed_Component
            | N_Selected_Component           =>
            return
              EW_Abstract
                (Expected_Type_Of_Prefix (N), Relaxed_Init => Relaxed_Init);

         when N_Function_Call                =>
            return EW_Abstract (Etype (N), Relaxed_Init => Relaxed_Init);

         when others                         =>
            Ada.Text_IO.Put_Line
              ("[Expected_Type] kind =" & Node_Kind'Image (Nkind (N)));
            raise Not_Implemented;
      end case;
   end Expected_Type_Of_Prefix;

   --------------------------
   -- Finalization_Actions --
   --------------------------

   function Finalization_Actions
     (Scope   : Node_Id;
      Exiting : Local_CFG.Vertex;
      Params  : Transformation_Params) return W_Statement_Sequence_Id
   is
      Scopes : Node_Lists.List;
   begin
      Scopes.Append (Scope);
      return Finalization_Actions (Scopes, Exiting, Params);
   end Finalization_Actions;

   function Finalization_Actions
     (Scopes  : Node_Lists.List;
      Exiting : Local_CFG.Vertex_Sets.Set;
      Params  : Transformation_Params) return W_Statement_Sequence_Id
   is
      use Local_CFG;

      Updated_Borrowers : Node_Sets.Set;
      --  Stores which borrowers have been found to be updated.

      Leading_To_Exiting : Vertex_Sets.Set := Exiting;
      --  Stores which local CFG vertices lead to Exiting vertices.

      procedure Update_Variable (X : Entity_Id);
      --  For X a variable, if it is a borrower, mark it updated,
      --  as well as all borrowers that it reborrows.
      --  Empty node is allowed and ignored.

      procedure Update_Call_Variables (Call : Node_Id);
      --  For N an entry/function/procedure call, call Update_Variable on every
      --  variable it modifies.

      ---------------------------
      -- Update_Call_Variables --
      ---------------------------

      procedure Update_Call_Variables (Call : Node_Id) is
         procedure Do_Param (Formal : Formal_Kind_Id; Actual : N_Subexpr_Id);
         --  Deal with a parameter, updating root object if (in-)out or
         --  access.

         --------------
         -- Do_Param --
         --------------

         procedure Do_Param (Formal : Formal_Kind_Id; Actual : N_Subexpr_Id) is
         begin
            if not Is_Constant_In_SPARK (Formal) then
               Update_Variable (Get_Root_Object (Actual));
            end if;
         end Do_Param;

         procedure Do_Parameters is new Iterate_Call_Parameters (Do_Param);

         Subp : constant Callable_Kind_Id := Get_Called_Entity (Call);

         --  Start of processing for Update_Call_Variables

      begin
         Do_Parameters (Call);

         --  Check the global OUT and IN OUT of Subp

         declare
            Unused_Ids : Flow_Types.Flow_Id_Sets.Set;
            Write_Ids  : Flow_Types.Flow_Id_Sets.Set;

         begin
            Flow_Utility.Get_Proof_Globals
              (Subprogram      => Subp,
               Reads           => Unused_Ids,
               Writes          => Write_Ids,
               Erase_Constants => True,
               Scop            => Get_Flow_Scope (Call));

            for F of Write_Ids loop
               if F.Kind = Direct_Mapping then
                  Update_Variable (Get_Direct_Mapping_Id (F));
               end if;
            end loop;
         end;

      end Update_Call_Variables;

      ---------------------
      -- Update_Variable --
      ---------------------

      procedure Update_Variable (X : Entity_Id) is
         Inserted : Boolean;
         Position : Node_Sets.Cursor;
      begin
         if Present (X) and then Is_Local_Borrower (X) then
            Updated_Borrowers.Insert (X, Position, Inserted);
            if Inserted then
               Update_Variable
                 (Get_Root_Object (Expression (Enclosing_Declaration (X))));
            end if;
         end if;
      end Update_Variable;

      --  Start of processing for Finalization_Actions

   begin
      return Result : W_Statement_Sequence_Id := Void_Sequence do
         for S of Scopes loop

            --  If S is an handled sequence of statements, the corresponding
            --  finalization actions are given by the finally block. This is
            --  the simple case, translate it and go to next iteration.

            if Nkind (S) = N_Handled_Sequence_Of_Statements then
               declare
                  Fin_Section : constant List_Id := Finally_Statements (S);
               begin
                  if Present (Fin_Section) then
                     Append
                       (Result,
                        Transform_Statements_And_Declarations
                          (Fin_Section, Params));
                  end if;
               end;
               goto Continue;
            end if;

            --  Otherwise, the finalization actions are given by end of borrows
            --  and leak checks. We analyze control flow to find borrows which
            --  may actually be updated.

            declare
               Decls   : constant List_Id :=
                 Declarations
                   (if S in N_Block_Statement_Id then S else Get_Body (S));
               Borrows : Node_Lists.List;
            begin
               if Present (Decls) then
                  Get_Borrows_From_Decls (Decls, Borrows);
                  if not Borrows.Is_Empty then
                     if Exiting.Is_Empty then
                        --  Having Exiting empty means no analysis should be
                        --  performed, we havoc all borrows.

                        for E of Borrows loop
                           Append (Result, Havoc_Borrowed_Expression (E));
                        end loop;

                     else
                        --  Scan local CFG of S for updates.

                        Collect_Vertices_Leading_To (S, Leading_To_Exiting);
                        for U of Leading_To_Exiting loop
                           case Nkind (U.Node) is

                              --  Calls to functions with side effects can
                              --  occur inside assignments and object
                              --  declarations.

                              when N_Object_Declaration       =>
                                 declare
                                    Src : constant Node_Id :=
                                      Expression (U.Node);
                                 begin
                                    if Nkind (Src) = N_Function_Call then
                                       Update_Call_Variables (Src);
                                    end if;
                                 end;

                              when N_Assignment_Statement     =>
                                 declare
                                    Nm  : constant Node_Id := Name (U.Node);
                                    Src : constant Node_Id :=
                                      Expression (U.Node);
                                 begin
                                    --  Direct assignments to borrowers must
                                    --  be re-borrows, which do not update
                                    --  borrowed object.

                                    if Nkind (Nm) /= N_Identifier then
                                       Update_Variable (Get_Root_Object (Nm));
                                    end if;
                                    if Nkind (Src) = N_Function_Call then
                                       Update_Call_Variables (Src);
                                    end if;
                                 end;

                              when N_Entry_Call_Statement
                                 | N_Procedure_Call_Statement =>
                                 Update_Call_Variables (U.Node);

                              when others                     =>
                                 null;
                           end case;
                        end loop;

                        --  Havoc borrows that are found to have been possibly
                        --  updated.

                        for E of Borrows loop
                           Append
                             (Result,
                              Havoc_Borrowed_Expression
                                (E,
                                 Already_Equal =>
                                   not Updated_Borrowers.Contains (E)));
                        end loop;

                     end if;

                  end if;
                  Append
                    (Result, Check_No_Memory_Leaks_At_End_Of_Scope (Decls));
               end if;
            end;
            <<Continue>>
         end loop;
      end return;
   end Finalization_Actions;

   function Finalization_Actions
     (Scopes  : Node_Lists.List;
      Exiting : Local_CFG.Vertex;
      Params  : Transformation_Params) return W_Statement_Sequence_Id
   is
      Exitings : Local_CFG.Vertex_Sets.Set;
   begin
      Exitings.Insert (Exiting);
      return Finalization_Actions (Scopes, Exitings, Params);
   end Finalization_Actions;

   ----------------------------------
   -- Finalization_Actions_On_Jump --
   ----------------------------------

   function Finalization_Actions_On_Jump
     (Jump : Node_Id; Params : Transformation_Params) return W_Prog_Id
   is
      Scopes : Node_Lists.List;

      procedure Append (Scop : Node_Id);

      ------------
      -- Append --
      ------------

      procedure Append (Scop : Node_Id) is
      begin
         if Nkind (Scop)
            in N_Block_Statement | N_Handled_Sequence_Of_Statements
         then
            Scopes.Append (Scop);
         end if;
      end Append;

      procedure Iter_Scopes is new Iter_Exited_Scopes (Append);

      --  Start of processing for Finalization_Actions_On_Jump

   begin
      Iter_Scopes (Jump);

      return
        +Finalization_Actions
           (Scopes, Local_CFG.Starting_Vertex (Jump), Params);
   end Finalization_Actions_On_Jump;

   -----------------------------------
   -- Finalization_Actions_On_Raise --
   -----------------------------------

   function Finalization_Actions_On_Raise
     (Stmt_Or_Decl : Node_Id; Params : Transformation_Params) return W_Prog_Id
   is
      use Local_CFG;

      Scopes : Node_Lists.List;

      Found : exception;

      procedure Append (Scop : Node_Id);
      --  Collect exited scopes (for Iter_Exited_Scopes)

      procedure Stop
        (Destination : Node_Id;
         Exc_Set     : Exception_Sets.Set;
         Is_Continue : Boolean);
      --  Stop collection at first caught exception by raising Found

      procedure Iter_From is new
        Iter_Exited_Scopes_With_Specified_Transfer
          (Process => Append,
           Stop    => Stop);

      ------------
      -- Append --
      ------------

      procedure Append (Scop : Node_Id) is
      begin
         if Nkind (Scop)
            in N_Block_Statement | N_Handled_Sequence_Of_Statements
         then
            Scopes.Append (Scop);
         end if;
      end Append;

      ----------
      -- Stop --
      ----------

      procedure Stop
        (Destination : Node_Id;
         Exc_Set     : Exception_Sets.Set;
         Is_Continue : Boolean)
      is
         pragma Unreferenced (Exc_Set, Is_Continue);
      begin
         if Nkind (Destination) = N_Exception_Handler then
            raise Found;
         end if;
      end Stop;

      Res : W_Prog_Id;

      --  Start of processing for Havoc_Borrowed_And_Check_No_Leaks_On_Raise

   begin
      --  Add a continuation locating the potential checks on exceptional exits

      Continuation_Stack.Append
        (Continuation_Type'
           (Ada_Node => Stmt_Or_Decl,
            Message  => To_Unbounded_String ("when an exception is raised")));

      --  A handled sequence of statements represent an implicit re-raise of
      --  not-caught exceptions in the handled sequence of statements. In
      --  particular, this goes through the finally section of that sequence if
      --  any. But since the iteration of exited scopes starts supposing that
      --  the transfer-of-control comes from the whole handled sequence of
      --  statements, which does not cover that particular scope. We need to
      --  add it explicitly.

      if Nkind (Stmt_Or_Decl) = N_Handled_Sequence_Of_Statements then
         Append (Stmt_Or_Decl);
      end if;

      --  Since we stop at the first encountered handler, we can make the
      --  iteration as if all exceptions were raised. This is also necessary
      --  for the case of implicit re-raises inserted at handlers, as the
      --  precise set of exceptions raised is not known.

      begin
         Iter_From
           (Stmt_Or_Decl, Exception_Sources => Exception_Sets.All_Exceptions);
      exception
         when Found =>
            null;
      end;

      --  This case happens because exceptions not handled by sequence of
      --  statements are treated as if handled and re-raised. Could do
      --  something by tracking the original exception sources (possibly
      --  several ones). Disconnect precise analysis for now.

      if Nkind (Stmt_Or_Decl) = N_Handled_Sequence_Of_Statements then
         Res := +Finalization_Actions (Scopes, Vertex_Sets.Empty_Set, Params);
      else
         Res :=
           +Finalization_Actions
              (Scopes, Starting_Vertex (Stmt_Or_Decl), Params);
      end if;

      Continuation_Stack.Delete_Last;

      return +Res;
   end Finalization_Actions_On_Raise;

   ------------------------------
   -- Generate_Case_Expression --
   ------------------------------

   function Generate_Case_Expression
     (N : N_Case_Kind_Id; Domain : EW_Domain; Params : Transformation_Params)
      return W_Expr_Id
   is
      --  For a given case expression
      --
      --    case X is
      --       when Case_1 => S1
      --       ...
      --       when Case_n => Sn
      --       when others => S
      --    end case;
      --
      --  We generate a single if expression, with a list of elsif cases, to
      --  avoid the generation of deep Why3 expressions, which may lead to
      --  stack overflow when traversing recursively the expression:
      --
      --    if X = Case_1 then S1
      --    elsif ...
      --    elsif X = Case_N then Sn
      --    else S

      Match_Domain : constant EW_Domain :=
        (if Domain = EW_Pred then EW_Term else Domain);
      Cond_Domain  : constant EW_Domain :=
        (if Domain = EW_Term
         then EW_Pred
         elsif Domain = EW_Prog
         then EW_Pterm
         else Domain);
      --  As the choices must be static, we do not need to generate checks
      --  for them.

      Cases        : constant List_Id := Alternatives (N);
      First_Case   : constant Node_Id := First_Non_Pragma (Cases);
      Last_Case    : constant Node_Id := Last_Non_Pragma (Cases);
      Expr         : constant Node_Id := Expression (N);
      Cur_Case     : Node_Id;
      Matched_Expr : constant W_Expr_Id :=
        New_Temp_For_Expr
          (Transform_Expr
             (Expr,
              Base_Why_Type (Entity_Id'(Type_Of_Node (Expr))),
              Match_Domain,
              Params));
      Then_Expr    : constant W_Expr_Id :=
        Generate_Branch_Expr (First_Case, Domain, Params);
      Elsif_Parts  : W_Expr_Array (1 .. Integer (List_Length (Cases)) - 2);
      Elsif_Count  : Natural;

      --  Start of processing for Generate_Case_Expression

   begin
      if List_Length (Cases) = 1 then
         return Then_Expr;

      else
         Cur_Case := Next_Non_Pragma (First_Case);
         Elsif_Count := 0;
         for Offset in 1 .. List_Length (Cases) - 2 loop
            declare
               Disc_Choices : constant W_Expr_Id :=
                 Transform_Discrete_Choices
                   (Choices      => Discrete_Choices (Cur_Case),
                    Choice_Type  => Empty,
                    Matched_Expr => Matched_Expr,
                    Cond_Domain  => Cond_Domain,
                    Params       => Params);
            begin
               Elsif_Parts (Integer (Offset)) :=
                 New_Elsif
                   (Domain    => Domain,
                    Condition =>
                      (if Nkind (N) in N_Case_Statement
                       then
                         +New_Counterexample_Assign
                            (If_Node => Cur_Case, Condition => +Disc_Choices)
                       else Disc_Choices),
                    Then_Part =>
                      Generate_Branch_Expr (Cur_Case, Domain, Params));
               Next_Non_Pragma (Cur_Case);
               Elsif_Count := Elsif_Count + 1;
            end;
         end loop;

         declare
            Disc_Choices : constant W_Expr_Id :=
              Transform_Discrete_Choices
                (Choices      => Discrete_Choices (First_Case),
                 Choice_Type  => Empty,
                 Matched_Expr => Matched_Expr,
                 Cond_Domain  => Cond_Domain,
                 Params       => Params);
         begin
            return
              Binding_For_Temp
                (Domain  => Domain,
                 Tmp     => Matched_Expr,
                 Context =>
                   New_Conditional
                     (Domain      => Domain,
                      Condition   =>
                        (if Nkind (N) in N_Case_Statement
                         then
                           +New_Counterexample_Assign
                              (If_Node   => First_Case,
                               Condition => +Disc_Choices)
                         else Disc_Choices),
                      Then_Part   => Then_Expr,
                      Elsif_Parts => Elsif_Parts (1 .. Elsif_Count),
                      Else_Part   =>
                        Generate_Branch_Expr (Last_Case, Domain, Params),
                      Typ         => Get_Type (Then_Expr)));
         end;
      end if;
   end Generate_Case_Expression;

   --------------------------------
   -- Generate_Expr_With_Actions --
   --------------------------------

   function Generate_Expr_With_Actions
     (Expr    : Node_Id;
      Actions : List_Id;
      Domain  : EW_Domain;
      Params  : Transformation_Params) return W_Expr_Id is
   begin
      Ada_Ent_To_Why.Push_Scope (Symbol_Table);

      if Present (Actions) then
         Transform_Actions_Preparation (Actions);
      end if;

      declare
         Result : W_Expr_Id := Generate_Expr (Expr, Domain, Params);
      begin

         --  Add check for absence of resource leaks at end of scope

         if Domain = EW_Prog then
            Prepend
              (Check_No_Memory_Leaks_At_End_Of_Scope (Decls => Actions),
               Result);
         end if;

         if Present (Actions) then
            Result := Transform_Actions (Actions, Result, Domain, Params);
         end if;

         Ada_Ent_To_Why.Pop_Scope (Symbol_Table);

         return Result;
      end;
   end Generate_Expr_With_Actions;

   ------------------------------------
   -- Generate_Quantified_Expression --
   ------------------------------------

   function Generate_Quantified_Expression
     (Expr   : N_Quantified_Expression_Id;
      Domain : EW_Domain;
      Params : Transformation_Params) return W_Expr_Id
   is
      -----------------------
      -- Local Subprograms --
      -----------------------

      function Make_Binding_For_Array
        (Ada_Node    : Node_Id;
         W_Arr_Expr  : W_Expr_Id;
         W_Index_Var : W_Identifier_Id;
         W_Quant_Var : W_Identifier_Id;
         Domain      : EW_Domain) return W_Expr_Id;
      --  @param Ada_Node quantified expression over an array
      --  @param W_Arr_Expr Why3 expression for the array value
      --  @param W_Index_Var Why3 name for the index of the quantification
      --  @param W_Quant_Var Why3 name for the quantified variable of the
      --     quantified expression in SPARK.
      --  @return the expression that binds the value of variable [W_Quant_Var]
      --     to the value of index variable [W_Index_Var]. For example, given
      --     a quantified expression (for all E of Arr => ...) and index
      --     variable J, it returns arr(j) suitably converted to E's type.

      function Make_Binding_For_Iterable
        (Ada_Node    : Node_Id;
         W_Over_E    : W_Expr_Id;
         Over_Type   : Entity_Id;
         W_Index_Var : W_Identifier_Id;
         Domain      : EW_Domain;
         Element_T   : W_Type_Id;
         Params      : Transformation_Params) return W_Expr_Id;
      --  @param Ada_Node quantified expression over a container
      --  @param W_Over_E Why3 expression for the container value
      --  @param Over_Type Entity of the container type
      --  @param W_Index_Var Why3 name for the index of the quantification
      --  @param Domain domain in which the quantification is translated
      --  @param Element_T Why3 type of the Index variable
      --  @param Params transformation parameters to be used.
      --  @return the expression that should be used to bind the index of a
      --  "of" quantified expression on a type with the Iterable aspect.
      --  Returns Element (W_Over_E, W_Index_Var)

      function Make_Constraint_For_Iterable
        (Ada_Node     : Node_Id;
         Use_Contains : Boolean;
         W_Over_E     : W_Expr_Id;
         Over_Type    : Entity_Id;
         W_Index_Var  : W_Expr_Id;
         Domain       : EW_Domain;
         Params       : Transformation_Params) return W_Expr_Id
      with
        Pre =>
          Nkind (Ada_Node) = N_Quantified_Expression
          and then Is_Type (Over_Type);
      --  @param Ada_Node quantified expression over a container
      --  @param Use_Contains wether there is a Contains primitive specified
      --         for Over_Type
      --  @param W_Over_E Why3 expression for the container value
      --  @param Over_Type Entity of the container type
      --  @param W_Index_Var Why3 name for the index of the quantification
      --  @param Domain domain in which the quantification is translated
      --  @param Params transformation parameters to be used
      --  @return the expression for the constraint of a quantified
      --     expression on a type with the Iterable aspect, which is equivalent
      --     to Has_Element (W_Over_E, W_Index_Var)

      procedure Parse_Iteration_Scheme_For_Iterable
        (Ada_Node     : Node_Id;
         Of_Present   : Boolean;
         W_Over_E     : in out W_Expr_Id;
         Over_Type    : in out Entity_Id;
         Index_Type   : out Entity_Id;
         Need_Tmp_Var : out Boolean);
      --  Computes the Index_Type to be used for quantifying over Over_Type.
      --  Goes through Model functions from pragma Annotate Iterate_For_Proof
      --  and updates W_Over_E and Over_Type accordingly.
      --  @param Ada_Node quantified expression over a container
      --  @param Of_Present quantification is done over a container's content
      --  @param W_Over_E Why3 expression for the container value
      --  @param Over_Type Entity of the container type on which quantification
      --         should be done
      --  @param Index_Type type of the index variable
      --  @param Need_Tmp_Var do we need a temporary variable

      ----------------------------
      -- Make_Binding_For_Array --
      ----------------------------

      function Make_Binding_For_Array
        (Ada_Node    : Node_Id;
         W_Arr_Expr  : W_Expr_Id;
         W_Index_Var : W_Identifier_Id;
         W_Quant_Var : W_Identifier_Id;
         Domain      : EW_Domain) return W_Expr_Id
      is
         W_Acc_Expr : constant W_Expr_Id :=
           New_Array_Access
             (Ada_Node => Ada_Node,
              Domain   => Domain,
              Ar       => W_Arr_Expr,
              Index    => (1 => +W_Index_Var));
      begin
         return
           Insert_Checked_Conversion
             (Ada_Node => Ada_Node,
              Domain   => Domain,
              Expr     => W_Acc_Expr,
              To       => Get_Type (+W_Quant_Var));
      end Make_Binding_For_Array;

      -------------------------------
      -- Make_Binding_For_Iterable --
      -------------------------------

      function Make_Binding_For_Iterable
        (Ada_Node    : Node_Id;
         W_Over_E    : W_Expr_Id;
         Over_Type   : Entity_Id;
         W_Index_Var : W_Identifier_Id;
         Domain      : EW_Domain;
         Element_T   : W_Type_Id;
         Params      : Transformation_Params) return W_Expr_Id
      is
         Element_E : constant Entity_Id :=
           Get_Iterable_Type_Primitive (Over_Type, Name_Element);
         Cont_Type : constant Entity_Id := Etype (First_Formal (Element_E));
         Cont_Expr : constant W_Expr_Id :=
           Insert_Simple_Conversion
             (Domain => Domain,
              Expr   => W_Over_E,
              To     => Type_Of_Node (Cont_Type));
         Curs_Type : constant Entity_Id :=
           Etype (Next_Formal (First_Formal (Element_E)));
         Curs_Expr : constant W_Expr_Id :=
           Insert_Simple_Conversion
             (Ada_Node => Empty,
              Domain   => Domain,
              Expr     => +W_Index_Var,
              To       => Type_Of_Node (Curs_Type));
         Subdomain : constant EW_Domain :=
           (if Domain = EW_Prog then EW_Pterm else Domain);
      begin
         return
           New_Function_Call
             (Ada_Node => Ada_Node,
              Name     =>
                W_Identifier_Id
                  (Transform_Identifier
                     (Params => Params,
                      Expr   => Element_E,
                      Ent    => Element_E,
                      Domain => Subdomain)),
              Subp     => Element_E,
              Args     => (1 => Cont_Expr, 2 => Curs_Expr),
              Domain   => Subdomain,
              Check    => False,
              --  Checks already done at level of Iterable aspect
              Typ      => Element_T);
      end Make_Binding_For_Iterable;

      ----------------------------------
      -- Make_Constraint_For_Iterable --
      ----------------------------------

      function Make_Constraint_For_Iterable
        (Ada_Node     : Node_Id;
         Use_Contains : Boolean;
         W_Over_E     : W_Expr_Id;
         Over_Type    : Entity_Id;
         W_Index_Var  : W_Expr_Id;
         Domain       : EW_Domain;
         Params       : Transformation_Params) return W_Expr_Id
      is
         Has_Element : Entity_Id;

      begin
         --  Look for the function that should be called to make the constraint
         --  over W_Index_Var.

         --  If there is no Contains annotation to use, use the Has_Element
         --  function of the Iterable aspect.

         if not Use_Contains then
            Has_Element :=
              Get_Iterable_Type_Primitive (Over_Type, Name_Has_Element);

         --  A Contains Iterable_For_Proof annotation is specified for
         --  Over_Type. Use the provided Contains primitive.

         else
            declare
               Found         : Boolean;
               Iterable_Info : Iterable_Annotation;
            begin
               Retrieve_Iterable_Annotation (Over_Type, Found, Iterable_Info);
               pragma Assert (Found and then Iterable_Info.Kind = Contains);
               Has_Element := Iterable_Info.Entity;
            end;
         end if;

         --  Call the function with the appropriate arguments

         declare
            Subdomain : constant EW_Domain := Term_Domain (Domain);
            Cont_Type : constant Entity_Id :=
              Etype (First_Formal (Has_Element));
            Cont_Expr : constant W_Expr_Id :=
              Insert_Simple_Conversion
                (Domain => Subdomain,
                 Expr   => W_Over_E,
                 To     => Type_Of_Node (Cont_Type));
            Curs_Type : constant Entity_Id :=
              Etype (Next_Formal (First_Formal (Has_Element)));
            Curs_Expr : constant W_Expr_Id :=
              Insert_Simple_Conversion
                (Ada_Node => Empty,
                 Domain   => Subdomain,
                 Expr     => +W_Index_Var,
                 To       => Type_Of_Node (Curs_Type));
            T         : W_Expr_Id;

         begin
            T :=
              New_Function_Call
                (Ada_Node => Ada_Node,
                 Name     =>
                   W_Identifier_Id
                     (Transform_Identifier
                        (Params => Params,
                         Expr   => Has_Element,
                         Ent    => Has_Element,
                         Domain => Subdomain)),
                 Subp     => Has_Element,
                 Args     => (1 => Cont_Expr, 2 => Curs_Expr),
                 Domain   => Subdomain,
                 Check    => False,
                 --  Checks have been done at Iterable annotation
                 Typ      => Type_Of_Node (Etype (Has_Element)));

            return T;
         end;
      end Make_Constraint_For_Iterable;

      -----------------------------------------
      -- Parse_Iteration_Scheme_For_Iterable --
      -----------------------------------------

      procedure Parse_Iteration_Scheme_For_Iterable
        (Ada_Node     : Node_Id;
         Of_Present   : Boolean;
         W_Over_E     : in out W_Expr_Id;
         Over_Type    : in out Entity_Id;
         Index_Type   : out Entity_Id;
         Need_Tmp_Var : out Boolean)
      is
         Subdomain     : constant EW_Domain := Term_Domain (Domain);
         Found         : Boolean;
         Iterable_Info : Iterable_Annotation;

      begin
         --  In case container type has visible invariants,
         --  iteration primitives implicitly assume it during Iterable checks.
         --  So for the early checks at Iterable to be valid, we need to
         --  insert a check for the container invariants.

         if Invariant_Check_Needed (Over_Type, Scop => Current_Subp)
           and then Domain = EW_Prog
         then
            W_Over_E :=
              +Insert_Invariant_Check (Ada_Node, Over_Type, +W_Over_E);
         end if;

         --  for ... in quantification:
         --  Iteration is done on cursors, no need for a temporary variable.

         if not Of_Present then
            Index_Type := Get_Cursor_Type (Over_Type);
            Need_Tmp_Var := False;

         --  for ... of quantification:
         --  Check wether an Iterable_For_Proof annotation is recorded for
         --  Over_Type.

         else
            Retrieve_Iterable_Annotation (Over_Type, Found, Iterable_Info);

            --  Go through Model Iterable_For_Proof annotations to find the
            --  type on which quantification should be done.

            while Found
              and then Iterable_Info.Kind = SPARK_Definition.Annotate.Model
            loop
               --  Replace W_Over_E by Model (W_Over_E) and Over_Type by the
               --  model's type.

               declare
                  Model     : constant Entity_Id := Iterable_Info.Entity;
                  Cont_Type : constant Entity_Id :=
                    Etype (First_Formal (Model));
                  Cont_Expr : constant W_Expr_Id :=
                    Insert_Simple_Conversion
                      (Domain => Subdomain,
                       Expr   => W_Over_E,
                       To     => Type_Of_Node (Cont_Type));
               begin
                  Over_Type := Etype (Model);
                  W_Over_E :=
                    New_Function_Call
                      (Ada_Node => Ada_Node,
                       Name     =>
                         W_Identifier_Id
                           (Transform_Identifier
                              (Params => Params,
                               Expr   => Model,
                               Ent    => Model,
                               Domain => Subdomain)),
                       Subp     => Model,
                       Args     => (1 => Cont_Expr),
                       Domain   => Subdomain,
                       Check    => False,
                       --  Checks have been done at Iterable annotation.
                       Typ      => Type_Of_Node (Over_Type));
               end;

               Retrieve_Iterable_Annotation (Over_Type, Found, Iterable_Info);
            end loop;

            --  No Contains Iterable_For_Proof annotation found.
            --  Iteration is done on cursors, we need a temporary variable
            --  to store the element.

            if not Found then
               Index_Type := Get_Cursor_Type (Over_Type);
               Need_Tmp_Var := True;

            --  A Contains Iterable_For_Proof annotation has been found.
            --  Iteration is directly done on elements, no need for a
            --  temporary variable.

            else
               Index_Type :=
                 Etype (Get_Iterable_Type_Primitive (Over_Type, Name_Element));

               Need_Tmp_Var := False;
            end if;
         end if;
      end Parse_Iteration_Scheme_For_Iterable;

      ---------------------
      -- Local Variables --
      ---------------------

      --  We distinguish between 4 types of quantified expressions:
      --  . over a scalar range (for all V in Low .. High)
      --  . over an array (for all V of Arr)
      --  . over a container's content (for all V of Cont)
      --  . over a container's cursors (for all V in Cont)
      --  The boolean variables below correspond to these 4 mutually exclusive
      --  cases.

      Over_Range : constant Boolean :=
        Present (Loop_Parameter_Specification (Expr));

      Over_Array : constant Boolean :=
        Present (Iterator_Specification (Expr))
        and then Is_Iterator_Over_Array (Iterator_Specification (Expr));

      Over_Content : constant Boolean :=
        Present (Iterator_Specification (Expr))
        and then not Over_Array
        and then Of_Present (Iterator_Specification (Expr));

      Over_Cursors : constant Boolean :=
        Present (Iterator_Specification (Expr))
        and then not Over_Array
        and then not Over_Content;

      --  We distinguish the quantified variable from the index variable in our
      --  translation. For quantifications over a scalar range, they are the
      --  same. For quantifications over an array or a container of the form
      --  (for V of E) the quantified variable is V, and the index variable is
      --  the variable over which quantification is done in Why3, over the
      --  underlying scalar range for array/container E.

      Need_Temp_Var : Boolean; --  Index variable is not quantified variable

      Quant_Var  : Entity_Id;  --  Quantified variable for quantification
      Over_Expr  : Node_Id;    --  Expression over which quantification is done
      Over_Type  : Entity_Id;  --  Type used for the quantification
      Quant_Type : Entity_Id;  --  Type of the quantified variable
      Index_Type : Entity_Id;  --  Index type for the quantification

      W_Quant_Type : W_Type_Id;  --  Why3 type for the quantified variable
      W_Index_Type : W_Type_Id;  --  Why3 type for the index variable

      W_Over_Expr  : W_Expr_Id;  --  Why3 expression for the expression over
      --  which quantification is done. This is only
      --  used in those cases where the quantified
      --  and the index variables are not the same,
      --  thus needing binding between the two that
      --  relies on this expression.
      W_Bound_Expr : W_Expr_Id;  --  Why3 expression for the constraint giving
      --  the bounds over which quantification is
      --  done.
      Result       : W_Expr_Id;  --  Why3 expression for the quantification

      W_Quant_Var : W_Identifier_Id;  --  Why3 name for the quantified
      --  variable.
      W_Index_Var : W_Identifier_Id;  --  Why3 name for the index variable

      --  Start of processing for Generate_Quantified_Expression

   begin
      --  The usual translation of quantified expression into Why3 is as a
      --  predicate (Domain = EW_Pred), into a forall or exists quantification
      --  in Why3. For programs (Domain = EW_Prog), we also need to check the
      --  absence of run-time errors in sub-expressions. The case of terms
      --  (Domain in EW_Terms) appears when the quantified expression needs
      --  to be considered of type bool in Why3, for example because it is
      --  assigned into a Boolean variable in SPARK. In this case, we transform
      --  the quantified expression into a predicate, and convert this
      --  predicate (pred) into a term (if pred then True else False).

      if Domain in EW_Terms then
         declare
            Pred : constant W_Expr_Id :=
              Generate_Quantified_Expression (Expr, EW_Pred, Params);
         begin
            return Boolean_Expr_Of_Pred (+Pred, Domain);
         end;
      end if;

      --  Step 1: create a Why3 variable for the quantified variable

      Over_Expr := Get_Expr_Quantified_Over (Expr, Over_Range);
      Quant_Var := Get_Quantified_Variable (Expr, Over_Range);
      Quant_Type := Etype (Quant_Var);

      W_Quant_Type :=
        (if Use_Split_Form_For_Type (Quant_Type)
         then EW_Split (Quant_Type)
         else Type_Of_Node (Quant_Type));

      --  In case of a for of quantification, the quantified variable may be
      --  partially initialized if:
      --  * the quantification is done on an array with relaxed initialization
      --  * the quantification is done on a container and the Element function
      --    returns a partially initialized expression.
      --  ??? for now we only check the return type to decide if we are in the
      --  second case.

      if (Over_Array
          and then
            (Expr_Has_Relaxed_Init (Over_Expr, No_Eval => False)
             or else Has_Relaxed_Init (Quant_Type)))
        or else
          (Over_Content
           and then Has_Relaxed_Init (Quant_Type)
           and then not Has_Scalar_Type (Quant_Type))
      then

         --  Use the abstract form as the initialization flag cannot easily
         --  be stored on the side.

         if Get_Type_Kind (W_Quant_Type) = EW_Split then
            W_Quant_Type :=
              EW_Abstract (Get_Ada_Node (+W_Quant_Type), Relaxed_Init => True);
         else
            W_Quant_Type := EW_Init_Wrapper (W_Quant_Type);
         end if;
      end if;

      W_Quant_Var :=
        New_Identifier (Name => Short_Name (Quant_Var), Typ => W_Quant_Type);

      --  Step 2: translate the expression over which the quantification is
      --          applied.

      if not Over_Range then
         Over_Type := Etype (Over_Expr);
      else
         Over_Type := Empty;
      end if;

      if not Over_Range then
         W_Over_Expr :=
           Transform_Expr (Over_Expr, Prog_Or_Term_Domain (Domain), Params);
      else
         W_Over_Expr := Why_Empty;  --  safe assignment in the unused case
      end if;

      --  Step 3: parse the iteration scheme to compute the proper Index_Type.
      --          When the quantification is done over a container, also
      --          update Over_Type and W_Over_Expr to go through model
      --          functions when one is specified using pragma Annotate
      --          Iterate_For_Proof.

      if Over_Array then
         Need_Temp_Var := True;
         Index_Type := Etype (First_Index (Etype (Over_Expr)));

      elsif Over_Range then
         Need_Temp_Var := False;
         Index_Type := Quant_Type;

      else
         pragma Assert (Over_Content or Over_Cursors);

         Parse_Iteration_Scheme_For_Iterable
           (Ada_Node     => Expr,
            Of_Present   => Over_Content,
            W_Over_E     => W_Over_Expr,
            Over_Type    => Over_Type,
            Index_Type   => Index_Type,
            Need_Tmp_Var => Need_Temp_Var);
      end if;

      if Need_Temp_Var then
         W_Index_Type :=
           (if Use_Split_Form_For_Type (Index_Type)
            then Base_Why_Type (Index_Type)
            else Type_Of_Node (Index_Type));
         W_Index_Var := New_Temp_Identifier (Typ => W_Index_Type);
      else
         W_Index_Type := W_Quant_Type;
         W_Index_Var := W_Quant_Var;
      end if;

      --  Save W_Over_Expr in a temporary, which can then be referred to in any
      --  context (including predicates even when Domain = EW_Prog), which
      --  requires that the expression is first evaluated in the appropriate
      --  context to possibly generate run-time checks

      if not Over_Range then
         W_Over_Expr := New_Temp_For_Expr (W_Over_Expr);
      end if;

      --  Step 4: translate the constraints over the index variable

      if Over_Range or Over_Array then

         if Over_Array then
            W_Bound_Expr :=
              New_Array_Range_Expr (+W_Index_Var, +W_Over_Expr, Domain, 1);
         else
            W_Bound_Expr :=
              Range_Expr (Over_Expr, +W_Index_Var, Domain, Params);
         end if;

      else
         pragma Assert (Over_Content or Over_Cursors);

         --  Call the appropriate primitive

         W_Bound_Expr :=
           +Make_Constraint_For_Iterable
              (Ada_Node     => Expr,
               Use_Contains => Over_Content and then not Need_Temp_Var,
               W_Over_E     => W_Over_Expr,
               Over_Type    => Over_Type,
               W_Index_Var  => +W_Index_Var,
               Domain       => Domain,
               Params       => Params);

         --  Add the dynamic predicate and invariant of the index type

         declare
            Inv : constant W_Pred_Id :=
              New_And_Pred
                (Compute_Dynamic_Inv_And_Initialization
                   (Expr        => +W_Index_Var,
                    Ty          => Index_Type,
                    Initialized => True_Term,
                    Only_Var    => False_Term,
                    Params      => Params),
                 Compute_Type_Invariant
                   (Expr   => +W_Index_Var,
                    Ty     => Index_Type,
                    Kind   => For_Check,
                    Params => Params,
                    Scop   => Current_Subp));
         begin
            W_Bound_Expr :=
              New_And_Expr
                (Left   => Boolean_Expr_Of_Pred (Inv, Domain),
                 Right  => W_Bound_Expr,
                 Domain => Domain);
         end;
      end if;

      --  Step 5: process the condition in the quantified expression, in a
      --          context where the quantified variable is known.

      Ada_Ent_To_Why.Push_Scope (Symbol_Table);
      Insert_Tmp_Item_For_Entity (Quant_Var, W_Quant_Var);
      Result := Generate_Condition (Condition (Expr), Domain, Params);

      --  If there is a filter, add it as an additional condition on the
      --  iterated values.

      declare
         Filter : constant Node_Id :=
           (if Over_Range
            then Iterator_Filter (Loop_Parameter_Specification (Expr))
            else Iterator_Filter (Iterator_Specification (Expr)));

      begin
         --  In the program domain, checks are always done for all values, so
         --  we always generate a conditional.

         if Present (Filter) then
            if All_Present (Expr) or else Domain = EW_Prog then
               Result :=
                 New_Conditional
                   (Domain    => Domain,
                    Condition => Transform_Expr (Filter, Domain, Params),
                    Then_Part => Result);
            else
               Result :=
                 New_And_Then_Expr
                   (Left   => Transform_Expr (Filter, Domain, Params),
                    Right  => Result,
                    Domain => Domain);
            end if;
         end if;
      end;

      Ada_Ent_To_Why.Pop_Scope (Symbol_Table);

      --  Step 6: in those cases where the quantified variable and the index
      --          variable are not the same, wrap the result in an expression
      --          that gives a value to the quantified variable based on the
      --          value of the index variable.

      if Need_Temp_Var then
         declare
            W_Binding_Expr : W_Expr_Id;
         begin
            if Over_Array then
               W_Binding_Expr :=
                 Make_Binding_For_Array
                   (Expr,
                    W_Over_Expr,
                    W_Index_Var,
                    W_Quant_Var,
                    Prog_Or_Term_Domain (Domain));
            else
               pragma Assert (Over_Content or Over_Cursors);
               W_Binding_Expr :=
                 Make_Binding_For_Iterable
                   (Expr,
                    W_Over_Expr,
                    Over_Type,
                    +W_Index_Var,
                    Prog_Or_Term_Domain (Domain),
                    W_Quant_Type,
                    Params);
            end if;

            Result :=
              New_Typed_Binding
                (Domain  => Domain,
                 Name    => W_Quant_Var,
                 Def     => W_Binding_Expr,
                 Context => Result);
         end;
      end if;

      --  Step 7: translate the quantified expression into a quantification in
      --          the predicate case, and an 'any' expression with a
      --          postcondition that uses the translation to predicate in the
      --          program case.

      if Domain = EW_Pred then
         declare
            Connector  : constant EW_Connector :=
              (if All_Present (Expr) then EW_Imply else EW_And);
            Quant_Body : constant W_Pred_Id :=
              New_Connection
                (Op => Connector, Left => +W_Bound_Expr, Right => +Result);
            Binders    : constant W_Binder_Array :=
              (1 =>
                 New_Binder
                   (Domain   => EW_Pred,
                    Name     => W_Index_Var,
                    Arg_Type => W_Index_Type));
         begin
            if All_Present (Expr) then
               Result :=
                 New_Universal_Quantif
                   (Ada_Node => Expr,
                    Binders  => Binders,
                    Labels   =>
                      Get_Counterexample_Labels
                        (Quant_Var,

                         --  When quantification is done on a temporary
                         --  variable, append a fake 'Index attribute that
                         --  will be recognized in counterexample handling.

                         Append_To_Name =>
                           (if Need_Temp_Var then "'" & Index_Label else "")),
                    Pred     => Quant_Body);
            else
               Result :=
                 New_Existential_Quantif
                   (Ada_Node => Expr,
                    Binders  => Binders,
                    Labels   => Symbol_Sets.Empty_Set,
                    Pred     => Quant_Body);
            end if;
         end;

      --  We are interested in the checks for the entire range, and in the
      --  return value of the entire expression, but we are not interested in
      --  the exact order in which things are evaluated. We also do not want
      --  to translate the expression function by a loop. So our scheme is:
      --    for all I in Cond => Expr
      --
      --  becomes:
      --    (let i = ref [ int ] in
      --       if cond then expr)
      --
      --  The condition is a formula that expresses that i is in the range
      --  given by the quantification.

      else
         --  Domain = EW_Prog
         Result :=
           +New_Typed_Binding
              (Name    => W_Index_Var,
               Def     => New_Simpl_Any_Prog (W_Index_Type),
               Context =>
                 New_Conditional
                   (Condition => +W_Bound_Expr, Then_Part => +Result));
      end if;

      --  Step 8: possibly bind the value of the temporary introduced for
      --          the expression over which quantification is done.

      if not Over_Range then
         Result :=
           Binding_For_Temp
             (Ada_Node => Expr,
              Domain   => Domain,
              Tmp      => W_Over_Expr,
              Context  => Result);
      end if;

      return Result;
   end Generate_Quantified_Expression;

   ------------------------
   -- Get_Item_From_Expr --
   ------------------------

   procedure Get_Item_From_Expr
     (Pattern     : Item_Type;
      Expr        : W_Expr_Id;
      Constr_Expr : W_Expr_Id := Why_Empty;
      Context     : in out Ref_Context;
      Args        : out W_Expr_Array;
      Need_Store  : out Boolean;
      Reuse_Discr : Boolean := False)
   is
      Count : Positive := Args'First;

   begin
      Need_Store := False;

      case Pattern.Kind is
         when Concurrent_Self | Regular =>

            --  We need to create a new reference if the binder is mutable

            if Pattern.Main.Mutable then
               Context.Append
                 (Ref_Type'
                    (Mutable => True,
                     Name    => Pattern.Main.B_Name,
                     Value   => +Expr));
               Args (Count) := +Pattern.Main.B_Name;
               Need_Store := True;

            --  Otherwise the expression is used as is

            else
               Args (Count) := +Expr;
            end if;
            Count := Count + 1;

         when DRecord                   =>

            --  If the pattern has a component for fields, it is necessarily
            --  mutable so we need a reference for it.

            if Pattern.Fields.Present then
               pragma Assert (Pattern.Fields.Binder.Mutable);
               Context.Append
                 (Ref_Type'
                    (Mutable => True,
                     Name    => Pattern.Fields.Binder.B_Name,
                     Value   =>
                       +New_Fields_Access (Name => Expr, Ty => Pattern.Typ)));
               Args (Count) := +Pattern.Fields.Binder.B_Name;
               Need_Store := True;
               Count := Count + 1;
            end if;

            --  We need a reference for discriminants if they are mutable. If
            --  Reuse_Discr is set to true, then the identifier from pattern
            --  can be used directly. Otherwise, we get the discriminant
            --  values from Expr.

            if Pattern.Discrs.Present and then Pattern.Discrs.Binder.Mutable
            then
               if not Reuse_Discr then
                  Context.Append
                    (Ref_Type'
                       (Mutable => True,
                        Name    => Pattern.Discrs.Binder.B_Name,
                        Value   =>
                          +New_Discriminants_Access
                             (Name => Expr, Ty => Pattern.Typ)));
                  Need_Store := True;
               end if;
               Args (Count) := +Pattern.Discrs.Binder.B_Name;
               Count := Count + 1;

            elsif Pattern.Discrs.Present then
               if Reuse_Discr then
                  Args (Count) := +Pattern.Discrs.Binder.B_Name;
               else
                  Args (Count) :=
                    +New_Discriminants_Access
                       (Name => Expr, Ty => Pattern.Typ);
               end if;
               Count := Count + 1;
            end if;

            --  For the Constr component, use the value of the 'Constrained
            --  attribute on the actual.

            if Pattern.Constr.Present then
               Args (Count) := Constr_Expr;
               Count := Count + 1;
            end if;

            if Pattern.Tag.Present then
               Args (Count) :=
                 New_Tag_Access
                   (Domain => EW_Prog, Name => +Expr, Ty => Pattern.Typ);

               Count := Count + 1;
            end if;

         when UCArray                   =>

            --  The Content component of the pattern is necessarily mutable so
            --  we need a reference for it.

            pragma Assert (Pattern.Content.Mutable);

            Context.Append
              (Ref_Type'
                 (Mutable => True,
                  Name    => Pattern.Content.B_Name,
                  Value   =>
                    (if Has_Static_Array_Type
                          (Get_Ada_Node (+Get_Type (+Expr)))
                     then Expr
                     else
                       Array_Convert_To_Base
                         (Domain => EW_Prog, Ar => Expr))));
            Args (Count) := +Pattern.Content.B_Name;
            Need_Store := True;
            Count := Count + 1;

            --  We get the bounds from Expr

            for I in 1 .. Pattern.Dim loop
               declare
                  Tmp_First  : constant W_Identifier_Id :=
                    New_Temp_Identifier
                      (Typ => Get_Type (+Expr), Base_Name => "for_first");
                  First_Expr : constant W_Term_Id :=
                    Get_Array_Attr
                      (Expr => +Tmp_First, Attr => Attribute_First, Dim => I);
               begin
                  Args (Count) :=
                    Insert_Simple_Conversion
                      (Domain => EW_Term,
                       Expr   =>
                         New_Typed_Binding
                           (Domain  => EW_Term,
                            Name    => Tmp_First,
                            Def     => Expr,
                            Context => +First_Expr),
                       To     => Get_Typ (Pattern.Bounds (I).First));
               end;

               declare
                  Tmp_Last  : constant W_Identifier_Id :=
                    New_Temp_Identifier
                      (Typ => Get_Type (+Expr), Base_Name => "for_last");
                  Last_Expr : constant W_Term_Id :=
                    Get_Array_Attr
                      (Expr => +Tmp_Last, Attr => Attribute_Last, Dim => I);
               begin
                  Args (Count + 1) :=
                    Insert_Simple_Conversion
                      (Domain => EW_Term,
                       Expr   =>
                         New_Typed_Binding
                           (Domain  => EW_Term,
                            Name    => Tmp_Last,
                            Def     => Expr,
                            Context => +Last_Expr),
                       To     => Get_Typ (Pattern.Bounds (I).Last));
               end;

               Count := Count + 2;
            end loop;

         when Pointer                   =>

            --  The Value component of the pattern is necessarily mutable so
            --  we need a reference for it.

            pragma Assert (Pattern.Value.Mutable);

            Context.Append
              (Ref_Type'
                 (Mutable => True,
                  Name    => Pattern.Value.B_Name,
                  Value   =>
                    New_Pointer_Value_Access
                      (Ada_Node => Empty,
                       Domain   => EW_Term,
                       E        => Pattern.P_Typ,
                       Name     => Expr)));
            Args (Count) := +Pattern.Value.B_Name;
            Need_Store := True;
            Count := Count + 1;

            --  If the is_null component is mutable, we also introduce a new
            --  reference for it. The initial value is taken from Expr.

            if Pattern.Mutable then
               Context.Append
                 (Ref_Type'
                    (Mutable => True,
                     Name    => Pattern.Is_Null,
                     Value   =>
                       +New_Pointer_Is_Null_Access
                          (E => Pattern.P_Typ, Name => Expr)));
               Args (Count) := +Pattern.Is_Null;
               Count := Count + 1;
            else
               Args (Count) :=
                 +New_Pointer_Is_Null_Access
                    (E => Pattern.P_Typ, Name => Expr);
               Count := Count + 1;
            end if;

         when Subp                      =>
            raise Program_Error;
      end case;
   end Get_Item_From_Expr;

   -----------------------
   -- Get_Item_From_Var --
   -----------------------

   procedure Get_Item_From_Var
     (Pattern    : in out Item_Type;
      Var        : Item_Type;
      Expr       : W_Expr_Id;
      Context    : in out Ref_Context;
      Args       : out W_Expr_Array;
      Need_Store : out Boolean)
   is
      Count : Positive := Args'First;

   begin
      Need_Store := False;

      case Pattern.Kind is
         when Concurrent_Self =>

            --  We can always reuse the reference for concurrent self

            Args (Count) := +Var.Main.B_Name;
            Count := Count + 1;

         when Regular         =>

            --  We can reuse the reference of the actual if Pattern and Var
            --  have the same type.

            if Pattern.Main.Mutable
              and then
                Eq_Base
                  (Get_Why_Type_From_Item (Pattern),
                   Get_Why_Type_From_Item (Var))
            then
               pragma Assert (Var.Kind = Regular and then Var.Main.Mutable);
               Args (Count) := +Var.Main.B_Name;

            --  Otherwise, a new temporary is needed

            else
               Get_Item_From_Expr
                 (Pattern    => Pattern,
                  Expr       => Expr,
                  Context    => Context,
                  Args       => Args,
                  Need_Store => Need_Store);
               return;
            end if;

         when DRecord         =>
            pragma Assert (Var.Kind = DRecord);

            --  Try to reuse the Fields identifier from Var

            if Pattern.Fields.Present then
               pragma Assert (Pattern.Fields.Binder.Mutable);

               --  We can reuse the Fields identifier from Var if both types
               --  have the same fields and both are wrapper types or none.

               if Oldest_Parent_With_Same_Fields (Pattern.Typ)
                 = Oldest_Parent_With_Same_Fields (Var.Typ)
                 and then
                   Is_Init_Wrapper_Type (Get_Why_Type_From_Item (Var))
                   = Is_Init_Wrapper_Type (Get_Why_Type_From_Item (Pattern))
               then
                  pragma
                    Assert
                      (Var.Fields.Present and then Var.Fields.Binder.Mutable);
                  Pattern.Fields := Var.Fields;
                  Args (Count) := +Var.Fields.Binder.B_Name;
                  Count := Count + 1;

               --  Otherwise, we revert to creating the identifiers from Expr.
               --  We can still reuse the variable for discriminants if both
               --  are similarly mutable.

               elsif Pattern.Discrs.Present
                 and then
                   Pattern.Discrs.Binder.Mutable = Var.Discrs.Binder.Mutable
               then
                  Pattern.Discrs := Var.Discrs;
                  Get_Item_From_Expr
                    (Pattern     => Pattern,
                     Expr        => Expr,
                     Context     => Context,
                     Args        => Args,
                     Constr_Expr =>
                       (if Var.Constr.Present
                        then +Var.Constr.Id
                        else Why_Empty),
                     Reuse_Discr => True,
                     Need_Store  => Need_Store);
                  return;
               else
                  Get_Item_From_Expr
                    (Pattern     => Pattern,
                     Expr        => Expr,
                     Context     => Context,
                     Args        => Args,
                     Constr_Expr =>
                       (if Var.Constr.Present
                        then +Var.Constr.Id
                        else Why_Empty),
                     Need_Store  => Need_Store);
                  return;
               end if;
            end if;

            --  Try to reuse the Discrs identifier from Var

            if Pattern.Discrs.Present then
               pragma Assert (Var.Discrs.Present);

               --  If both are similarly mutable, we can reuse the discriminant
               --  identifier as all convertible record types share the
               --  same discriminants.

               if Var.Discrs.Binder.Mutable = Pattern.Discrs.Binder.Mutable
               then
                  Pattern.Discrs := Var.Discrs;
                  Args (Count) := +Var.Discrs.Binder.B_Name;

               --  If the formal has mutable discriminants and not the actual,
               --  we need to create a new reference.

               elsif Pattern.Discrs.Binder.Mutable then
                  Context.Append
                    (Ref_Type'
                       (Mutable => True,
                        Name    => Pattern.Discrs.Binder.B_Name,
                        Value   => +Var.Discrs.Binder.B_Name));
                  Need_Store := True;
                  Args (Count) := +Pattern.Discrs.Binder.B_Name;

               --  If the actual has mutable discriminants and not the formal,
               --  we need a dereference.

               else
                  Args (Count) :=
                    New_Deref
                      (Right => Var.Discrs.Binder.B_Name,
                       Typ   => Get_Typ (Var.Discrs.Binder.B_Name));
               end if;
               Count := Count + 1;
            end if;

            --  Take the Constr field of Var. It should always be present as
            --  all variable objects of a type with default discriminants have
            --  this field (even when their subtype is constrained).

            if Pattern.Constr.Present then
               pragma Assert (Var.Constr.Present);
               Args (Count) := +Var.Constr.Id;

               Count := Count + 1;
            end if;

            if Pattern.Tag.Present then
               pragma Assert (Var.Tag.Present);
               Args (Count) := +Var.Tag.Id;

               Count := Count + 1;
            end if;

         when UCArray         =>

            --  We can reuse the content of Var if no sliding might occur as
            --  part of the conversion between Pattern and Var and both have
            --  the same relaxed initialization status.

            if Eq_Base
                 (Get_Why_Type_From_Item (Pattern),
                  Get_Why_Type_From_Item (Var))
              or else
                (not Needs_Slide
                       (Get_Ada_Type_From_Item (Pattern),
                        Get_Ada_Type_From_Item (Var))
                 and then
                   Get_Relaxed_Init (Get_Typ (Pattern.Content.B_Name))
                   = Get_Relaxed_Init (Get_Why_Type_From_Item (Var)))
            then

               --  The actual can be either an array in split form or a
               --  statically constrained array.
               --  If the actual is a split array, use elements from its
               --  binder.

               if Var.Kind = UCArray then
                  Args (Count) := +Var.Content.B_Name;
                  Count := Count + 1;

                  for Dim_Index in 1 .. Var.Dim loop
                     Args (Count) := +Var.Bounds (Dim_Index).First;
                     Args (Count + 1) := +Var.Bounds (Dim_Index).Last;
                     Count := Count + 2;
                  end loop;

               --  Otherwise, the actual is a static constrained array.
               --  We can reuse its identifier for the content but we must
               --  use its type to get the bounds.

               else
                  pragma
                    Assert
                      (Var.Kind = Regular
                       and then Var.Main.Mutable
                       and then
                         Is_Static_Array_Type (Get_Ada_Type_From_Item (Var)));

                  Args (Count) := +Var.Main.B_Name;
                  Count := Count + 1;

                  declare
                     Arr_Ty : constant Entity_Id :=
                       Get_Ada_Type_From_Item (Var);
                  begin
                     for Dim_Index in 1 .. Pattern.Dim loop
                        Args (Count) :=
                          +Insert_Simple_Conversion
                             (Expr =>
                                Get_Array_Attr
                                  (Domain => EW_Pterm,
                                   Ty     => Arr_Ty,
                                   Attr   => Attribute_First,
                                   Dim    => Dim_Index),
                              To   =>
                                Get_Typ (Pattern.Bounds (Dim_Index).First));
                        Args (Count + 1) :=
                          +Insert_Simple_Conversion
                             (Expr =>
                                Get_Array_Attr
                                  (Domain => EW_Pterm,
                                   Ty     => Arr_Ty,
                                   Attr   => Attribute_Last,
                                   Dim    => Dim_Index),
                              To   =>
                                Get_Typ (Pattern.Bounds (Dim_Index).Last));
                        Count := Count + 2;
                     end loop;
                  end;
               end if;

            --  Otherwise, the identifiers of the actual cannot be used.
            --  Use the expression instead.

            else
               Get_Item_From_Expr
                 (Pattern    => Pattern,
                  Expr       => Expr,
                  Context    => Context,
                  Args       => Args,
                  Need_Store => Need_Store);
               return;
            end if;

         when Pointer         =>
            pragma Assert (Var.Kind = Pointer);

            --  We can reuse the reference for the value of split
            --  pointers, if both pointer types designate the same subtype and
            --  have the same Relaxed_Initialization status.

            if Repr_Pointer_Type
                 (Get_Ada_Node (+Get_Why_Type_From_Item (Pattern)))
              = Repr_Pointer_Type
                  (Get_Ada_Node (+Get_Why_Type_From_Item (Var)))
              and then
                Get_Relaxed_Init (Get_Why_Type_From_Item (Pattern))
                = Get_Relaxed_Init (Get_Why_Type_From_Item (Var))
            then

               Args (Count) := +Var.Value.B_Name;
               Count := Count + 1;

               if Pattern.Mutable = Var.Mutable then
                  Args (Count) := +Var.Is_Null;
                  Count := Count + 1;
               else
                  pragma Assert (not Pattern.Mutable);
                  Args (Count) :=
                    New_Deref
                      (Right => Var.Is_Null, Typ => Get_Typ (Var.Is_Null));
                  Count := Count + 1;
               end if;

            --  Otherwise, use the expression instead.

            else
               Get_Item_From_Expr
                 (Pattern    => Pattern,
                  Expr       => Expr,
                  Context    => Context,
                  Args       => Args,
                  Need_Store => Need_Store);
               return;
            end if;

         when Subp            =>
            raise Program_Error;
      end case;
   end Get_Item_From_Var;

   -----------------------------
   -- Get_Valid_Id_For_Result --
   -----------------------------

   function Get_Valid_Id_For_Result (Fun : Entity_Id) return W_Term_Id is
   begin
      if not Is_Potentially_Invalid (Fun) then
         return Why_Empty;

      elsif Result_Is_Mutable then
         return
           New_Deref
             (Ada_Node => Empty,
              Right    => Get_Valid_Flag_For_Id (Result_Name, Etype (Fun)),
              Typ      => Get_Validity_Tree_Type (Etype (Fun)));

      else
         return +Get_Valid_Flag_For_Id (Result_Name, Etype (Fun));
      end if;
   end Get_Valid_Id_For_Result;

   ------------------------
   -- Get_Variants_Exprs --
   ------------------------

   function Get_Variants_Exprs
     (E : Callable_Kind_Id; Domain : EW_Domain; Params : Transformation_Params)
      return W_Expr_Array
   is
      Variants : constant Node_Id := Get_Pragma (E, Pragma_Subprogram_Variant);
      Exprs    : W_Expr_Array (1 .. Count_Numerical_Variants (E));
   begin
      if Exprs'Last > 0 then
         declare
            Aggr    : constant Node_Id :=
              Expression (First (Pragma_Argument_Associations (Variants)));
            Variant : Node_Id := First (Component_Associations (Aggr));
            Expr    : Node_Id;
            Count   : Positive := 1;
         begin
            while Present (Variant) loop
               Expr := Expression (Variant);
               Exprs (Count) :=
                 Transform_Expr
                   (Expr          => Expr,
                    Domain        => Domain,
                    Params        => Params,
                    Expected_Type => Base_Why_Type (Etype (Expr)));

               --  If Expr is a big integer, insert a check to make sure that
               --  the value stays non-negative.

               if not Has_Discrete_Type (Etype (Expr))
                 and then Domain = EW_Prog
               then
                  pragma
                    Assert
                      (Is_From_Hardcoded_Unit
                         (Base_Type (Etype (Expr)), Big_Integers));

                  declare
                     Tmp : constant W_Expr_Id :=
                       New_Temp_For_Expr (Exprs (Count));
                  begin
                     Exprs (Count) :=
                       +Sequence
                          (New_Located_Assert
                             (Ada_Node => Expr,
                              Pred     =>
                                New_Comparison
                                  (Symbol => Int_Infix_Ge,
                                   Left   => +Tmp,
                                   Right  =>
                                     New_Integer_Constant (Value => Uint_0)),
                              Reason   => VC_Range_Check,
                              Kind     => EW_Assert),
                           +Tmp);

                     Exprs (Count) :=
                       Binding_For_Temp
                         (Ada_Node => Expr,
                          Domain   => EW_Prog,
                          Tmp      => Tmp,
                          Context  => Exprs (Count));
                  end;
               end if;
               Count := Count + 1;
               Next (Variant);
            end loop;
         end;
      end if;
      return Exprs;
   end Get_Variants_Exprs;

   ----------------------
   -- Get_Variants_Ids --
   ----------------------

   function Get_Variants_Ids (E : Callable_Kind_Id) return W_Expr_Array is
      Variants : constant Opt_N_Pragma_Id :=
        Get_Pragma (E, Pragma_Subprogram_Variant);
      Exprs    : W_Expr_Array (1 .. Count_Numerical_Variants (E));
   begin
      if Exprs'Last > 0 then
         declare
            Aggr    : constant Node_Id :=
              Expression (First (Pragma_Argument_Associations (Variants)));
            Variant : Node_Id := First (Component_Associations (Aggr));
            Count   : Positive := 1;
         begin
            while Present (Variant) loop
               Exprs (Count) :=
                 +Variant_Append
                    (Base  => Full_Name (E),
                     Count => Count,
                     Typ   => Base_Why_Type (Etype (Expression (Variant))));
               Count := Count + 1;
               Next (Variant);
            end loop;
         end;
      end if;
      return Exprs;
   end Get_Variants_Ids;

   -------------------------------
   -- Havoc_Borrowed_Expression --
   -------------------------------

   function Havoc_Borrowed_Expression
     (Brower : Constant_Or_Variable_Kind_Id; Already_Equal : Boolean := False)
      return W_Prog_Id
   is
      Expr            : constant Node_Id := Get_Borrowed_Expr (Brower);
      Borrowed_At_End : constant W_Expr_Id := +Get_Borrowed_At_End (Brower);
      Assignment      : W_Prog_Id;

   begin
      --  If the borrowed object is not mutable (it happens when we are inside
      --  a traversal function), nothing needs to be done.

      if Is_Constant_Borrower (Brower) then
         return +Void;
      end if;

      --  We assign borrowed_at_end to Expr

      Continuation_Stack.Append
        (Continuation_Type'
           (Ada_Node => Brower,
            Message  =>
              To_Unbounded_String
                ("in reconstructed value at the end of the borrow")));

      if Already_Equal then
         Assignment :=
           New_Assume_Statement
             (Pred =>
                New_Comparison
                  (Symbol => Why_Eq,
                   Left   => +Transform_Expr (Expr, EW_Term, Body_Params),
                   Right  =>
                     +Insert_Simple_Conversion
                        (Ada_Node => Expr,
                         Domain   => EW_Term,
                         Expr     => Borrowed_At_End,
                         To       => Type_Of_Node (Expr))));
      else
         Assignment :=
           New_Assignment
             (Lvalue => Expr,
              Expr   =>
                +Insert_Checked_Conversion
                   (Ada_Node => Expr,
                    Domain   => EW_Prog,
                    Expr     => Borrowed_At_End,
                    To       => Type_Of_Node (Expr),
                    Lvalue   => True));
      end if;

      Continuation_Stack.Delete_Last;

      --  We produce:
      --
      --    assume { brower_at_end = brower };
      --    expr := borrowed_at_end;
      --
      --  Assignment is replaced by assume { expr = borrowed_at_end }
      --  if Already_Equal is set.

      return
        Sequence
          (Left  =>
             New_Assume_Statement
               (Pred =>
                  New_Comparison
                    (Symbol => Why_Eq,
                     Left   =>
                       New_Deref
                         (Right => Get_Brower_At_End (Brower),
                          Typ   => Get_Typ (Get_Brower_At_End (Brower))),
                     Right  =>
                       +Transform_Identifier
                          (Params => Body_Params,
                           Expr   => Brower,
                           Ent    => Brower,
                           Domain => EW_Term))),
           Right => Assignment);
   end Havoc_Borrowed_Expression;

   ---------------------------------------
   -- Insert_Check_For_Size_Of_Overlays --
   ---------------------------------------

   procedure Insert_Check_For_Size_Of_Overlays
     (Ada_Node        : Node_Id;
      Obj             : Entity_Id;
      Overlaid_Object : Node_Id;
      P               : in out W_Prog_Id;
      Params          : Transformation_Params)
   is

      --  Objects introduced for the sizes of Obj and its Overlaid_Object.
      --  If the size can be computed statically, Static_*_Size and *_Size_Str
      --  are set and Dynamic_*_Size is Why_Empty. If the size can only be
      --  computed dynamically, Dynamic_*_Size is set.

      Static_Obj_Size       : Uint;
      Obj_Size_Str          : Unbounded_String := Null_Unbounded_String;
      Dynamic_Obj_Size      : W_Expr_Id := Why_Empty;
      Overlaid_Size_Str     : Unbounded_String;
      Static_Overlaid_Size  : Uint;
      Dynamic_Overlaid_Size : W_Expr_Id := Why_Empty;
      Explanation           : Unbounded_String;
   begin
      Check_Known_Size_For_Object
        (Obj, Static_Obj_Size, Explanation, Obj_Size_Str);

      --  Try to compute the size of dynamic array object if static computation
      --  failed.

      if No (Static_Obj_Size) then

         --  Address cannot be supplied for a classwide type

         pragma Assert (not Is_Class_Wide_Type (Retysp (Etype (Obj))));

         --  Dynamic size computation is not supported on entities with
         --  mutable discriminants, reject it here.

         if Has_Mutable_Discriminants (Retysp (Etype (Obj))) then
            Emit_Static_Proof_Result
              (Ada_Node,
               VC_UC_Same_Size,
               False,
               Current_Subp,
               Explanation => "overlaid object has mutable discriminants");
            return;
         end if;

         declare
            Precise     : Boolean;
            Explanation : Unbounded_String;
         begin
            Compute_Size_Of_Object
              (Obj, EW_Term, Params, Dynamic_Obj_Size, Precise, Explanation);
         end;
      end if;

      Check_Known_Size_For_Object
        (Overlaid_Object,
         Static_Overlaid_Size,
         Explanation,
         Overlaid_Size_Str);

      if No (Static_Overlaid_Size) then

         --  Dynamic size computation is not supported on classwide
         --  expressions, reject it here.

         if Is_Class_Wide_Type (Retysp (Etype (Overlaid_Object))) then
            Emit_Static_Proof_Result
              (Ada_Node,
               VC_UC_Same_Size,
               False,
               Current_Subp,
               Explanation => "overlaid object has a classwide type");
            return;
         end if;

         declare
            Precise     : Boolean;
            Explanation : Unbounded_String;
         begin
            Compute_Size_Of_Object
              (Overlaid_Object,
               EW_Term,
               Params,
               Dynamic_Overlaid_Size,
               Precise,
               Explanation);
         end;
      end if;

      --  If one of the sizes is dynamic, add a dynamic check to P

      if No (Static_Obj_Size) or No (Static_Overlaid_Size) then
         if No (Dynamic_Obj_Size) then
            pragma Assert (Present (Static_Obj_Size));
            Dynamic_Obj_Size :=
              New_Integer_Constant (Value => Static_Obj_Size);
         elsif No (Dynamic_Overlaid_Size) then
            pragma Assert (Present (Static_Overlaid_Size));
            Dynamic_Overlaid_Size :=
              New_Integer_Constant (Value => Static_Overlaid_Size);
         end if;

         P :=
           +Sequence
              (New_Ignore
                 (Prog =>
                    Why.Gen.Progs.New_Located_Assert
                      (Ada_Node => Ada_Node,
                       Pred     =>
                         New_Comparison
                           (Symbol => Why_Eq,
                            Left   => +Dynamic_Obj_Size,
                            Right  => +Dynamic_Overlaid_Size),
                       Reason   => VC_UC_Same_Size,
                       Kind     => EW_Assert)),
               P);

      --  Otherwise, everything is static. Check the sizes and emit a static
      --  proof result.

      else
         Explanation :=
           To_Unbounded_String
             ("sizes of overlaid objects differ: "
              & To_String (Obj_Size_Str)
              & " "
              & Escape (UI_Image (Static_Obj_Size))
              & ", while "
              & To_String (Overlaid_Size_Str)
              & " "
              & Escape (UI_Image (Static_Overlaid_Size)));

         Emit_Static_Proof_Result
           (Ada_Node,
            VC_UC_Same_Size,
            Static_Obj_Size = Static_Overlaid_Size,
            Current_Subp,
            Explanation => To_String (Explanation));
      end if;
   end Insert_Check_For_Size_Of_Overlays;

   ----------------------------
   -- Insert_Invariant_Check --
   ----------------------------

   function Insert_Invariant_Check
     (Ada_Node   : Node_Id;
      Check_Ty   : Type_Kind_Id;
      W_Expr     : W_Prog_Id;
      Var_Ent    : Opt_Object_Kind_Id := Empty;
      Check_Info : Check_Info_Type := New_Check_Info) return W_Prog_Id
   is
      W_Tmp : constant W_Identifier_Id :=
        New_Temp_Identifier (Typ => Get_Type (+W_Expr), Ada_Node => Var_Ent);
      --  If W_Expr is an array in split form, we need to link W_Tmp to Var_Ent
      --  so that the proper bounds can be retrieved.

      W_Seq : constant W_Prog_Id :=
        Sequence
          (New_Invariant_Check
             (Ada_Node, Check_Ty, +W_Tmp, Check_Info => Check_Info),
           +W_Tmp);
   begin
      return
        New_Binding
          (Ada_Node => Ada_Node,
           Name     => +W_Tmp,
           Def      => W_Expr,
           Context  => W_Seq,
           Typ      => Get_Type (+W_Expr));
   end Insert_Invariant_Check;

   -----------------------------------
   -- Insert_Invariant_Check_For_Eq --
   -----------------------------------

   function Insert_Invariant_Check_For_Eq
     (Ada_Node         : Node_Id;
      Typ              : Type_Kind_Id;
      W_Expr           : W_Expr_Id;
      Domain           : EW_Domain;
      Force_Predefined : Boolean := True) return W_Expr_Id
   is
      function Compute_Type_Invariant_For_Eq
        (Typ            : Type_Kind_Id;
         W_Expr         : W_Term_Id;
         Skip_Top_Level : Boolean := False) return W_Pred_Id;
      --  Generate a predicate with the potential type invariants of all
      --  subcomponents of W_Expr of type Typ that have a user-defined equality
      --  which is used in the predefined equality of enclosing types.
      --  If Skip_Top_Level is True, do not consider Typ itself, even if it has
      --  a user-defined equality.

      function Compute_Inv_For_Field
        (F_Expr : W_Term_Id; F_Ty : Entity_Id; E : Entity_Id) return W_Pred_Id
      is (if Ekind (E) = E_Component
          then Compute_Type_Invariant_For_Eq (F_Ty, F_Expr)
          else True_Pred);

      function Compute_Inv_For_Record is new
        Build_Predicate_For_Record
          (Compute_Inv_For_Field,
           Compute_Inv_For_Field);

      function Compute_Inv_For_Comp
        (C_Expr : W_Term_Id; C_Ty : Entity_Id; Unused_Idx : W_Expr_Array)
         return W_Pred_Id
      is (Compute_Type_Invariant_For_Eq (C_Ty, C_Expr));

      function Compute_Inv_For_Array is new
        Build_Predicate_For_Array (Compute_Inv_For_Comp);

      -----------------------------------
      -- Compute_Type_Invariant_For_Eq --
      -----------------------------------

      function Compute_Type_Invariant_For_Eq
        (Typ            : Type_Kind_Id;
         W_Expr         : W_Term_Id;
         Skip_Top_Level : Boolean := False) return W_Pred_Id is
      begin
         --  If Typ has a primitive equality, perform invariant checks

         if not Skip_Top_Level
           and then not Use_Predefined_Equality_For_Type (Typ)
         then
            return
              Compute_Type_Invariant
                (+W_Expr, Typ, For_Check, Scop => Current_Subp);

         --  For composite types, traverse the type to find potential
         --  subcomponents with a primitive equality.

         elsif Has_Array_Type (Typ) then
            return Compute_Inv_For_Array (W_Expr, Typ);

         elsif Is_Record_Type_In_Why (Typ) then

            --  Type invariants are not supported on tagged types and on
            --  components of tagged types, so Typ cannot be tagged. No need
            --  to account for the parent equality. Simply traverse the
            --  components.

            pragma Assert (not Is_Tagged_Type (Typ));
            return Compute_Inv_For_Record (W_Expr, Typ);
         else
            pragma Assert (Has_Scalar_Type (Typ));
            return True_Pred;
         end if;
      end Compute_Type_Invariant_For_Eq;

      --  Start of processing for Insert_Invariant_Check_For_Eq

   begin
      if Domain /= EW_Prog
        or else not Invariant_Check_Needed (Typ, Scop => Current_Subp)
      then
         return W_Expr;

      else
         declare
            W_Tmp : constant W_Expr_Id := New_Temp_For_Expr (+W_Expr);
            Inv   : constant W_Pred_Id :=
              Compute_Type_Invariant_For_Eq
                (Retysp (Typ), +W_Tmp, Skip_Top_Level => Force_Predefined);
         begin
            if Is_True_Boolean (+Inv) then
               return W_Expr;
            else
               return
                 +Binding_For_Temp
                    (Ada_Node => Ada_Node,
                     Tmp      => +W_Tmp,
                     Context  =>
                       Sequence
                         (New_Ignore
                            (Prog =>
                               New_Assert
                                 (Pred        =>
                                    New_VC_Pred
                                      (Ada_Node, Inv, VC_Invariant_Check),
                                  Assert_Kind => EW_Assert)),
                          +W_Tmp));
            end if;
         end;
      end if;
   end Insert_Invariant_Check_For_Eq;

   -------------------------------
   -- Insert_Move_Of_Deep_Parts --
   -------------------------------

   procedure Insert_Move_Of_Deep_Parts
     (Rhs     : N_Subexpr_Id;
      Lhs_Typ : Entity_Id;
      Expr    : in out W_Prog_Id;
      Do_Move : out Boolean)
   is
      --  Local subprograms

      procedure Collect_Moved_Objects
        (Expr   : Node_Id;
         Set    : in out Node_Sets.Set;
         Checks : in out W_Prog_Id);
      --  Add in Set all moved objects from Expr and emit in Checks resource
      --  leak checks for conversions to types without reclamation.

      function Tmp_Of_Expr (Expr : W_Expr_Id) return W_Identifier_Id;
      --  Return a temporary identifier suitable to be used in place of Expr

      ---------------------------
      -- Collect_Moved_Objects --
      ---------------------------

      procedure Collect_Moved_Objects
        (Expr : Node_Id; Set : in out Node_Sets.Set; Checks : in out W_Prog_Id)
      is
         --  Local subprograms

         procedure Collect_Associations (Assocs : List_Id);
         --  Collect objects in all associations of an aggregate

         procedure Collect_Expressions (Expressions : List_Id);
         --  Collect objects in all expressions of an aggregate

         procedure Collect_Subobject (Expr : Node_Id);
         --  Collect a subobject, passing in the Set and Checks

         --------------------------
         -- Collect_Associations --
         --------------------------

         procedure Collect_Associations (Assocs : List_Id) is
            Assoc : Node_Id := Nlists.First (Assocs);
         begin
            while Present (Assoc) loop
               if not Box_Present (Assoc) then
                  Collect_Subobject (SPARK_Atree.Expression (Assoc));
               end if;
               Next (Assoc);
            end loop;
         end Collect_Associations;

         -------------------------
         -- Collect_Expressions --
         -------------------------

         procedure Collect_Expressions (Expressions : List_Id) is
            N : Node_Id;
         begin
            N := First (Expressions);
            while Present (N) loop
               Collect_Subobject (N);
               Next (N);
            end loop;
         end Collect_Expressions;

         -----------------------
         -- Collect_Subobject --
         -----------------------

         procedure Collect_Subobject (Expr : Node_Id) is
         begin
            Collect_Moved_Objects (Expr, Set => Set, Checks => Checks);
         end Collect_Subobject;

         --  Start of processing for Collect_Moved_Objects

      begin
         --  Object can be moved, insert it in the set unless at top-level

         if Can_Be_Moved (Expr) then
            Set.Insert (Expr);
            return;
         end if;

         --  Otherwise, look at sub-objects that may be moved

         --  The cases considered below should correspond to those in
         --  Check_Anonymous_Object in gnat2why-borrow_checker.adb

         case Nkind (Expr) is
            when N_Qualified_Expression
               | N_Type_Conversion
               | N_Unchecked_Type_Conversion =>

               --  Insert resource leak checks if the conversion is a move of a
               --  pool specific access type to a general or access-to-constant
               --  type.

               if Is_Access_Type (Retysp (Etype (Expr))) then
                  pragma
                    Assert
                      (not In_Statically_Leaking_Context
                             (Expr, Ignore_Non_Exec => False));

                  declare
                     Target_Typ : constant Entity_Id := Retysp (Etype (Expr));
                     To_Const   : constant Boolean :=
                       Is_Access_Constant (Target_Typ);
                     To_Gen     : constant Boolean :=
                       Is_General_Access_Type (Target_Typ);
                     Source_Typ : constant Entity_Id :=
                       Retysp (Etype (Expression (Expr)));
                     From_Const : constant Boolean :=
                       Is_Access_Constant (Source_Typ)
                       or else Is_Rooted_In_Constant (Expression (Expr));
                     From_Gen   : constant Boolean :=
                       Is_General_Access_Type (Source_Typ);

                  begin
                     --  Insert check for resource leak if needed

                     if (To_Gen or else To_Const)
                       and then not From_Gen
                       and then not From_Const
                       and then not Value_Is_Never_Leaked (Expr)
                     then
                        Append
                          (Checks,
                           Check_No_Memory_Leaks (Expr, Expression (Expr)));
                     end if;
                  end;
               end if;

               Collect_Subobject (Expression (Expr));

            --  No move occurs in an uninitialized allocator

            when N_Allocator                 =>
               if Nkind (Expression (Expr)) = N_Qualified_Expression then
                  Collect_Subobject (Expression (Expr));
               end if;

            when N_Aggregate                 =>
               Collect_Expressions (Expressions (Expr));
               Collect_Associations (Component_Associations (Expr));

            when N_Delta_Aggregate           =>
               Collect_Subobject (Expression (Expr));
               Collect_Associations (Component_Associations (Expr));

            when N_Extension_Aggregate       =>
               Collect_Subobject (Ancestor_Part (Expr));
               Collect_Expressions (Expressions (Expr));
               Collect_Associations (Component_Associations (Expr));

            when N_Attribute_Reference       =>
               case Get_Attribute_Id (Attribute_Name (Expr)) is

                  --  Handle 'Update like delta aggregate

                  when Attribute_Update =>
                     Collect_Subobject (Prefix (Expr));
                     Collect_Expressions (Expressions (Expr));

                  --  If 'Access is applied to an object, move the fields of
                  --  the prefix.

                  when Attribute_Access =>
                     if not Is_Access_Subprogram_Type (Etype (Expr)) then
                        Collect_Subobject (Prefix (Expr));
                     end if;

                  when others           =>
                     null;
               end case;

            when others                      =>
               null;
         end case;
      end Collect_Moved_Objects;

      -----------------
      -- Tmp_Of_Expr --
      -----------------

      function Tmp_Of_Expr (Expr : W_Expr_Id) return W_Identifier_Id is
         Typ : constant W_Type_Id := Get_Type (+Expr);
      begin
         return New_Temp_Identifier (Typ => Typ, Base_Name => "for_move");
      end Tmp_Of_Expr;

      --  Local variables

      Nested_Moved : Node_Sets.Set;
      Checks       : W_Prog_Id := +Void;
      Tmp          : constant W_Identifier_Id := Tmp_Of_Expr (+Expr);
      Init         : constant W_Prog_Id := Expr;

      --  Start of processing for Insert_Move_Of_Deep_Parts

   begin
      --  There is no move at all for a borrow or observe

      if Is_Anonymous_Access_Type (Lhs_Typ) then
         Do_Move := False;

      --  If Rhs can be moved, do it

      elsif Can_Be_Moved (Rhs) then
         Do_Move := True;
         Expr := Sequence (Move_Expression (Rhs, Tmp), +Tmp);

      --  Otherwise, collect all deep objects potentially moved inside an
      --  aggregate.

      else
         Collect_Moved_Objects (Rhs, Set => Nested_Moved, Checks => Checks);
         Do_Move := not Nested_Moved.Is_Empty;

         if Do_Move then
            Expr := +Tmp;

            for Obj of Nested_Moved loop
               declare
                  Obj_Expr : constant W_Expr_Id :=
                    Transform_Expr (Obj, EW_Term, Body_Params);
                  Obj_Tmp  : constant W_Identifier_Id :=
                    Tmp_Of_Expr (Obj_Expr);
               begin
                  Expr :=
                    New_Binding
                      (Name    => +Obj_Tmp,
                       Def     => +Obj_Expr,
                       Context =>
                         Sequence (Move_Expression (Obj, Obj_Tmp), Expr),
                       Typ     => Get_Type (+Expr));
               end;
            end loop;
         end if;

         Expr := Sequence (Checks, Expr);
      end if;

      if Do_Move then
         Expr :=
           New_Binding
             (Name    => Tmp,
              Def     => Init,
              Context => Expr,
              Typ     => Get_Type (+Expr));
      end if;
   end Insert_Move_Of_Deep_Parts;

   ---------------------------
   -- Insert_Overflow_Check --
   ---------------------------

   function Insert_Overflow_Check
     (Ada_Node : Node_Id;
      T        : W_Expr_Id;
      In_Type  : Type_Kind_Id;
      Is_Float : Boolean) return W_Prog_Id
   is
      Base : constant Entity_Id := Base_Type (In_Type);

   begin
      return
        New_VC_Call
          (Ada_Node => Ada_Node,
           Name     => E_Symb (Base, WNE_Range_Check_Fun),
           Progs    => (1 => T),
           Reason   =>
             (if Is_Float then VC_FP_Overflow_Check else VC_Overflow_Check),
           Typ      => Get_Type (T));
   end Insert_Overflow_Check;

   ----------------------------
   -- Insert_Predicate_Check --
   ----------------------------

   function Insert_Predicate_Check
     (Ada_Node      : Node_Id;
      Check_Ty      : Type_Kind_Id;
      W_Expr        : W_Prog_Id;
      Top_Predicate : Boolean := True) return W_Prog_Id
   is
      W_Tmp : constant W_Identifier_Id :=
        New_Temp_Identifier (Typ => Get_Type (+W_Expr));

      W_Seq : constant W_Prog_Id :=
        Sequence
          (New_Predicate_Check
             (Ada_Node, Check_Ty, +W_Tmp, Top_Predicate => Top_Predicate),
           +W_Tmp);
   begin
      return
        New_Binding
          (Ada_Node => Ada_Node,
           Name     => +W_Tmp,
           Def      => W_Expr,
           Context  => W_Seq,
           Typ      => Get_Type (+W_Expr));
   end Insert_Predicate_Check;

   ------------------------
   -- Insert_Ref_Context --
   ------------------------

   function Insert_Ref_Context
     (Ada_Call : Node_Id;
      Why_Call : W_Prog_Id;
      Context  : Ref_Context;
      Store    : in out W_Statement_Sequence_Id) return W_Prog_Id
   is
      Ref_Context : W_Prog_Id;
      Subp        : constant Entity_Id :=
        Get_Called_Entity_For_Proof (Ada_Call);

   begin
      --  In the case of a procedure or entry call, there is no value to return
      --  as the final expression, so just prepend the call at the start of the
      --  sequence.

      if Nkind (Ada_Call)
         in N_Procedure_Call_Statement | N_Entry_Call_Statement
      then
         Prepend (Why_Call, Store);
         Ref_Context := +Store;

      --  In the case of a function call, there is value to return as the final
      --  expression. Note that this can only occur for calls to functions
      --  with side effects or calls to or volatile functions, when one of
      --  the parameters is of a volatile type. Save the result of the call at
      --  the start of the sequence (Ref_Context consists in the sequence of
      --  post-call assignments and assumptions at this point) and use it as
      --  the final value for the sequence.

      elsif not Is_Void_Sequence (Store) then
         declare
            Tmp : constant W_Identifier_Id :=
              New_Temp_Identifier (Ada_Call, Get_Type (+Why_Call));
         begin
            Ref_Context :=
              New_Typed_Binding
                (Name    => Tmp,
                 Def     => Why_Call,
                 Context => Sequence (+Store, +Tmp));
         end;
      else
         Ref_Context := Why_Call;
      end if;

      --  We need to havoc the values of global variables of mode Output if
      --  they have parts with relaxed initialization so that their value
      --  before the call cannot leak into subsequently read values.

      declare
         Read_Ids  : Flow_Types.Flow_Id_Sets.Set;
         Write_Ids : Flow_Types.Flow_Id_Sets.Set;
         Effects   : constant W_Effects_Id := New_Effects;
         Has_Out   : Boolean := False;

      begin
         Flow_Utility.Get_Proof_Globals
           (Subprogram      => Subp,
            Reads           => Read_Ids,
            Writes          => Write_Ids,
            Erase_Constants => True);

         for Write_Id of Write_Ids loop
            if not Read_Ids.Contains (Write_Id) then
               case Write_Id.Kind is
                  when Direct_Mapping =>
                     declare
                        Entity : constant Entity_Id :=
                          Get_Direct_Mapping_Id (Write_Id);
                        Binder : constant Item_Type :=
                          Ada_Ent_To_Why.Element (Symbol_Table, Entity);

                     begin
                        if Contains_Relaxed_Init_Parts (Etype (Entity))
                          or else Obj_Has_Relaxed_Init (Entity)
                        then
                           Has_Out := True;
                           case Binder.Kind is
                              when DRecord =>
                                 pragma Assert (Binder.Fields.Present);
                                 Effects_Append_To_Writes
                                   (Effects, Binder.Fields.Binder.B_Name);

                              when UCArray =>
                                 Effects_Append_To_Writes
                                   (Effects, Binder.Content.B_Name);

                              when Pointer =>
                                 Effects_Append_To_Writes
                                   (Effects, Binder.Value.B_Name);

                              when Regular =>
                                 Effects_Append_To_Writes
                                   (Effects, Binder.Main.B_Name);

                              when others  =>
                                 raise Program_Error;
                           end case;

                           if Binder.Init.Present then
                              Effects_Append_To_Writes
                                (Effects, Binder.Init.Id);
                           end if;
                        end if;
                     end;

                  when Magic_String   =>
                     Has_Out := True;
                     Effects_Append_To_Writes
                       (Effects,
                        To_Why_Id (Obj => To_Name (Write_Id), Local => False));

                  when others         =>
                     raise Program_Error;
               end case;
            end if;
         end loop;

         if Has_Out then
            Prepend
              (New_Havoc_Statement (Ada_Node => Ada_Call, Effects => Effects),
               Ref_Context);
         end if;
      end;

      Ref_Context :=
        +Bindings_For_Ref_Context (+Ref_Context, Context, EW_Prog);
      return Ref_Context;
   end Insert_Ref_Context;

   ----------------------
   -- Is_Simple_Actual --
   ----------------------

   function Is_Simple_Actual (Actual : N_Subexpr_Id) return Boolean is
   begin
      return
        Nkind (Actual) in N_Identifier | N_Expanded_Name
        and then
          not Is_Protected_Component_Or_Discr_Or_Part_Of (Entity (Actual))
        and then No (Ultimate_Overlaid_Entity (Entity (Actual)));
   end Is_Simple_Actual;

   ----------------------
   -- Is_Terminal_Node --
   ----------------------

   function Is_Terminal_Node (N : Node_Id) return Boolean is
   begin
      if Nkind (N) = N_And_Then then
         return
           (Is_Predicate_Function_Call (Left_Opnd (N))
            and then Is_Terminal_Node (Right_Opnd (N)))
           or
             (Is_Predicate_Function_Call (Right_Opnd (N))
              and then Is_Terminal_Node (Left_Opnd (N)));
      else
         return
           Nkind (N)
           not in N_Op_And
                | N_If_Expression
                | N_Case_Expression
                | N_Expression_With_Actions
           and then
             not (Nkind (N) in N_Quantified_Expression
                  and then All_Present (N));
      end if;
   end Is_Terminal_Node;

   ---------------------
   -- Move_Expression --
   ---------------------

   function Move_Expression
     (Expr : N_Subexpr_Id; Tmp : W_Identifier_Id) return W_Prog_Id
   is
      Exp_Ty      : constant Entity_Id := Expected_Type_For_Move_Tree (Expr);
      W_Typ       : constant W_Type_Id :=
        (if Has_Init_Wrapper (Exp_Ty)
         then EW_Init_Wrapper (Type_Of_Node (Exp_Ty))
         else Type_Of_Node (Exp_Ty));
      Moved_Value : constant W_Prog_Id :=
        New_Call
          (Name => E_Symb (Exp_Ty, WNE_Moved_Tree),
           Args =>
             (1 =>
                Insert_Simple_Conversion
                  (Expr => +Tmp, Domain => EW_Pterm, To => W_Typ)),
           Typ  => Get_Move_Tree_Type (Exp_Ty));
   begin
      return New_Move_Tree_Assignment (Lvalue => Expr, Expr => Moved_Value);
   end Move_Expression;

   --------------------
   -- New_Assignment --
   --------------------

   function New_Assignment
     (Ada_Node    : Node_Id := Empty;
      Lvalue      : N_Subexpr_Id;
      Expr        : W_Prog_Id;
      Do_Check    : Do_Check_Kind := All_Checks;
      Preserv_Tag : Boolean := True;
      Index_Map   : Ada_Node_To_Why_Id.Map := Ada_Node_To_Why_Id.Empty_Map)
      return W_Prog_Id
   is
      --  Here, we deal with assignment statements. In SPARK, the general form
      --  of an assignment is
      --
      --    Lvalue := Expr;
      --
      --  where Lvalue is a mix of array and record accesses. If we adopt the
      --  same notation for both, we obtain the general form
      --
      --    Prefix.Acc1.Acc2.(...).Accn := Expr;
      --
      --  where the Acc(i) are either array accesses using an index (or
      --  several indices in the multidimensional case) or record accesses
      --  using a field name.
      --
      --  Here, we generate Why code of the form
      --
      --    Prefix := Upd (Prefix, Acc1,
      --                   (Upd (Prefix.Acc1, Acc2,
      --                         Upd (..., Accn, Expr))));

      Left_Side   : Node_Id := Lvalue;
      Right_Side  : W_Expr_Id := +Expr;
      Last_Access : Node_Id := Empty;
      Result      : W_Prog_Id := +Void;
      Domain      : constant EW_Domain :=
        (if Do_Check = No_Checks then EW_Pterm else EW_Prog);

      --  Start of processing for New_Assignment

   begin
      --  If Preserv_Tag is set, preserve the tag and extension of objects if
      --  they have a specific tagged type.

      if Preserv_Tag
        and then Is_Tagged_Type (Etype (Left_Side))
        and then not Is_Class_Wide_Type (Etype (Left_Side))
      then
         declare
            Typ      : constant Entity_Id := Etype (Left_Side);
            Old_Left : constant W_Expr_Id :=
              Transform_Expr (Left_Side, EW_Pterm, Body_Params);
         begin
            Right_Side :=
              New_Tag_And_Ext_Update
                (Ada_Node  => Ada_Node,
                 Domain    => Domain,
                 Name      => Right_Side,
                 From_Expr => Old_Left,
                 Ty        => Typ);
         end;
      end if;

      while not (Nkind (Left_Side) in N_Identifier | N_Expanded_Name) loop
         Shift_Rvalue
           (Left_Side,
            Right_Side,
            Last_Access,
            Domain,
            Check_Prefix => Do_Check = All_Checks,
            Index_Map    => Index_Map);
      end loop;

      --  In those cases where the left-hand side is type converted, the type
      --  of the Left_Side and Right_Side may not coincide here. Convert the
      --  Right_Side to the type of the Left_Side. Possible checks were taken
      --  into account before.

      Right_Side :=
        Insert_Simple_Conversion
          (Domain => EW_Pterm,
           To     => Type_Of_Node (Left_Side),
           Expr   => Right_Side);

      --  In the case of protected components, we have to generate the record
      --  code ourselves on top.

      if Is_Protected_Component_Or_Discr_Or_Part_Of (Entity (Left_Side)) then
         declare
            Prot_Obj : constant W_Identifier_Id := Self_Name;

         begin
            pragma Assert (Self_Is_Mutable);

            Result :=
              New_Assignment
                (Ada_Node => Ada_Node,
                 Name     => Prot_Obj,
                 Labels   => Symbol_Sets.Empty_Set,
                 Value    =>
                   +One_Level_Update
                      (Left_Side,
                       New_Deref
                         (Right => +Prot_Obj, Typ => Get_Typ (Prot_Obj)),
                       Right_Side,
                       Domain,
                       Body_Params),
                 Typ      => Get_Typ (Prot_Obj));
         end;

      --  For overlays, the ultimate alias is havocked and the value of the
      --  object is assumed.

      elsif Present (Ultimate_Overlaid_Entity (Entity (Left_Side))) then
         Result := New_Overlay_Assignment (Entity (Left_Side), +Right_Side);
      else
         declare
            Binder : constant Item_Type :=
              Ada_Ent_To_Why.Element (Symbol_Table, Entity (Left_Side));
         begin
            case Binder.Kind is
               when Regular                =>
                  Append
                    (Result,
                     New_Assignment
                       (Ada_Node => Ada_Node,
                        Name     => Binder.Main.B_Name,
                        Labels   => Symbol_Sets.Empty_Set,
                        Value    => +Right_Side,
                        Typ      => Get_Typ (Binder.Main.B_Name)));

               when UCArray                =>
                  Append
                    (Result,
                     New_Assignment
                       (Ada_Node => Ada_Node,
                        Name     => Binder.Content.B_Name,
                        Labels   => Symbol_Sets.Empty_Set,
                        Value    =>
                          +Array_Convert_To_Base
                             (Ar => Right_Side, Domain => EW_Prog),
                        Typ      => Get_Typ (Binder.Content.B_Name)));

               when DRecord                =>
                  declare
                     Tmp : constant W_Prog_Id :=
                       New_Temp_For_Expr (+Right_Side);

                  begin
                     pragma
                       Assert
                         (No (Last_Access)
                          or else
                            (Nkind (Last_Access) = N_Selected_Component
                             and then
                               Ekind (Entity (Selector_Name (Last_Access)))
                               /= E_Discriminant));

                     if Binder.Fields.Present then
                        Append
                          (Result,
                           New_Assignment
                             (Ada_Node => Ada_Node,
                              Name     => Binder.Fields.Binder.B_Name,
                              Labels   => Symbol_Sets.Empty_Set,
                              Value    =>
                                New_Fields_Access
                                  (Name => Tmp, Ty => Binder.Typ),
                              Typ      =>
                                Get_Typ (Binder.Fields.Binder.B_Name)));
                     end if;

                     --  Discriminants cannot have been updated if the last
                     --  access was a selected components as discriminants can
                     --  only be modified when the object is assigned as a
                     --  whole.

                     if Binder.Discrs.Present and then No (Last_Access) then
                        if Binder.Discrs.Binder.Mutable then
                           Append
                             (Result,
                              New_Assignment
                                (Ada_Node => Ada_Node,
                                 Name     => Binder.Discrs.Binder.B_Name,
                                 Labels   => Symbol_Sets.Empty_Set,
                                 Value    =>
                                   New_Discriminants_Access
                                     (Name => Tmp, Ty => Binder.Typ),
                                 Typ      =>
                                   Get_Typ (Binder.Discrs.Binder.B_Name)));
                        else
                           Append
                             (Result,
                              New_Assume_Statement
                                (Ada_Node => Ada_Node,
                                 Pred     =>
                                   New_Comparison
                                     (Symbol => Why_Eq,
                                      Left   => +Binder.Discrs.Binder.B_Name,
                                      Right  =>
                                        New_Discriminants_Access
                                          (Name => +Tmp, Ty => Binder.Typ))));
                        end if;
                     end if;

                     Result :=
                       Binding_For_Temp
                         (Ada_Node => Ada_Node,
                          Tmp      => +Tmp,
                          Context  => Result);
                  end;

               when Pointer                =>
                  declare
                     Binder_Typ : constant Entity_Id := Binder.P_Typ;
                     Tmp        : constant W_Prog_Id :=
                       New_Temp_For_Expr (+Right_Side);

                  begin
                     pragma
                       Assert
                         (No (Last_Access)
                          or else
                            Nkind (Last_Access) = N_Explicit_Dereference);

                     Append
                       (Result,
                        New_Assignment
                          (Ada_Node => Ada_Node,
                           Name     => Binder.Value.B_Name,
                           Labels   => Symbol_Sets.Empty_Set,
                           Value    =>
                             +New_Pointer_Value_Access
                                (Ada_Node => Empty,
                                 Domain   => EW_Pterm,
                                 Name     => +Tmp,
                                 E        => Binder_Typ),
                           Typ      => Get_Typ (Binder.Value.B_Name)));

                     --  Is_null cannot have been updated if the last access
                     --  was a dereference.

                     if Binder.Mutable and then No (Last_Access) then
                        Append
                          (Result,
                           New_Assignment
                             (Ada_Node => Ada_Node,
                              Name     => Binder.Is_Null,
                              Labels   => Symbol_Sets.Empty_Set,
                              Value    =>
                                New_Pointer_Is_Null_Access
                                  (Name => Tmp, E => Binder_Typ),
                              Typ      => Get_Typ (Binder.Is_Null)));
                     end if;

                     Result :=
                       Binding_For_Temp
                         (Ada_Node => Ada_Node,
                          Tmp      => +Tmp,
                          Context  => Result);
                  end;

               when Subp | Concurrent_Self =>
                  raise Program_Error;
            end case;

            --  Assign the initialization flag if any. Do it after the main
            --  assignment so as to avoid doing it if an exception is raised by
            --  the evaluation of parameters.
            --  Always assign it to True, if a different value is necessary,
            --  another assignment needs to be added afterwards.

            if Binder.Init.Present then
               Append
                 (Result,
                  New_Assignment
                    (Ada_Node => Ada_Node,
                     Name     => Binder.Init.Id,
                     Labels   => Symbol_Sets.Empty_Set,
                     Value    => True_Prog,
                     Typ      => EW_Bool_Type));
            end if;
         end;
      end if;

      --  Reset the move tree associated to Lvalue if the assignment is a move

      if Contains_Allocated_Parts (Etype (Lvalue))
        and then not Is_Anonymous_Access_Type (Etype (Lvalue))
      then
         pragma Assert (not Traverse_Access_To_Constant (Lvalue));
         Result :=
           Sequence
             (Result,
              New_Move_Tree_Assignment
                (Lvalue    => Lvalue,
                 Expr      =>
                   New_Any_Expr
                     (Return_Type =>
                        Get_Move_Tree_Type
                          (Expected_Type_For_Move_Tree (Lvalue)),
                      Labels      => Symbol_Sets.Empty_Set),
                 Index_Map => Index_Map));
      end if;

      return Result;
   end New_Assignment;

   ------------------------------------
   -- New_Constrained_Attribute_Expr --
   ------------------------------------

   function New_Constrained_Attribute_Expr
     (Prefix : N_Subexpr_Id; Domain : EW_Domain) return W_Expr_Id
   is
      Var : Node_Id := Prefix;

   begin
      --  Prefix can be either an object, a type, or a conversion of an object
      --  (when it is called on an actual parameter). In the latter case, the
      --  constrained attribute is the attribute of the converted object.

      while Nkind (Var) = N_Type_Conversion loop
         Var := Expression (Var);
      end loop;

      if Attr_Constrained_Statically_Known (Var) then
         return
           New_Literal
             (Domain => Domain,
              Value  =>
                (if Attribute_Constrained_Static_Value (Var)
                 then EW_True
                 else EW_False));
      else
         declare
            Binder : constant Item_Type :=
              Ada_Ent_To_Why.Element (Symbol_Table, Entity (Var));
         begin
            if Binder.Constr.Present then
               return +Binder.Constr.Id;
            else
               return +False_Term;
            end if;
         end;
      end if;
   end New_Constrained_Attribute_Expr;

   -------------------------------------
   -- New_Equality_Of_Preserved_Parts --
   -------------------------------------

   function New_Equality_Of_Preserved_Parts
     (Ty : Type_Kind_Id; Expr1, Expr2 : W_Term_Id) return W_Pred_Id
   is
      Result : W_Pred_Id;
   begin
      if Is_Record_Type_In_Why (Ty)
        and then Has_Discriminants (Ty)
        and then not Is_Constrained (Ty)
        and then not Has_Defaulted_Discriminants (Ty)
      then
         Result :=
           New_Comparison
             (Symbol => Why_Eq,
              Left   => New_Discriminants_Access (Name => Expr1, Ty => Ty),
              Right  => New_Discriminants_Access (Name => Expr2, Ty => Ty));
      elsif Is_Array_Type (Ty) and then not Is_Constrained (Ty) then
         Result :=
           New_Bounds_Equality
             (Left_Arr  => Expr1,
              Right_Arr => Expr2,
              Dim       => Positive (Number_Dimensions (Ty)));
      elsif Is_Access_Type (Ty) then
         Result :=
           New_Comparison
             (Symbol => Why_Eq,
              Left   => New_Pointer_Is_Null_Access (Ty, Expr1),
              Right  => New_Pointer_Is_Null_Access (Ty, Expr2));

         if Is_Anonymous_Access_Type (Ty) then
            Result :=
              New_And_Pred
                (Left  => Result,
                 Right =>
                   New_Conditional
                     (Condition =>
                        New_Not
                          (Right =>
                             Pred_Of_Boolean_Term
                               (New_Pointer_Is_Null_Access (Ty, Expr1))),
                      Then_Part =>
                        New_Equality_Of_Preserved_Parts
                          (Retysp (Directly_Designated_Type (Ty)),
                           New_Pointer_Value_Access (E => Ty, Name => Expr1),
                           New_Pointer_Value_Access
                             (E => Ty, Name => Expr2))));
         end if;
      else
         Result := True_Pred;
      end if;
      return Result;
   end New_Equality_Of_Preserved_Parts;

   --------------------------
   -- New_Move_Tree_Access --
   --------------------------

   function New_Move_Tree_Access
     (Expr      : N_Subexpr_Id;
      Domain    : EW_Terms;
      Params    : Transformation_Params;
      Index_Map : Ada_Node_To_Why_Id.Map := Ada_Node_To_Why_Id.Empty_Map)
      return W_Expr_Id is
   begin
      case Nkind (Expr) is
         when N_Identifier | N_Expanded_Name                  =>
            return New_Move_Tree_Access_For_Identitier (Entity (Expr));

         --   As move trees for arrays do not have bounds, slices are ignored
         --   in Expr.

         when N_Slice                                         =>
            return
              New_Move_Tree_Access (Prefix (Expr), Domain, Params, Index_Map);

         when N_Type_Conversion | N_Unchecked_Type_Conversion =>
            return
              New_Move_Tree_Access
                (Expression (Expr), Domain, Params, Index_Map);

         when N_Selected_Component                            =>
            declare
               Prefix_Expr : constant W_Expr_Id :=
                 New_Move_Tree_Access
                   (Prefix (Expr), Domain, Params, Index_Map);
               Pref_Ty     : constant Entity_Id :=
                 Expected_Type_For_Move_Tree (Prefix (Expr));
               Selector    : constant Entity_Id :=
                 Search_Component_In_Type
                   (Pref_Ty, Entity (Selector_Name (Expr)));
               pragma Assert (Present (Selector));

            begin
               return
                 New_Move_Tree_Record_Access
                   (Name => Prefix_Expr, Field => Selector, Ty => Pref_Ty);
            end;

         when N_Explicit_Dereference                          =>
            declare
               Prefix_Expr : constant W_Expr_Id :=
                 New_Move_Tree_Access
                   (Prefix (Expr), Domain, Params, Index_Map);
               Pref_Ty     : constant Entity_Id :=
                 Expected_Type_For_Move_Tree (Prefix (Expr));

            begin
               return
                 New_Move_Tree_Pointer_Value_Access
                   (Ty => Pref_Ty, Name => Prefix_Expr, Domain => Domain);
            end;

         when N_Indexed_Component                             =>
            declare
               Prefix_Expr : constant W_Expr_Id :=
                 New_Move_Tree_Access
                   (Prefix (Expr), Domain, Params, Index_Map);
               Pref_Ty     : constant Entity_Id :=
                 Expected_Type_For_Move_Tree (Prefix (Expr));
               Dim         : constant Pos := Number_Dimensions (Pref_Ty);
               Indices     : W_Expr_Array (1 .. Positive (Dim));
               Cursor      : Node_Id := First (Expressions (Expr));
               Count       : Natural := 0;

            begin
               while Present (Cursor) loop
                  Count := Count + 1;
                  Indices (Count) :=
                    (if Index_Map.Is_Empty
                     then
                       Transform_Expr
                         (Cursor,
                          Base_Why_Type_No_Bool
                            (Entity_Id'(Type_Of_Node (Cursor))),
                          Domain,
                          Body_Params)
                     else +Index_Map.Element (Cursor));
                  Next (Cursor);
               end loop;

               return
                 New_Move_Tree_Array_Access
                   (Name   => Prefix_Expr,
                    Index  => Indices,
                    Ty     => Pref_Ty,
                    Domain => Domain);
            end;

         when others                                          =>
            Ada.Text_IO.Put_Line
              ("[New_Move_Tree_Access] kind ="
               & Node_Kind'Image (Nkind (Expr)));
            raise Not_Implemented;
      end case;
   end New_Move_Tree_Access;

   -----------------------------------------
   -- New_Move_Tree_Access_For_Identitier --
   -----------------------------------------

   function New_Move_Tree_Access_For_Identitier
     (Ent : Entity_Id) return W_Expr_Id
   is
      C : constant Ada_Ent_To_Why.Cursor :=
        Ada_Ent_To_Why.Find (Symbol_Table, Ent);

   begin
      if Ada_Ent_To_Why.Has_Element (C) then
         declare
            Obj : constant Item_Type := Ada_Ent_To_Why.Element (C);

         begin
            if Obj.Is_Moved.Present then
               return
                 New_Deref
                   (Right => Obj.Is_Moved.Id,
                    Typ   => Get_Typ (Obj.Is_Moved.Id));
            else
               raise Program_Error;
            end if;
         end;
      else
         pragma Assert (Is_Protected_Component_Or_Discr_Or_Part_Of (Ent));
         declare
            Prot : constant Entity_Id := Enclosing_Concurrent_Type (Ent);
            pragma Assert (Ekind (Prot) = E_Protected_Type);

         begin
            return
              New_Move_Tree_Record_Access
                (Name  =>
                   New_Deref
                     (Right => Concurrent_Self_Move_Tree_Id (Prot),
                      Typ   => Get_Move_Tree_Type (Prot)),
                 Field => Ent,
                 Ty    => Prot);
         end;
      end if;
   end New_Move_Tree_Access_For_Identitier;

   ------------------------------
   -- New_Move_Tree_Assignment --
   ------------------------------

   function New_Move_Tree_Assignment
     (Lvalue    : N_Subexpr_Id;
      Expr      : W_Prog_Id;
      Index_Map : Ada_Node_To_Why_Id.Map := Ada_Node_To_Why_Id.Empty_Map)
      return W_Prog_Id
   is
      Left_Side  : Node_Id := Lvalue;
      Right_Side : W_Prog_Id := +Expr;
      Skip_Slice : Boolean := False;
      --  Only top-level slices are relevant for the assignment. Potential
      --  other slices located in the prefix of indexed components or other
      --  slices can be ignored.

   begin
      loop
         case Nkind (Left_Side) is
            when N_Identifier | N_Expanded_Name                  =>
               declare
                  Ent : constant Entity_Id := Entity (Left_Side);
                  C   : constant Ada_Ent_To_Why.Cursor :=
                    Ada_Ent_To_Why.Find (Symbol_Table, Ent);

               begin
                  if Ada_Ent_To_Why.Has_Element (C) then
                     declare
                        Obj : constant Item_Type := Ada_Ent_To_Why.Element (C);

                     begin
                        if Obj.Is_Moved.Present then
                           return
                             New_Assignment
                               (Name   => +Obj.Is_Moved.Id,
                                Value  => Right_Side,
                                Typ    => Get_Typ (Obj.Is_Moved.Id),
                                Labels => Symbol_Sets.Empty_Set);
                        else
                           raise Program_Error;
                        end if;
                     end;
                  else
                     pragma
                       Assert
                         (Is_Protected_Component_Or_Discr_Or_Part_Of (Ent));
                     declare
                        Prot : constant Entity_Id :=
                          Enclosing_Concurrent_Type (Ent);
                        Typ  : constant W_Type_Id := Get_Move_Tree_Type (Prot);
                        pragma Assert (Ekind (Prot) = E_Protected_Type);

                     begin
                        return
                          New_Assignment
                            (Name   => Concurrent_Self_Move_Tree_Id (Prot),
                             Value  =>
                               New_Move_Tree_Record_Update
                                 (Name  =>
                                    New_Deref
                                      (Right =>
                                         Concurrent_Self_Move_Tree_Id (Prot),
                                       Typ   => Typ),
                                  Field => Ent,
                                  Value => Right_Side,
                                  Ty    => Prot),
                             Typ    => Typ,
                             Labels => Symbol_Sets.Empty_Set);
                     end;
                  end if;
               end;

            when N_Type_Conversion | N_Unchecked_Type_Conversion =>
               Left_Side := Expression (Left_Side);

            when N_Selected_Component                            =>
               declare
                  Pref_Expr : constant W_Expr_Id :=
                    New_Move_Tree_Access
                      (Expr      => Prefix (Left_Side),
                       Domain    => EW_Pterm,
                       Params    => Body_Params,
                       Index_Map => Index_Map);
                  Pref_Ty   : constant Entity_Id :=
                    Expected_Type_For_Move_Tree (Prefix (Left_Side));
                  Selector  : constant Entity_Id :=
                    Search_Component_In_Type
                      (Pref_Ty, Entity (Selector_Name (Left_Side)));
                  pragma Assert (Present (Selector));

               begin
                  Right_Side :=
                    New_Move_Tree_Record_Update
                      (Name  => +Pref_Expr,
                       Field => Selector,
                       Value => Right_Side,
                       Ty    => Pref_Ty);
                  Left_Side := Prefix (Left_Side);
               end;

            when N_Explicit_Dereference                          =>
               declare
                  Pref_Expr : constant W_Expr_Id :=
                    New_Move_Tree_Access
                      (Expr      => Prefix (Left_Side),
                       Domain    => EW_Pterm,
                       Params    => Body_Params,
                       Index_Map => Index_Map);
                  Pref_Ty   : constant Entity_Id :=
                    Expected_Type_For_Move_Tree (Prefix (Left_Side));

               begin
                  Right_Side :=
                    New_Move_Tree_Pointer_Value_Update
                      (Name => +Pref_Expr, Value => Right_Side, Ty => Pref_Ty);
                  Left_Side := Prefix (Left_Side);
               end;

            when N_Indexed_Component                             =>
               declare
                  Pref_Expr : constant W_Expr_Id :=
                    New_Move_Tree_Access
                      (Expr      => Prefix (Left_Side),
                       Domain    => EW_Pterm,
                       Params    => Body_Params,
                       Index_Map => Index_Map);
                  Pref_Ty   : constant Entity_Id :=
                    Expected_Type_For_Move_Tree (Prefix (Left_Side));
                  Dim       : constant Pos :=
                    Number_Dimensions (Etype (Prefix (Left_Side)));
                  Indices   : W_Expr_Array (1 .. Positive (Dim));
                  Cursor    : Node_Id := First (Expressions (Left_Side));
                  Count     : Natural := 0;

               begin
                  while Present (Cursor) loop
                     Count := Count + 1;
                     Indices (Count) :=
                       (if Index_Map.Is_Empty
                        then
                          Transform_Expr
                            (Cursor,
                             Base_Why_Type_No_Bool
                               (Entity_Id'(Type_Of_Node (Cursor))),
                             EW_Pterm,
                             Body_Params)
                        else +Index_Map.Element (Cursor));
                     Next (Cursor);
                  end loop;

                  Right_Side :=
                    New_Move_Tree_Array_Update
                      (Name  => +Pref_Expr,
                       Index => Indices,
                       Value => Right_Side,
                       Ty    => Pref_Ty);
                  Left_Side := Prefix (Left_Side);

                  --  An indexed component has been found, it is OK to skip
                  --  slices from now on.

                  Skip_Slice := True;
               end;

            when N_Slice                                         =>

               --  If Skip_Slice is True, ignore slices. Otherwise, update the
               --  corresponding slice in Right_Side. We generate:
               --
               --  any pref_ty.move_tree
               --    ensures
               --      { forall i1 : index1 ...
               --          (if i1 in <slice range> ...
               --           then get result i1 ... = get right_side i1 ...
               --           else get result i1 ... = get prefix i1 ...) }

               if not Skip_Slice then
                  declare
                     Pref_Expr    : constant W_Expr_Id :=
                       New_Move_Tree_Access
                         (Expr      => Prefix (Left_Side),
                          Domain    => EW_Pterm,
                          Params    => Body_Params,
                          Index_Map => Index_Map);
                     Pref_Ty      : constant Entity_Id :=
                       Expected_Type_For_Move_Tree (Prefix (Left_Side));
                     Prefix_Name  : constant W_Term_Id :=
                       New_Temp_For_Expr (Pref_Expr);
                     Value_Name   : constant W_Prog_Id :=
                       New_Temp_For_Expr (Right_Side);
                     Result_Id    : constant W_Identifier_Id :=
                       New_Result_Ident (Get_Type (+Pref_Expr));
                     D_Rng        : constant Node_Id :=
                       Discrete_Range (Left_Side);
                     Rng          : constant Node_Id := Get_Range (D_Rng);
                     Binders_Type : constant W_Type_Id :=
                       Base_Why_Type_No_Bool (D_Rng);
                     Binders      : constant W_Identifier_Array :=
                       New_Temp_Identifiers (1, Typ => Binders_Type);
                     Indexes      : constant W_Expr_Array :=
                       To_Exprs (Binders);
                     Range_Pred   : constant W_Pred_Id :=
                       (if Index_Map.Is_Empty
                        then
                          +Transform_Discrete_Choice
                             (Choice      => D_Rng,
                              Choice_Type => Empty,
                              Expr        => Indexes (1),
                              Domain      => EW_Pred,
                              Params      => Body_Params)
                        else
                          New_Range_Expr
                            (Low  => +Index_Map.Element (Low_Bound (Rng)),
                             High => +Index_Map.Element (High_Bound (Rng)),
                             Expr => +Indexes (1)));
                     In_Slice_Eq  : constant W_Pred_Id :=
                       New_Move_Tree_Element_Equality
                         (Left_Arr  => +Result_Id,
                          Right_Arr => +Value_Name,
                          Index     => Indexes,
                          Ty        => Pref_Ty);
                     Unchanged    : constant W_Pred_Id :=
                       New_Move_Tree_Element_Equality
                         (Left_Arr  => +Result_Id,
                          Right_Arr => +Prefix_Name,
                          Index     => Indexes,
                          Ty        => Pref_Ty);

                     Def           : constant W_Pred_Id :=
                       New_Conditional
                         (Condition => Range_Pred,
                          Then_Part => In_Slice_Eq,
                          Else_Part => Unchanged);
                     Quant_Binders : W_Binder_Array (Binders'Range);
                  begin
                     for I in Binders'Range loop
                        Quant_Binders (I) :=
                          New_Binder
                            (Domain   => EW_Pred,
                             Name     => Binders (I),
                             Arg_Type => Binders_Type);
                     end loop;
                     Right_Side :=
                       New_Simpl_Any_Prog
                         (T    => Get_Type (+Pref_Expr),
                          Pred =>
                            New_Universal_Quantif
                              (Binders => Quant_Binders,
                               Labels  => Symbol_Sets.Empty_Set,
                               Pred    => Def));
                     Right_Side :=
                       Binding_For_Temp
                         (Tmp => +Value_Name, Context => Right_Side);
                     Right_Side :=
                       Binding_For_Temp
                         (Tmp => +Prefix_Name, Context => Right_Side);
                  end;

                  --  An enclosing slice has been found, it is OK to skip
                  --  slices from now on.

                  Skip_Slice := True;
               end if;

               Left_Side := Prefix (Left_Side);

            when others                                          =>
               Ada.Text_IO.Put_Line
                 ("[New_Move_Tree_Assignment] kind ="
                  & Node_Kind'Image (Nkind (Left_Side)));
               raise Not_Implemented;
         end case;
      end loop;
   end New_Move_Tree_Assignment;

   ----------------------------
   -- New_Overlay_Assignment --
   ----------------------------

   function New_Overlay_Assignment
     (Lvalue : Object_Kind_Id; Right : W_Prog_Id := Why_Empty) return W_Prog_Id
   is
      Alias      : constant Object_Kind_Id :=
        Ultimate_Overlaid_Entity (Lvalue);
      Alias_Item : constant Item_Type :=
        Ada_Ent_To_Why.Element (Symbol_Table, Alias);
      Typ        : constant Entity_Id := Type_Of_Node (Alias);
      Eff        : constant W_Effects_Id := New_Effects;
      procedure Effects_Append_Binder_To_Writes is new
        Effects_Append_Binder (Effects_Append_To_Writes);
      Result     : W_Prog_Id;

   begin
      --  Havoc the ultimate alias

      Effects_Append_Binder_To_Writes (Eff, Alias_Item);
      Result :=
        Sequence
          (New_Havoc_Statement (Effects => Eff),
           Assume_Dynamic_Invariant
             (Expr  =>
                +Transform_Identifier (Body_Params, Alias, Alias, EW_Term),
              Ty    => Typ,
              Valid =>
                Get_Valid_Id_From_Object (Alias, Body_Params.Ref_Allowed)));

      --  If a new value is supplied for the overlay, assume it

      if Present (Right) then
         declare
            Right_Tmp : constant W_Identifier_Id :=
              New_Temp_Identifier (Typ => Get_Type (+Right));

         begin
            Result :=
              New_Typed_Binding
                (Name    => Right_Tmp,
                 Def     => Right,
                 Context =>
                   Sequence
                     (Result,
                      New_Assume_Statement
                        (Pred =>
                           New_Comparison
                             (Symbol => Why_Eq,
                              Left   =>
                                +Transform_Identifier
                                   (Body_Params, Lvalue, Lvalue, EW_Term),
                              Right  => +Right_Tmp))));
         end;
      end if;

      return Result;
   end New_Overlay_Assignment;

   -------------------------
   -- New_Predicate_Check --
   -------------------------

   function New_Predicate_Check
     (Ada_Node         : Node_Id;
      Ty               : Type_Kind_Id;
      W_Expr           : W_Expr_Id;
      On_Default_Value : Boolean := False;
      Top_Predicate    : Boolean := True) return W_Prog_Id
   is
      --  Here we recompute the predicate instead of calling
      --  Compute_Dynamic_Predicate to be able to add continuations on
      --  inherited predicates.

      Kind       : constant VC_Kind :=
        (if On_Default_Value
         then VC_Predicate_Check_On_Default_Value
         else VC_Predicate_Check);
      Need_Init  : constant Boolean :=
        Is_Init_Wrapper_Type (Get_Type (+W_Expr))
        and then Has_Predicates (Ty)
        and then Predicate_Requires_Initialization (Ty);
      --  If Ty's predicate expects an initialized expression, introduce an
      --  initialization check.
      Init_Expr  : constant W_Expr_Id :=
        (if Need_Init
         then
           +Insert_Initialization_Check
              (Ada_Node           => Ada_Node,
               E                  => Ty,
               Name               => +W_Expr,
               Domain             => EW_Prog,
               Exclude_Components => Relaxed,
               No_Predicate_Check => True)
         else W_Expr);
      --  Exclude the predicate from the initialization check to avoid
      --  duplication.
      Tmp_Expr   : constant W_Expr_Id :=
        (if Need_Init
         then +New_Temp_Identifier (Typ => Get_Type (Init_Expr))
         else W_Expr);
      Checks     : W_Prog_Id := +Void;
      First_Pred : Boolean := True;

      procedure Check_One_Dynamic_Predicate
        (Type_Instance : Formal_Kind_Id; Pred_Expression : Node_Id);
      --  Append to Checks a check of the current predicate

      ---------------------------------
      -- Check_One_Dynamic_Predicate --
      ---------------------------------

      procedure Check_One_Dynamic_Predicate
        (Type_Instance : Formal_Kind_Id; Pred_Expression : Node_Id)
      is
         My_Params  : Transformation_Params := Body_Params;
         Check_Info : Check_Info_Type := New_Check_Info;
         Check      : W_Pred_Id;

      begin
         --  We set the Gen_Marker param to GM_Toplevel to instruct
         --  the translation to generate pretty-printing labels for
         --  the parts of the predicate. We also indicate that the
         --  predicate is effectively inlined here by using the
         --  GP_Inlined_Marker (this last part avoids using the
         --  location of the predicate to place the error message,
         --  which is not desired.

         My_Params.Gen_Marker := GM_Toplevel;

         Check :=
           Dynamic_Predicate_Expression
             (Expr       => +Tmp_Expr,
              Pred_Param => Type_Instance,
              Pred_Expr  => Pred_Expression,
              Params     => My_Params);

         --  Ignore the top-level predicate if needed

         if not Top_Predicate
           and then Retysp (Etype (Type_Instance)) = Retysp (Ty)
         then
            return;
         end if;

         --  If the predicate was inherited, add a continuation

         if not First_Pred then
            Check_Info.Continuation.Append
              (Continuation_Type'
                 (Pred_Expression,
                  To_Unbounded_String ("for inherited predicate")));
         else
            First_Pred := False;
         end if;

         --  Append the checks in reverse order so that the inherited are
         --  checked first. It is important for static predicates which are
         --  aggregated by the frontend during the derivation.

         Checks :=
           Sequence
             (New_Assert
                (Pred        =>
                   New_VC_Pred
                     (Ada_Node,
                      New_Label
                        (Labels =>
                           Symbol_Sets.To_Set (NID (GP_Inlined_Marker)),
                         Def    => Check),
                      Kind,
                      Check_Info),
                 Assert_Kind => EW_Assert),
              Checks);
      end Check_One_Dynamic_Predicate;

      procedure Check_All_Predicates is new
        Iterate_Applicable_Predicates (Check_One_Dynamic_Predicate);

   begin
      Check_All_Predicates (Ty);

      if Need_Init then
         return
           New_Binding
             (Name => +Tmp_Expr, Def => +Init_Expr, Context => Checks);
      else
         return Checks;
      end if;
   end New_Predicate_Check;

   -------------------------
   -- New_Raise_Or_Absurd --
   -------------------------

   function New_Raise_Or_Absurd
     (Ada_Node    : Node_Id;
      Ex_Name     : W_Identifier_Id;
      Handled_Exc : Exception_Sets.Set;
      Params      : Transformation_Params) return W_Prog_Id
   is
      Raise_Or_Absurd : W_Prog_Id;
      All_But         : Boolean;
      Exc_Set         : Node_Sets.Set;

   begin
      --  Check whether all raised exceptions are handled and if
      --  not, use absurd to cut unhandled branches.

      if Handled_Exc.Is_Empty then
         Raise_Or_Absurd := New_Absurd_Statement (Ada_Node, VC_Raise);
      else
         --  Check for absence of leaks and havoc borrowed on
         --  enclosing scopes.

         Raise_Or_Absurd :=
           Sequence
             (Finalization_Actions_On_Raise (Ada_Node, Params),
              New_Raise
                (Ada_Node => Ada_Node,
                 Name     => M_Main.Ada_Exc,
                 Arg      => +Ex_Name));

         --  Create a condition from the elements in Handled_Exc

         Handled_Exc.Disclose (All_But, Exc_Set);

         declare
            Handled_Cond : W_Prog_Id := False_Prog;
         begin
            for Exc of Exc_Set loop
               Handled_Cond :=
                 New_Or_Prog
                   (Handled_Cond,
                    New_Comparison (Why_Eq, +Ex_Name, +To_Why_Id (Exc)));
            end loop;

            if All_But then
               Handled_Cond := New_Not (Right => Handled_Cond);
            end if;

            --  Raise the exception of handled exceptions and
            --  cut the branch for others.

            Raise_Or_Absurd :=
              New_Conditional
                (Condition => Handled_Cond,
                 Then_Part => Raise_Or_Absurd,
                 Else_Part => New_Absurd_Statement (Ada_Node, VC_Raise));
         end;
      end if;

      return Raise_Or_Absurd;
   end New_Raise_Or_Absurd;

   -----------------------------
   -- New_Type_Invariant_Call --
   -----------------------------

   function New_Type_Invariant_Call
     (Ty : Type_Kind_Id; W_Expr : W_Term_Id; Params : Transformation_Params)
      return W_Pred_Id
   is
      Variables : Flow_Id_Sets.Set;

   begin
      Variables_In_Type_Invariant (Ty, Variables);

      declare
         Vars  : constant W_Expr_Array :=
           Get_Args_From_Variables (Variables, Params.Ref_Allowed);
         Num_B : constant Positive := 1 + Vars'Length;
         Args  : W_Expr_Array (1 .. Num_B);

      begin
         Args (1) := +W_Expr;
         Args (2 .. Num_B) := Vars;

         return
           New_Call
             (Name => E_Symb (Ty, WNE_Type_Invariant),
              Args => Args,
              Typ  => EW_Bool_Type);
      end;
   end New_Type_Invariant_Call;

   -------------------------
   -- New_Invariant_Check --
   -------------------------

   function New_Invariant_Check
     (Ada_Node         : Node_Id;
      Ty               : Type_Kind_Id;
      W_Expr           : W_Term_Id;
      On_Default_Value : Boolean := False;
      Check_Info       : Check_Info_Type := New_Check_Info) return W_Prog_Id
   is
      Check : constant W_Pred_Id :=
        Compute_Type_Invariant
          (Expr   => W_Expr,
           Ty     => Ty,
           Params => Body_Params,
           Kind   => For_Check,
           Scop   => Current_Subp);
      Kind  : constant VC_Kind :=
        (if On_Default_Value
         then VC_Invariant_Check_On_Default_Value
         else VC_Invariant_Check);
   begin
      if Is_True_Boolean (+Check) then
         return +Void;
      else
         return
           New_Assert
             (Pred        => New_VC_Pred (Ada_Node, Check, Kind, Check_Info),
              Assert_Kind => EW_Assert);
      end if;
   end New_Invariant_Check;

   ----------------------------------
   -- New_Update_For_Borrow_At_End --
   ----------------------------------

   function New_Update_For_Borrow_At_End
     (Brower : Entity_Id; Path : Node_Id) return W_Prog_Id
   is
      function Borrowed_At_End_In_Traversal
        (Borrowed_Entity : Entity_Id) return W_Term_Id
      is (if Is_Formal (Borrowed_Entity)
          then +To_Local (Get_Borrowed_At_End (Brower))
          else
            New_Deref
              (Right => Get_Brower_At_End (Borrowed_Entity),
               Typ   => Get_Typ (Get_Brower_At_End (Borrowed_Entity))))
      with Pre => Ekind (Brower) = E_Function;
      --  Compute the value at end of a borrowed entity inside a traversal
      --  function. If the borrowed entity is the borrowed parameter, then
      --  we have a local identifier introduced to hold its value at the end
      --  of the subprogram. Otherwise, it is a local borrower itself. Use the
      --  identifier introduced for its value at the end of the borrow.
      --  This is used to simulate the reconstruction of the borrowed object
      --  at the end of the scope of the function result.

      --  Local variables

      Borrowed_Entity : constant Entity_Id := Get_Root_Object (Path);
      Reborrow        : constant Boolean := Borrowed_Entity = Brower;
      --  We are in a reborrow if the root of Path is the borrower

      Brower_At_End : constant W_Identifier_Id := Get_Brower_At_End (Brower);
      W_Brower      : constant W_Term_Id :=
        (if Reborrow
         then
           +New_Temp_Identifier
              (Typ => Get_Typ (Brower_At_End), Base_Name => "brower")
         else
           New_Deref (Right => Brower_At_End, Typ => Get_Typ (Brower_At_End)));
      --  Expression of the borrower. Use a temporary for reborrows, see the
      --  translation below.

      Result_Id      : constant W_Identifier_Id :=
        New_Result_Ident (Typ => Get_Typ (Brower_At_End));
      Brower_Relaxed : constant Boolean :=
        Is_Object (Brower) and then Obj_Has_Relaxed_Init (Brower);
      pragma
        Assert
          (if Ekind (Brower) = E_Function
           then not Fun_Has_Relaxed_Init (Brower));
      --  Traversal functions with relaxed initialization are rejected by the
      --  frontend for now.

      New_Brower : constant W_Prog_Id :=
        New_Any_Expr
          (Return_Type => Get_Typ (Brower_At_End),
           Labels      => Symbol_Sets.Empty_Set,
           Post        =>
             New_And_Pred
               (Conjuncts =>
                  (1 =>
                     (if Reborrow
                      then True_Pred
                      else
                        Compute_Dynamic_Inv_And_Initialization
                          (Expr        => +Result_Id,
                           Ty          => Etype (Brower),
                           Params      => Body_Params,
                           Initialized => True_Term)),
                   2 =>
                     New_Equality_Of_Preserved_Parts
                       (Ty    => Retysp (Etype (Brower)),
                        Expr1 => Transform_Term (Path, Body_Params),
                        Expr2 => +Result_Id),
                   3 =>
                     (if Brower_Relaxed
                      then
                        Pred_Of_Boolean_Term
                          (New_Init_Attribute_Access
                             (Name => +Result_Id, E => Etype (Brower)))
                      else True_Pred))));
      --  New value of the borrower. Use an any expr and assume the value of
      --  the is_null field since it cannot be modified.
      --  If we are not inside a reborrow we also assume that the value of
      --  the borrowed object at the end of the borrow respects its dynamic
      --  invariant. This is sound as we only do this update after we have
      --  created the current value of the borrowed object, so we are sure that
      --  there exists a value matching this assumption, the current value.
      --  For reborrow, we do this update before the assignment, as we need to
      --  refer to the value of the object before the assignment. As a result,
      --  it could be unsound to assume the dynamic invariant here.
      --  The address of the borrower is necessarily initialized at the end of
      --  the borrow.

      Borrowed_Ty : constant Entity_Id :=
        (if Reborrow
         then Etype (Brower)
         elsif Ekind (Brower) = E_Function
         then Etype (Borrowed_Entity)
         else Get_Borrowed_Typ (Brower));
      W_Borrowed  : constant W_Term_Id :=
        (if Reborrow
         then
           New_Deref (Right => Brower_At_End, Typ => Get_Typ (Brower_At_End))
         elsif Ekind (Brower) = E_Function
         then Borrowed_At_End_In_Traversal (Borrowed_Entity)
         else +Get_Borrowed_At_End (Brower));
      --  Expression of the borrowed entity at end of borrow:
      --    * in a reborrow, it is the borrower at end,
      --    * in return of traversal functions it is the value at end of the
      --      borrowed entity,
      --    * otherwise, it is the value of the borrowed expression at end.

      At_End_Value  : W_Term_Id;
      Pred_Checks   : W_Statement_Sequence_Id;
      At_End_Assume : W_Prog_Id;
      At_End_Checks : W_Prog_Id;

      --  Start of processing for New_Update_For_Borrow_At_End

   begin
      --  1. Reconstruct the value of Path from the borrower at end of borrow

      Compute_Borrow_At_End_Value
        (Check_Node    => Brower,
         W_Brower      => W_Brower,
         Expr          => Path,
         Borrowed_Expr =>
           (if Ekind (Brower) = E_Function
            then Empty
            else Get_Borrowed_Expr (Brower)),
         Reconstructed => At_End_Value,
         Checks        => Pred_Checks);

      --  2. Construct the assumptions and checks to be performed for values at
      --  the end of the borrow.

      --  Predicates traversed in Path shall be preserved by the borrow. We do
      --  this check at the beginning of the borrow without any assumptions
      --  about the actual modifications performed in the borrow. We could
      --  possibly move this check at the place of havoc/reborrows instead.

      At_End_Checks :=
        New_Ignore
          (Ada_Node => Path,
           Prog     =>
             Sequence
               (New_Assume_Statement
                  (Pred =>
                     Compute_Dynamic_Inv_And_Initialization
                       (W_Brower, Etype (Brower), Body_Params)),
                +Pred_Checks));

      --  Store borrowed_at_end = at_end_value in At_End_Assume. Also add
      --  information about parts of the borrowed_at_end that cannot be
      --  modified (bounds of unconstrained arrays, immutable discriminants,
      --  and is_null field of pointer). If we are in a borrow, also add the
      --  dynamic invariant of the borrowed object.

      At_End_Assume :=
        New_Assume_Statement
          (Pred =>
             New_And_Pred
               ((1 =>
                   (if Reborrow
                    then True_Pred
                    else
                      Compute_Dynamic_Inv_And_Initialization
                        (Expr   => W_Borrowed,
                         Ty     => Borrowed_Ty,
                         Params => Body_Params)),
                 2 =>
                   New_Comparison
                     (Symbol => Why_Eq,
                      Left   => W_Borrowed,
                      Right  =>
                        Insert_Simple_Conversion
                          (Expr => At_End_Value,
                           To   => Get_Type (+W_Borrowed))),
                 3 =>
                   New_Equality_Of_Preserved_Parts
                     (Ty    => Borrowed_Ty,
                      Expr1 => W_Borrowed,
                      Expr2 =>
                        +Transform_Expr_Or_Identifier
                           (N      =>
                              (if Reborrow
                               then Brower
                               elsif Ekind (Brower) = E_Function
                               then Borrowed_Entity
                               else Get_Borrowed_Expr (Brower)),
                            Domain => EW_Term,
                            Params => Body_Params)))));

      --  3. Put together all the parts.

      --  3.1 In reborrows, we emit:
      --     let tmp_brower = any in
      --     <at_end_checks> tmp_brower;
      --     assume { !brower_at_end = { brower with path -> tmp_brower } };
      --     brower_at_end := tmp_brower;

      if Reborrow then
         return
           New_Binding
             (Name    => +W_Brower,
              Def     => New_Brower,
              Context =>
                Sequence
                  ((1 => At_End_Checks,
                    2 => At_End_Assume,
                    3 =>
                      New_Assignment
                        (Name   => Brower_At_End,
                         Value  => +W_Brower,
                         Typ    => Get_Typ (Brower_At_End),
                         Labels => Symbol_Sets.Empty_Set))));

      --  3.2 For return of traversal functions, we need to assume equalities
      --  to go up the chain of constant borrows to simulate the end of scope
      --  of the result. For a return statement rooted at v_1 itself rooted at
      --  v_2 etc. itself rooted at borrowed, we emit:
      --     result_at_end := any;
      --     <at_end_checks> result_at_end;
      --     assume { w_borrowed = { borrowed with path -> !v_n_at_end } };
      --     ...
      --     assume { v_1_at_end = { borrowed with path_1 -> !result_at_end }};

      elsif Ekind (Brower) = E_Function then
         declare
            Current_Brower   : Node_Id := Borrowed_Entity;
            Current_Borrowed : Node_Id;
            Assumptions      : W_Statement_Sequence_Id := Void_Sequence;
         begin
            Append (Assumptions, At_End_Assume);

            --  Go over the chain of local borrowers until we reach the first
            --  formal of the call to construct the sequence of assumptions.

            while not Is_Formal (Current_Brower) loop
               pragma Assert (Is_Constant_Borrower (Current_Brower));

               Current_Borrowed := Get_Borrowed_Entity (Current_Brower);
               Append
                 (Assumptions,
                  New_Assume_Statement
                    (Pred =>
                       New_Comparison
                         (Symbol => Why_Eq,
                          Left   => +Get_Borrowed_At_End (Current_Brower),
                          Right  =>
                            Borrowed_At_End_In_Traversal (Current_Borrowed))));

               Current_Brower := Current_Borrowed;
            end loop;

            return
              Sequence
                ((1 =>
                    New_Assignment
                      (Name   => Brower_At_End,
                       Value  => New_Brower,
                       Typ    => Get_Typ (Brower_At_End),
                       Labels => Symbol_Sets.Empty_Set),
                  2 => At_End_Checks,
                  3 => +Assumptions));
         end;

      --  3.3 In regular borrows, we emit:
      --     brower_at_end := any;
      --     <at_end_checks> brower_at_end;
      --     assume { w_borrowed = { borrowed with path -> !brower_at_end } };

      else
         return
           Sequence
             ((1 =>
                 New_Assignment
                   (Name   => Brower_At_End,
                    Value  => New_Brower,
                    Typ    => Get_Typ (Brower_At_End),
                    Labels => Symbol_Sets.Empty_Set),
               2 => At_End_Checks,
               3 => At_End_Assume));
      end if;
   end New_Update_For_Borrow_At_End;

   ----------------------------------
   -- New_Validity_Tree_Assignment --
   ----------------------------------

   function New_Validity_Tree_Assignment
     (LHS       : N_Subexpr_Id;
      New_Tree  : W_Prog_Id;
      Params    : Transformation_Params;
      Index_Map : Ada_Node_To_Why_Id.Map := Ada_Node_To_Why_Id.Empty_Map)
      return W_Prog_Id
   is
      function Get_Validity_Tree (Expr : N_Subexpr_Id) return W_Prog_Id;
      --  Recursively compute the validity tree of Expr

      function Validity_Tree_Update
        (Expr : N_Subexpr_Id; RHS : W_Prog_Id) return W_Prog_Id;
      --  Construct an assignement of RHS in the validity tree of Expr

      -----------------------
      -- Get_Validity_Tree --
      -----------------------

      function Get_Validity_Tree (Expr : N_Subexpr_Id) return W_Prog_Id is
      begin
         case Nkind (Expr) is
            when N_Identifier | N_Expanded_Name =>
               return
                 +Get_Valid_Id_From_Object
                    (Entity (Expr), Ref_Allowed => Params.Ref_Allowed);

            when N_Selected_Component           =>
               declare
                  Field : constant Entity_Id := Entity (Selector_Name (Expr));
               begin
                  return
                    +New_Validity_Tree_Record_Access
                       (Name  => +Get_Validity_Tree (Prefix (Expr)),
                        Field => Field,
                        Ty    => Etype (Prefix (Expr)));
               end;

            when N_Indexed_Component            =>
               declare
                  Pref    : constant Node_Id := Prefix (Expr);
                  Pref_Ty : constant Entity_Id := Retysp (Etype (Pref));
                  Dim     : constant Pos := Number_Dimensions (Pref_Ty);
                  Indices : W_Expr_Array (1 .. Positive (Dim));
                  Cursor  : Node_Id := First (Expressions (Expr));
                  Count   : Positive := 1;
               begin
                  while Present (Cursor) loop
                     Indices (Count) :=
                       (if Index_Map.Is_Empty
                        then
                          Transform_Expr
                            (Cursor,
                             Base_Why_Type_No_Bool
                               (Entity_Id'(Type_Of_Node (Cursor))),
                             EW_Pterm,
                             Params)
                        else +Index_Map.Element (Cursor));

                     Count := Count + 1;
                     Next (Cursor);
                  end loop;

                  return
                    +New_Validity_Tree_Array_Access
                       (Name   => +Get_Validity_Tree (Prefix (Expr)),
                        Index  => Indices,
                        Ty     => Pref_Ty,
                        Domain => EW_Prog);
               end;

            when N_Slice                        =>
               return Get_Validity_Tree (Prefix (Expr));

            when others                         =>
               raise Program_Error;
         end case;
      end Get_Validity_Tree;

      --------------------------
      -- Validity_Tree_Update --
      --------------------------

      function Validity_Tree_Update
        (Expr : N_Subexpr_Id; RHS : W_Prog_Id) return W_Prog_Id is
      begin
         case Nkind (Expr) is
            when N_Identifier | N_Expanded_Name =>
               return
                 New_Assignment
                   (Name   =>
                      +Get_Valid_Id_From_Object
                         (Entity (Expr), Ref_Allowed => False),
                    Labels => Symbol_Sets.Empty_Set,
                    Value  => RHS,
                    Typ    => Get_Validity_Tree_Type (Etype (Expr)));

            when N_Selected_Component           =>
               declare
                  Pref  : constant Node_Id := Prefix (Expr);
                  Field : constant Entity_Id := Entity (Selector_Name (Expr));
               begin
                  return
                    Validity_Tree_Update
                      (Pref,
                       New_Validity_Tree_Record_Update
                         (Name  => +Get_Validity_Tree (Pref),
                          Field => Field,
                          Ty    => Etype (Pref),
                          Value => +RHS));
               end;

            when N_Indexed_Component            =>
               declare
                  Pref    : constant Node_Id := Prefix (Expr);
                  Pref_Ty : constant Entity_Id := Retysp (Etype (Pref));
                  Dim     : constant Pos := Number_Dimensions (Pref_Ty);
                  Indices : W_Expr_Array (1 .. Positive (Dim));
                  Cursor  : Node_Id := First (Expressions (Expr));
                  Count   : Positive := 1;
               begin
                  while Present (Cursor) loop
                     Indices (Count) :=
                       (if Index_Map.Is_Empty
                        then
                          Transform_Expr
                            (Cursor,
                             Base_Why_Type_No_Bool
                               (Entity_Id'(Type_Of_Node (Cursor))),
                             EW_Pterm,
                             Params)
                        else +Index_Map.Element (Cursor));

                     Count := Count + 1;
                     Next (Cursor);
                  end loop;

                  return
                    Validity_Tree_Update
                      (Pref,
                       +New_Validity_Tree_Array_Update
                          (Name   => +Get_Validity_Tree (Pref),
                           Index  => Indices,
                           Value  => +RHS,
                           Ty     => Pref_Ty,
                           Domain => EW_Prog));
               end;

            when N_Slice                        =>
               declare
                  Pref        : constant Node_Id := Prefix (Expr);
                  Pref_Ty     : constant Entity_Id := Retysp (Etype (Pref));
                  Rng         : constant Node_Id :=
                    Get_Range (Discrete_Range (Expr));
                  Rng_Type    : constant W_Type_Id :=
                    Nth_Index_Rep_Type_No_Bool (Pref_Ty, 1);
                  Low_Expr    : constant W_Term_Id :=
                    Transform_Term (Low_Bound (Rng), Rng_Type, Params);
                  High_Expr   : constant W_Term_Id :=
                    Transform_Term (High_Bound (Rng), Rng_Type, Params);
                  Prefix_Expr : constant W_Prog_Id :=
                    New_Temp_For_Expr (Get_Validity_Tree (Pref));
                  New_Expr    : constant W_Prog_Id := New_Temp_For_Expr (RHS);
                  Var         : constant W_Identifier_Id :=
                    New_Temp_Identifier (Typ => Rng_Type);
                  Range_Pred  : constant W_Pred_Id :=
                    New_Range_Expr
                      (Low => Low_Expr, High => High_Expr, Expr => +Var);
                  Result_Id   : constant W_Identifier_Id :=
                    New_Result_Ident (Typ => Get_Validity_Tree_Type (Pref_Ty));
                  Prop        : constant W_Pred_Id :=
                    New_Conditional
                      (Condition => Range_Pred,
                       Then_Part =>
                         New_Comparison
                           (Symbol => Why_Eq,
                            Left   =>
                              +New_Validity_Tree_Array_Access
                                 (Name   => +Result_Id,
                                  Index  => (1 => +Var),
                                  Ty     => Pref_Ty,
                                  Domain => EW_Term),
                            Right  =>
                              +New_Validity_Tree_Array_Access
                                 (Name   => +New_Expr,
                                  Index  => (1 => +Var),
                                  Ty     => Pref_Ty,
                                  Domain => EW_Term)),
                       Else_Part =>
                         New_Comparison
                           (Symbol => Why_Eq,
                            Left   =>
                              +New_Validity_Tree_Array_Access
                                 (Name   => +Result_Id,
                                  Index  => (1 => +Var),
                                  Ty     => Pref_Ty,
                                  Domain => EW_Term),
                            Right  =>
                              +New_Validity_Tree_Array_Access
                                 (Name   => +Prefix_Expr,
                                  Index  => (1 => +Var),
                                  Ty     => Pref_Ty,
                                  Domain => EW_Term)));

               begin
                  return
                    Validity_Tree_Update
                      (Pref,
                       Binding_For_Temp
                         (Tmp     => +Prefix_Expr,
                          Context =>
                            Binding_For_Temp
                              (Tmp     => +New_Expr,
                               Context =>
                                 New_Any_Expr
                                   (Post        =>
                                      New_Universal_Quantif
                                        (Binders =>
                                           (1 =>
                                              New_Binder
                                                (Domain   => EW_Pred,
                                                 Name     => Var,
                                                 Arg_Type => Rng_Type)),
                                         Labels  => Symbol_Sets.Empty_Set,
                                         Pred    => Prop),
                                    Return_Type => Get_Typ (Result_Id),
                                    Labels      => Symbol_Sets.Empty_Set))));
               end;

            when others                         =>
               raise Program_Error;
         end case;
      end Validity_Tree_Update;

   begin
      return Validity_Tree_Update (LHS, New_Tree);
   end New_Validity_Tree_Assignment;

   ----------------------
   -- One_Level_Access --
   ----------------------

   function One_Level_Access
     (N             : Node_Id;
      Expr          : W_Expr_Id;
      Domain        : EW_Domain;
      Params        : Transformation_Params;
      No_Init_Check : Boolean) return W_Expr_Id
   is
      R : W_Expr_Id;
   begin
      case Nkind (N) is
         when N_Selected_Component   =>
            declare
               Sel_Ent : constant Entity_Id := Entity (Selector_Name (N));
               Ty      : constant Entity_Id := Retysp (Etype (Prefix (N)));

               --  For private types, functions are declared in the first
               --  ancestor only

               P_Expr : W_Expr_Id :=
                 Insert_Simple_Conversion
                   (Ada_Node => N,
                    Domain   => EW_Term,
                    Expr     => Expr,
                    To       =>
                      (if Is_Init_Wrapper_Type (Get_Type (Expr))
                       then EW_Init_Wrapper (Type_Of_Node (Ty))
                       else Type_Of_Node (Ty)));

            begin
               --  If initialization is not required, complete initialization
               --  will not have been enforced for the prefix. We still need
               --  top level initialization to access the components.

               P_Expr :=
                 Insert_Top_Level_Init_Check
                   (Ada_Node => Prefix (N),
                    E        => Ty,
                    Name     => P_Expr,
                    Domain   => Domain,
                    Do_Check => No_Init_Check);

               R :=
                 New_Ada_Record_Access
                   (Ada_Node => N,
                    Domain   => Domain,
                    Name     => P_Expr,
                    Ty       => Ty,
                    Field    => Sel_Ent);
            end;

         when N_Explicit_Dereference =>
            declare
               Ty     : constant Entity_Id := Retysp (Etype (Prefix (N)));
               P_Expr : W_Expr_Id :=
                 Insert_Simple_Conversion
                   (Ada_Node => N,
                    Domain   => EW_Term,
                    Expr     => Expr,
                    To       =>
                      (if Is_Init_Wrapper_Type (Get_Type (Expr))
                       then EW_Init_Wrapper (Type_Of_Node (Ty))
                       else Type_Of_Node (Ty)));
            begin
               --  If initialization is not required, complete initialization
               --  will not have been enforced for the prefix. We still need
               --  top level initialization to access the designated value.

               P_Expr :=
                 Insert_Top_Level_Init_Check
                   (Ada_Node => Prefix (N),
                    E        => Ty,
                    Name     => P_Expr,
                    Domain   => Domain,
                    Do_Check => No_Init_Check);

               R :=
                 New_Pointer_Value_Access
                   (Ada_Node => N, E => Ty, Name => P_Expr, Domain => Domain);
            end;

         when N_Indexed_Component    =>

            --  ??? Save the index in a temporary variable

            declare
               Ar      : constant Node_Id := Prefix (N);
               Ar_Tmp  : constant W_Term_Id := New_Temp_For_Expr (Expr);
               Dim     : constant Pos := Number_Dimensions (Type_Of_Node (Ar));
               Indices : W_Expr_Array (1 .. Positive (Dim));
               Cursor  : Node_Id := First (Expressions (N));
               Count   : Positive := 1;
            begin
               while Present (Cursor) loop
                  Indices (Count) :=
                    Transform_Expr
                      (Cursor,
                       Base_Why_Type_No_Bool (Node_Id'(Type_Of_Node (Cursor))),
                       Domain,
                       Params);

                  --  Insert Index Check if needed

                  if Domain = EW_Prog and then Do_Range_Check (Cursor) then
                     Indices (Count) :=
                       +Do_Index_Check
                          (Ada_Node => Cursor,
                           Arr_Expr => Ar_Tmp,
                           W_Expr   => Indices (Count),
                           Dim      => Count);
                  end if;

                  Count := Count + 1;
                  Next (Cursor);
               end loop;

               R :=
                 Binding_For_Temp
                   (Domain  => Domain,
                    Tmp     => +Ar_Tmp,
                    Context =>
                      New_Array_Access
                        (Ada_Node => N,
                         Domain   => Domain,
                         Ar       => +Ar_Tmp,
                         Index    => Indices));
            end;

         when others                 =>
            Ada.Text_IO.Put_Line
              ("[One_Level_Access] kind =" & Node_Kind'Image (Nkind (N)));
            raise Not_Implemented;
      end case;

      --  Insert predicate and initialization checks on values of
      --  initialization wrapper type. Don't do it for scalar types for
      --  which initialization is always checked on read.

      if not No_Init_Check
        and then Domain = EW_Prog
        and then Is_Init_Wrapper_Type (Get_Type (R))
        and then not Has_Scalar_Full_View (Etype (N))
      then
         pragma Assert (Get_Type_Kind (Get_Type (R)) = EW_Abstract);
         declare
            Ty : constant Entity_Id := Get_Ada_Node (+Get_Type (R));
         begin
            if Has_Predicates (Ty) then
               R := +Insert_Predicate_Check (N, Ty, +R);
            end if;
         end;
      end if;

      --  Check that the discriminants or address of the component are
      --  initialized if any.

      R :=
        Insert_Top_Level_Init_Check
          (Ada_Node => N,
           E        => Etype (N),
           Name     => R,
           Domain   => Domain,
           Do_Check => not No_Init_Check);

      return R;
   end One_Level_Access;

   ----------------------
   -- One_Level_Update --
   ----------------------

   function One_Level_Update
     (N            : Node_Id;
      Pref         : W_Term_Id;
      Value        : W_Expr_Id;
      Domain       : EW_Domain;
      Params       : Transformation_Params;
      Check_Prefix : Boolean := True;
      Index_Map    : Ada_Node_To_Why_Id.Map := Ada_Node_To_Why_Id.Empty_Map)
      return W_Expr_Id
   is
      --  In some cases, the frontend introduces an Itype for the type of a
      --  discriminant dependent component. In this case, to avoid a type
      --  mismatch in Why, we go to the root of the assignment to retrieve
      --  the correct type.

      Pref_Ty       : constant Entity_Id :=
        (if Nkind (N)
            in N_Selected_Component
             | N_Indexed_Component
             | N_Slice
             | N_Explicit_Dereference
         then Expected_Type_Of_Prefix (Prefix (N))
         else Empty);
      Init_Val      : constant W_Expr_Id :=
        (if Domain = EW_Prog
           and then Is_Init_Wrapper_Type (Get_Type (Value))
           and then not Expr_Has_Relaxed_Init (N)
         then
           Insert_Initialization_Check
             (Ada_Node           => N,
              E                  => Get_Ada_Node (+Get_Type (Value)),
              Name               => Value,
              Domain             => EW_Prog,
              Exclude_Components => Relaxed)
         else Value);
      Prefix_Domain : constant EW_Domain :=
        (if not Check_Prefix and then Domain = EW_Prog
         then EW_Pterm
         else Domain);
      --  Domain for the checks on the prefix which are preserved from the
      --  previous value (index check, discriminant check...)

      Result : W_Expr_Id;
   begin
      case Nkind (N) is
         when N_Selected_Component | N_Identifier | N_Expanded_Name =>
            --  In fact identifiers can refer to components in the case of
            --  protected objects. But this is the only case, and we assert
            --  this here.

            pragma
              Assert
                (if Nkind (N) in N_Identifier | N_Expanded_Name
                 then Is_Protected_Component_Or_Discr_Or_Part_Of (Entity (N)));

            --  It can happen that the prefix does not have the expected type
            --  but some Itype with the same constraints. To avoid a type
            --  mismatch in Why, we should use the selector of the expected
            --  type instead. Force no sliding, as the bounds of the expected
            --  type might depend on the discriminants of the enclosing type,
            --  which are not in the symbol table at this stage.
            --  If there is no such component, we must be in a tagged view
            --  conversion. Introduce conversions to do the update.

            declare
               Selector  : Entity_Id :=
                 (if Nkind (N) in N_Identifier | N_Expanded_Name
                  then Entity (N)
                  else
                    Search_Component_In_Type
                      (Pref_Ty, Entity (Selector_Name (N))));
               Need_Conv : constant Boolean := No (Selector);
               View_Pref : W_Term_Id := Pref;

            begin
               if Need_Conv then
                  pragma Assert (Is_Tagged_Type (Pref_Ty));

                  Selector :=
                    Search_Component_In_Type
                      (Etype (Prefix (N)), Entity (Selector_Name (N)));
                  View_Pref :=
                    Insert_Simple_Conversion
                      (Ada_Node => N,
                       Expr     => View_Pref,
                       To       => EW_Abstract (Etype (Prefix (N))));
               end if;

               declare
                  Relaxed_Init : constant Boolean :=
                    (if Is_Init_Wrapper_Type (Get_Type (+Pref))
                     then Has_Init_Wrapper (Etype (Selector))
                     else Has_Relaxed_Init (Etype (Selector)));
                  To_Type      : constant W_Type_Id :=
                    EW_Abstract
                      (Etype (Selector), Relaxed_Init => Relaxed_Init);
                  New_Value    : constant W_Expr_Id :=
                    Insert_Simple_Conversion
                      (Ada_Node       => N,
                       Domain         => Domain,
                       Expr           => Init_Val,
                       To             => To_Type,
                       Force_No_Slide => True);
               begin
                  --  The code should never update a discrimiant by assigning
                  --  to it.

                  pragma Assert (Ekind (Selector) /= E_Discriminant);

                  Result :=
                    New_Ada_Record_Update
                      (Ada_Node => N,
                       Domain   => Prefix_Domain,
                       Name     => +View_Pref,
                       Field    => Selector,
                       Value    => New_Value);
               end;

               if Need_Conv then
                  Result :=
                    Insert_Simple_Conversion
                      (Ada_Node => N,
                       Domain   => Domain,
                       Expr     => Result,
                       To       => EW_Abstract (Pref_Ty));
               end if;
            end;

         when N_Explicit_Dereference                                =>

            declare
               Des_Ty       : constant Entity_Id :=
                 Directly_Designated_Type (Pref_Ty);
               Relaxed_Init : constant Boolean :=
                 (if Is_Init_Wrapper_Type (Get_Type (+Pref))
                  then Has_Init_Wrapper (Des_Ty)
                  else Has_Relaxed_Init (Des_Ty));
               To_Type      : constant W_Type_Id :=
                 EW_Abstract (Des_Ty, Relaxed_Init => Relaxed_Init);
               New_Value    : constant W_Expr_Id :=
                 Insert_Simple_Conversion
                   (Ada_Node => N,
                    Domain   => Domain,
                    Expr     => Init_Val,
                    To       => To_Type);

            begin
               Result :=
                 New_Ada_Pointer_Update
                   (Ada_Node => N,
                    Domain   => Prefix_Domain,
                    Name     => +Pref,
                    Value    => New_Value);
            end;

         when N_Indexed_Component                                   =>
            declare
               Dim          : constant Pos := Number_Dimensions (Pref_Ty);
               Ar_Tmp       : constant W_Term_Id := New_Temp_For_Expr (Pref);
               Indices      : W_Expr_Array (1 .. Positive (Dim));
               Cursor       : Node_Id := First (Expressions (N));
               Count        : Positive := 1;
               Relaxed_Init : constant Boolean :=
                 (if Is_Init_Wrapper_Type (Get_Type (+Pref))
                  then Has_Init_Wrapper (Component_Type (Pref_Ty))
                  else Has_Relaxed_Init (Component_Type (Pref_Ty)));
               To_Type      : constant W_Type_Id :=
                 EW_Abstract
                   (Component_Type (Pref_Ty), Relaxed_Init => Relaxed_Init);
            begin
               while Present (Cursor) loop
                  Indices (Count) :=
                    (if Index_Map.Is_Empty
                     then
                       Transform_Expr
                         (Cursor,
                          Base_Why_Type_No_Bool
                            (Entity_Id'(Type_Of_Node (Cursor))),
                          Domain,
                          Params)
                     else +Index_Map.Element (Cursor));

                  --  Insert Index Check if needed

                  if Prefix_Domain = EW_Prog and then Do_Range_Check (Cursor)
                  then
                     pragma Assert (Index_Map.Is_Empty);
                     Indices (Count) :=
                       +Do_Index_Check
                          (Ada_Node => Cursor,
                           Arr_Expr => Ar_Tmp,
                           W_Expr   => Indices (Count),
                           Dim      => Count);
                  end if;

                  Count := Count + 1;
                  Next (Cursor);
               end loop;

               Result :=
                 Binding_For_Temp
                   (Domain  => Domain,
                    Tmp     => +Ar_Tmp,
                    Context =>
                      New_Array_Update
                        (Ada_Node => N,
                         Ar       => +Pref,
                         Index    => Indices,
                         Value    =>
                           Insert_Simple_Conversion
                             (Ada_Node => N,
                              Domain   => Domain,
                              Expr     => Init_Val,
                              To       => To_Type),
                         Domain   => Domain));
            end;

         when N_Slice                                               =>
            declare
               Prefix_Name  : constant W_Term_Id := New_Temp_For_Expr (Pref);
               Value_Name   : constant W_Expr_Id :=
                 New_Temp_For_Expr (Init_Val, True);
               Dim          : constant Pos := Number_Dimensions (Pref_Ty);
               pragma Assert (Dim = 1);
               --  Slices are only for one-dimentional arrays (Ada RM 4.1.2)
               Result_Id    : constant W_Identifier_Id :=
                 New_Result_Ident (Get_Type (+Pref));
               D_Rng        : constant Node_Id := Discrete_Range (N);
               Rng          : constant Node_Id := Get_Range (D_Rng);
               Binder_Type  : constant W_Type_Id :=
                 Base_Why_Type_No_Bool (D_Rng);
               Binder       : constant W_Identifier_Id :=
                 New_Temp_Identifier (Typ => Binder_Type);
               Index        : constant W_Expr_Id := +Binder;
               Low_Term     : constant W_Term_Id :=
                 (if Index_Map.Is_Empty
                  then Transform_Term (Low_Bound (Rng), Binder_Type, Params)
                  else +Index_Map.Element (Low_Bound (Rng)));
               High_Term    : constant W_Term_Id :=
                 (if Index_Map.Is_Empty
                  then Transform_Term (High_Bound (Rng), Binder_Type, Params)
                  else +Index_Map.Element (High_Bound (Rng)));
               Range_Pred   : constant W_Pred_Id :=
                 New_Range_Expr
                   (Low => Low_Term, High => High_Term, Expr => +Index);
               Quant_Binder : constant W_Binder_Id :=
                 New_Binder
                   (Domain   => EW_Pred,
                    Name     => Binder,
                    Arg_Type => Binder_Type);
               Unchanged    : constant W_Pred_Id :=
                 New_Universal_Quantif
                   (Binders => (1 => Quant_Binder),
                    Labels  => Symbol_Sets.Empty_Set,
                    Pred    =>
                      New_Conditional
                        (Condition => New_Not (Right => Range_Pred),
                         Then_Part =>
                           New_Element_Equality
                             (Left_Arr  => +Result_Id,
                              Right_Arr => +Prefix_Name,
                              Index     => (1 => Index))));
               --  Assumption after the slice update:
               --     forall i.
               --       not low <= i <= high -> get result i = get prefix i

               Slice_Eq : constant W_Pred_Id :=
                 New_Comparison
                   (Symbol => Why_Eq,
                    Left   =>
                      (if Is_Static_Array_Type
                            (Get_Ada_Node (+Get_Type (+Value_Name)))
                       then +Value_Name
                       else +Array_Convert_To_Base (EW_Term, +Value_Name)),
                    Right  =>
                      +New_Slice_Call
                         (Domain => EW_Term,
                          Arr    =>
                            (if Is_Static_Array_Type
                                  (Get_Ada_Node (+Get_Type (+Result_Id)))
                             then +Result_Id
                             else Array_Convert_To_Base (EW_Term, +Result_Id)),
                          Typ    => Get_Typ (Result_Id),
                          Low    => +Low_Term,
                          High   => +High_Term));
               --  Assumption after the slice update:
               --     value = slice result low high

               --  If the prefix is not in split form, then its bounds are
               --  contained in the object. We should assume that they are
               --  preserved by the assignment.

               Bounds : constant W_Pred_Id :=
                 (if Type_Get_Type_Kind (+Get_Type (+Pref)) = EW_Abstract
                  then
                    New_Bounds_Equality
                      (Left_Arr  => Prefix_Name,
                       Right_Arr => +Result_Id,
                       Dim       => Positive (Dim))
                  else True_Pred);
            begin
               --  "any" Why3 nodes are only allowed in programs, which is
               --  ensured by not allowing slices in borrowed expressions.
               pragma Assert (Domain in EW_Prog | EW_Pterm);

               Result :=
                 +New_Simpl_Any_Prog
                    (T    => Get_Type (+Pref),
                     Pred =>
                       New_And_Pred
                         ((1 => Bounds, 2 => Unchanged, 3 => Slice_Eq)));

               --  Insert checks for bounds in the program domain

               if Prefix_Domain = EW_Prog then
                  pragma Assert (Index_Map.Is_Empty);

                  declare
                     Low_Expr     : constant W_Prog_Id :=
                       New_Temp_For_Expr
                         (Transform_Prog
                            (Low_Bound (Rng), Binder_Type, Params));
                     High_Expr    : constant W_Prog_Id :=
                       New_Temp_For_Expr
                         (Transform_Prog
                            (High_Bound (Rng), Binder_Type, Params));
                     Cond         : constant W_Prog_Id :=
                       New_Comparison
                         (Symbol =>
                            (if Binder_Type = EW_Int_Type
                             then Int_Infix_Le
                             else MF_BVs (Binder_Type).Ule),
                          Left   => Low_Expr,
                          Right  => High_Expr);
                     Index_Checks : W_Prog_Id;

                  begin
                     --  If either the prefix type or the slice bounds are not
                     --  statically known, introduce a check to make sure that
                     --  the bounds of the slice are in the array bounds.

                     if Is_Static_Array_Type (Pref_Ty)
                       and then Is_Static_Expression (Low_Bound (Rng))
                       and then Is_Static_Expression (High_Bound (Rng))
                     then
                        Index_Checks := +Void;
                     else
                        Index_Checks :=
                          New_Conditional
                            (Condition => Cond,
                             Then_Part =>
                               Sequence
                                 (Left  =>
                                    New_Ignore
                                      (Prog =>
                                         Do_Index_Check
                                           (Ada_Node => Low_Bound (Rng),
                                            Arr_Expr => Prefix_Name,
                                            W_Expr   => +Low_Expr,
                                            Dim      => 1)),
                                  Right =>
                                    New_Ignore
                                      (Prog =>
                                         Do_Index_Check
                                           (Ada_Node => High_Bound (Rng),
                                            Arr_Expr => Prefix_Name,
                                            W_Expr   => +High_Expr,
                                            Dim      => 1))));
                     end if;

                     --  Add binding for the high and low bounds even if no
                     --  index checks were introduced to check for RTE in the
                     --  bound expressions.

                     Index_Checks :=
                       Binding_For_Temp
                         (Tmp => +High_Expr, Context => Index_Checks);
                     Index_Checks :=
                       Binding_For_Temp
                         (Tmp => +Low_Expr, Context => Index_Checks);
                     Prepend (Index_Checks, Result);

                     --  Check the subtype indication if any

                     if Nkind (D_Rng) = N_Subtype_Indication then
                        Prepend
                          (Check_Scalar_Range
                             (Params => Params,
                              N      => Rng,
                              Base   => Entity (Subtype_Mark (D_Rng))),
                           Result);
                     end if;
                  end;
               end if;

               Result :=
                 Binding_For_Temp
                   (Domain => EW_Prog, Tmp => Value_Name, Context => Result);
               Result :=
                 Binding_For_Temp
                   (Domain => EW_Prog, Tmp => +Prefix_Name, Context => Result);
            end;

         when others                                                =>
            Ada.Text_IO.Put_Line
              ("[One_Level_Update] kind =" & Node_Kind'Image (Nkind (N)));
            raise Not_Implemented;
      end case;

      --  If the target type has a direct or inherited predicate, generate a
      --  corresponding check.

      declare
         Ty : constant Entity_Id := Get_Ada_Node (+Get_Type (+Pref));
      begin
         if Domain = EW_Prog and then Present (Ty) and then Has_Predicates (Ty)
         then
            Result :=
              +Insert_Predicate_Check
                 (Ada_Node => N, Check_Ty => Ty, W_Expr => +Result);
         end if;
      end;

      return Result;
   end One_Level_Update;

   -------------------------------------
   --  Check_Type_Invariants_For_Call --
   -------------------------------------

   function Check_Type_Invariants_For_Call
     (Call : Node_Id; Params : Transformation_Params) return W_Prog_Id
   is
      E     : constant Entity_Id := Get_Called_Entity_For_Proof (Call);
      Ids   : W_Identifier_Array (1 .. Number_Formals (E));
      Exprs : W_Expr_Array (1 .. Number_Formals (E));
      Top   : Natural := 0;

      procedure One_Param (Formal : Entity_Id; Actual : Node_Id);
      --  Introduce a let binding for parameters which need invariant checks
      --  and insert them in the symbol table.

      ---------------
      -- One_Param --
      ---------------

      procedure One_Param (Formal : Entity_Id; Actual : Node_Id) is
      begin
         if Ekind (Formal) /= E_Out_Parameter
           and then Invariant_Check_Needed (Etype (Formal))
         then
            Top := Top + 1;
            Exprs (Top) := Transform_Expr (Actual, EW_Pterm, Params);
            Ids (Top) := New_Temp_Identifier (Typ => Get_Type (Exprs (Top)));
            Insert_Tmp_Item_For_Entity (Formal, Ids (Top));
         end if;
      end One_Param;

      procedure Iterate_Call is new Iterate_Call_Parameters (One_Param);

      Res : W_Prog_Id;

   begin
      Ada_Ent_To_Why.Push_Scope (Symbol_Table);
      Iterate_Call (Call);
      Res :=
        Check_Type_Invariants_For_Subprogram
          (E, Call, Params, For_Input => True);
      Ada_Ent_To_Why.Pop_Scope (Symbol_Table);

      for I in reverse 1 .. Top loop
         Res :=
           New_Typed_Binding
             (Name => Ids (I), Def => +Exprs (I), Context => Res);
      end loop;

      return Res;
   end Check_Type_Invariants_For_Call;

   -------------------------------------------
   --  Check_Type_Invariants_For_Subprogram --
   -------------------------------------------

   function Check_Type_Invariants_For_Subprogram
     (E           : Entity_Id;
      Ada_Node    : Node_Id;
      Params      : Transformation_Params;
      For_Input   : Boolean;
      Exceptional : Boolean := False) return W_Prog_Id
   is
      Res : W_Prog_Id := +Void;

      procedure Add_To_Res (Obj : Node_Id; Inv : W_Pred_Id);
      --  Append assert { Inv } to Res

      ----------------
      -- Add_To_Res --
      ----------------

      procedure Add_To_Res (Obj : Node_Id; Inv : W_Pred_Id) is
         Check_Info : Check_Info_Type := New_Check_Info;
      begin
         if not Is_True_Boolean (+Inv) then
            if Obj = E then
               Check_Info.Continuation.Append
                 (Continuation_Type'
                    (Ada_Node => E,
                     Message  =>
                       To_Unbounded_String
                         ("for the result of " & Pretty_Source_Name (E))));
            elsif Is_Concurrent_Type (Obj) then

               --  Type invariant are not supported on protected objects

               pragma Assert (False);
            else
               Check_Info.Continuation.Append
                 (Continuation_Type'
                    (Ada_Node => Obj,
                     Message  =>
                       To_Unbounded_String
                         ("for "
                          & Pretty_Source_Name (Obj)
                          & (if For_Input
                             then " before the call"
                             else
                               " at the end of " & Pretty_Source_Name (E)))));
            end if;

            Res :=
              Sequence
                (Res,
                 New_Assert
                   (Pred        =>
                      New_VC_Pred
                        (Ada_Node   => (if For_Input then Ada_Node else E),
                         Expr       => Inv,
                         Reason     => VC_Invariant_Check,
                         Check_Info => Check_Info),
                    Assert_Kind => EW_Assert));
         end if;
      end Add_To_Res;

      procedure Compute_Type_Invariants is new
        Process_Type_Invariants_For_Subprogram (Add_To_Res);
   begin
      Compute_Type_Invariants
        (E, Params, For_Input, Exceptional, Scop => Current_Subp);

      return Res;
   end Check_Type_Invariants_For_Subprogram;

   --------------------------------------------
   -- Process_Type_Invariants_For_Subprogram --
   --------------------------------------------

   procedure Process_Type_Invariants_For_Subprogram
     (E           : Entity_Id;
      Params      : Transformation_Params;
      For_Input   : Boolean;
      Exceptional : Boolean := False;
      Scop        : Entity_Id)
   is

      procedure Process_Type_Invariants_For_Globals
        (Ids : Flow_Types.Flow_Id_Sets.Set);
      --  Process the type invariants of elements of Ids
      --  @param Ids the set of read / write effects for the subprogram

      procedure Process_Type_Invariants_For_Params;
      --  Process the type invariants of E's parameters

      function Compute_Type_Invariant_For_Entity
        (Obj : Entity_Id; Is_Param : Boolean) return W_Pred_Id
      with Pre => Ada_Ent_To_Why.Has_Element (Symbol_Table, Obj);
      --  @param Obj Entity of an object stored in the Symbol_Table
      --  @param Is_Param True if Obj is a parameter and not a global of E
      --  @return a predicate containing the invariants of all parts of Obj
      --          which have an external invariant.

      -----------------------------------------
      -- Process_Type_Invariants_For_Globals --
      -----------------------------------------

      procedure Process_Type_Invariants_For_Globals
        (Ids : Flow_Types.Flow_Id_Sets.Set) is
      begin
         for F of Ids loop
            pragma Assert (F.Kind in Direct_Mapping | Magic_String);

            --  Magic_String are global state with no attached entities. As
            --  such state is translated as private in Why3, we do not need
            --  to consider any type invariant for it.

            if F.Kind = Direct_Mapping then
               declare
                  Obj : constant Entity_Id := Get_Direct_Mapping_Id (F);
               begin
                  --  Global variables accessed by the subprogram. Abstract
                  --  states and private variables are not considered here,
                  --  as they cannot have visible type invariants.

                  if Is_Object (Obj) then
                     Process
                       (Obj,
                        Compute_Type_Invariant_For_Entity
                          (Obj, Is_Param => False));

                  --  Self reference of protected subprograms

                  else
                     pragma Assert (Is_Concurrent_Type (Obj));

                     Process
                       (Obj,
                        Compute_Type_Invariant
                          (Expr   => +Concurrent_Self_Binder (Obj).B_Name,
                           Ty     => Obj,
                           Params => Params,
                           Kind   => For_Check,
                           Scop   => Scop));
                  end if;
               end;
            end if;
         end loop;
      end Process_Type_Invariants_For_Globals;

      ----------------------------------------
      -- Process_Type_Invariants_For_Params --
      ----------------------------------------

      procedure Process_Type_Invariants_For_Params is
         Formal : Entity_Id := First_Formal (E);

      begin
         while Present (Formal) loop
            if (if For_Input
                then Ekind (Formal) /= E_Out_Parameter
                else not Is_Constant_In_SPARK (Formal))
              and then (not Exceptional or else By_Reference (Formal))
            then
               Process
                 (Formal,
                  Compute_Type_Invariant_For_Entity
                    (Formal, Is_Param => True));
            end if;

            Next_Formal (Formal);
         end loop;
      end Process_Type_Invariants_For_Params;

      ---------------------------------------
      -- Compute_Type_Invariant_For_Entity --
      ---------------------------------------

      function Compute_Type_Invariant_For_Entity
        (Obj : Entity_Id; Is_Param : Boolean) return W_Pred_Id
      is
         Expr : constant W_Term_Id :=
           +Transform_Identifier (Body_Params, Obj, Obj, EW_Term);
      begin
         --  If Is_Param is True, exclude invariants relaxed for parameters of
         --  E.

         return
           Compute_Type_Invariant
             (Expr   => Expr,
              Ty     => Etype (Obj),
              Kind   => For_Check,
              Params => Params,
              Subp   => (if Is_Param then E else Empty),
              Scop   => Scop);
      end Compute_Type_Invariant_For_Entity;

      Read_Ids  : Flow_Types.Flow_Id_Sets.Set;
      Write_Ids : Flow_Types.Flow_Id_Sets.Set;
   begin
      --  Assume/check the type invariants of the parameters

      Process_Type_Invariants_For_Params;

      Flow_Utility.Get_Proof_Globals
        (Subprogram      => E,
         Reads           => Read_Ids,
         Writes          => Write_Ids,
         Erase_Constants => True);

      --  If For_Input is True, add the invariants of the variables read by E,
      --  otherwise add the invariants of the variables written by E.

      if For_Input then
         Process_Type_Invariants_For_Globals (Read_Ids);
      else
         Process_Type_Invariants_For_Globals (Write_Ids);
      end if;

      --  If For_Input is false and E is a function, add the invariants of its
      --  result.

      if not For_Input and then Ekind (E) = E_Function then
         declare
            Result : constant W_Term_Id :=
              (if not Result_Is_Mutable
               then +Result_Name
               else
                 New_Deref
                   (Right => Result_Name, Typ => Get_Typ (+Result_Name)));
         begin
            Process
              (E,
               Compute_Type_Invariant
                 (Expr   => Result,
                  Ty     => Etype (E),
                  Kind   => For_Check,
                  Params => Params,
                  Subp   => E,
                  Scop   => Scop));
         end;
      end if;
   end Process_Type_Invariants_For_Subprogram;

   ----------------
   -- Range_Expr --
   ----------------

   function Range_Expr
     (N      : Node_Id;
      T      : W_Expr_Id;
      Domain : EW_Domain;
      Params : Transformation_Params;
      T_Type : W_Type_OId := Why_Empty) return W_Expr_Id
   is
      Subdomain  : constant EW_Domain :=
        (if Domain = EW_Pred then EW_Term else Domain);
      Range_Node : constant Node_Id := Get_Range (N);
      Low        : constant Node_Id := Low_Bound (Range_Node);
      High       : constant Node_Id := High_Bound (Range_Node);
      Base_Type  : W_Type_Id := Base_Why_Type (Low, High);

      R : W_Expr_Id;

   begin
      if T_Type /= Why_Empty then
         Base_Type := Base_Why_Type (T_Type, Base_Type);
      end if;

      --  Another special case for booleans: The above base type computations
      --  return "bool" for Standard_Boolean, but in fact for a boolean range
      --  we still want to have "int" here.

      if Base_Type = EW_Bool_Type then
         Base_Type := EW_Int_Type;
      end if;

      declare
         Low_Expr  : constant W_Expr_Id :=
           Transform_Expr (Low, Base_Type, Subdomain, Params);
         High_Expr : constant W_Expr_Id :=
           Transform_Expr (High, Base_Type, Subdomain, Params);
      begin
         R :=
           New_Range_Expr
             (Domain => Domain,
              Low    => Low_Expr,
              High   => High_Expr,
              Expr   =>
                Insert_Simple_Conversion
                  (Domain => Subdomain, Expr => T, To => Base_Type));
      end;

      --  In programs, we generate a check that the range_constraint of a
      --  subtype_indication is compatible with the given subtype.

      if Domain = EW_Prog and then Nkind (N) = N_Subtype_Indication then
         Prepend
           (Check_Subtype_Indication
              (Params => Params, N => N, Sub_Type => Etype (N)),
            R);
      end if;

      return R;
   end Range_Expr;

   ----------------------------------
   -- Reconstruct_Actual_From_Item --
   ----------------------------------

   function Reconstruct_Actual_From_Item
     (Pattern   : Item_Type;
      Actual    : N_Subexpr_Id;
      No_Checks : Boolean;
      Pre_Expr  : W_Expr_Id) return W_Prog_Id
   is
      Reconstructed_Arg : constant W_Prog_Id :=
        Reconstruct_Formal_From_Item (Pattern, Pre_Expr);
      T                 : W_Prog_Id;
   begin
      case Pattern.Kind is
         when Concurrent_Self =>
            T :=
              +Insert_Checked_Conversion
                 (Ada_Node => Actual,
                  Domain   => (if No_Checks then EW_Pterm else EW_Prog),
                  Expr     => +Reconstructed_Arg,
                  To       => Type_Of_Node (Actual));

         when Regular         =>
            declare
               --  Types:

               Actual_T : constant W_Type_Id := Type_Of_Node (Actual);

               --  On store, checks are not inserted for composite
               --  parameters to avoid duplicate discriminant or length
               --  check. Predicate and initialization checks are introduced
               --  afterward.

               Need_Check_On_Store : constant Boolean :=
                 not No_Checks
                 and then Is_Scalar_Type (Retysp (Etype (Actual)));

            begin
               if Need_Check_On_Store then
                  T :=
                    +Insert_Checked_Conversion
                       (Ada_Node => Actual,
                        Domain   => EW_Prog,
                        Expr     => +Reconstructed_Arg,
                        Lvalue   => True,
                        To       =>
                          (if Is_Init_Wrapper_Type
                                (Get_Type (+Reconstructed_Arg))
                           then EW_Init_Wrapper (Actual_T)
                           else Actual_T));
               else
                  T :=
                    +Insert_Simple_Conversion
                       (Ada_Node => Actual,
                        Domain   => EW_Prog,
                        Expr     => +Reconstructed_Arg,
                        To       =>
                          (if Is_Init_Wrapper_Type
                                (Get_Type (+Reconstructed_Arg))
                           then EW_Init_Wrapper (Actual_T)
                           else Actual_T));
               end if;
            end;

         when UCArray         =>
            declare
               --  Types:

               Formal_T : constant W_Type_Id :=
                 Get_Typ (Pattern.Content.B_Name);
               Actual_T : constant W_Type_Id := Type_Of_Node (Actual);
            begin
               --  Generate an expression of the form:
               --
               --    to_actual_type_ (from_formal_type (!tmp_var))

               T :=
                 +Insert_Simple_Conversion
                    (Ada_Node => Actual,
                     Domain   => EW_Pterm,
                     Expr     => +Reconstructed_Arg,
                     To       =>
                       (if Is_Init_Wrapper_Type (Formal_T)
                        then
                          EW_Abstract
                            (Get_Ada_Node (+Actual_T), Relaxed_Init => True)
                        else Actual_T));
            end;

         when DRecord         =>
            declare
               Formal_T     : constant W_Type_Id :=
                 Get_Why_Type_From_Item (Pattern);
               Relaxed_Init : constant Boolean :=
                 Is_Init_Wrapper_Type (Formal_T);

            begin
               T :=
                 +Insert_Simple_Conversion
                    (Domain => EW_Pterm,
                     Expr   => +Reconstructed_Arg,
                     To     =>
                       EW_Abstract
                         (Etype (Actual), Relaxed_Init => Relaxed_Init));
            end;

         when Pointer         =>
            declare
               Relaxed_Init : constant Boolean :=
                 Is_Init_Wrapper_Type (Get_Typ (Pattern.Value.B_Name));

            begin
               T :=
                 +Insert_Simple_Conversion
                    (Domain => EW_Pterm,
                     Expr   => +Reconstructed_Arg,
                     To     =>
                       EW_Abstract
                         (Etype (Actual), Relaxed_Init => Relaxed_Init));
            end;

         when Subp            =>
            raise Program_Error;
      end case;

      --  T has the relaxed initialization status of the formal. We need to
      --  check correct initialization if the actual does not have relaxed
      --  initialization and we want to emit checks.

      if not No_Checks
        and then not Expr_Has_Relaxed_Init (Actual)
        and then Is_Init_Wrapper_Type (Get_Type (+T))
      then
         T :=
           +Insert_Initialization_Check
              (Ada_Node           => Actual,
               E                  => Etype (Actual),
               Name               => +T,
               Domain             => EW_Prog,
               Exclude_Components => Relaxed);
      end if;

      --  Convert to the expected type. All the necessary checks should have
      --  been inserted.

      return
        +Insert_Simple_Conversion
           (Domain => EW_Pterm, Expr => +T, To => Type_Of_Node (Actual));
   end Reconstruct_Actual_From_Item;

   ----------------------------------
   -- Reconstruct_Formal_From_Item --
   ----------------------------------

   function Reconstruct_Formal_From_Item
     (Pattern : Item_Type; Pre_Expr : W_Expr_Id) return W_Prog_Id is
   begin
      case Pattern.Kind is
         when Concurrent_Self =>

            --  Here, we are necessarily in an external call.
            --  We need to reconstruct the object if it is mutable.

            pragma Assert (Pattern.Main.Mutable);
            return
              New_Deref
                (Right => Pattern.Main.B_Name,
                 Typ   => Get_Typ (Pattern.Main.B_Name));

         when Regular         =>
            declare
               Formal_T : constant W_Type_Id := Get_Typ (Pattern.Main.B_Name);
            begin
               return
                 (if Pattern.Init.Present
                  then
                    New_Label
                      (Labels => Symbol_Sets.Empty_Set,
                       Def    =>
                         New_Deref
                           (Right => Pattern.Main.B_Name, Typ => Formal_T),
                       Typ    => EW_Split (Get_Ada_Node (+Formal_T)))
                  else
                    New_Deref (Right => Pattern.Main.B_Name, Typ => Formal_T));
            end;

         when UCArray         =>
            declare
               --  Types:

               Formal_T : constant W_Type_Id :=
                 Get_Typ (Pattern.Content.B_Name);
               Deref    : constant W_Prog_Id :=
                 New_Deref (Right => Pattern.Content.B_Name, Typ => Formal_T);

               --  If the argument is in split form, we
               --  need to reconstruct the argument using the actual's
               --  bounds before applying the conversion.

               Reconstructed_Arg : constant W_Prog_Id :=
                 (if Is_Static_Array_Type
                       (Get_Ada_Node (+Get_Why_Type_From_Item (Pattern)))
                  then +Deref
                  else +Array_Convert_From_Base (EW_Prog, Pre_Expr, +Deref));

            begin
               return Reconstructed_Arg;
            end;

         when DRecord         =>
            declare
               Formal_T     : constant W_Type_Id :=
                 Get_Why_Type_From_Item (Pattern);
               Relaxed_Init : constant Boolean :=
                 Is_Init_Wrapper_Type (Formal_T);

               Arg_Array : W_Expr_Array (1 .. 5);
               Index     : Positive := 1;

            begin
               --  For fields, use the temporary variable

               if Pattern.Fields.Present then
                  Arg_Array (Index) :=
                    New_Deref
                      (Right => Pattern.Fields.Binder.B_Name,
                       Typ   => Get_Typ (Pattern.Fields.Binder.B_Name));
                  Index := Index + 1;
               end if;

               --  If discriminants are mutable, we have introduced a
               --  temporary variable for them if we could not reuse the
               --  discriminants from the actual because they were not
               --  mutable. In this case, also assume preservation of the
               --  discriminants.

               if Pattern.Discrs.Present then
                  if Pattern.Discrs.Binder.Mutable then
                     declare
                        Discr_Name : constant W_Identifier_Id :=
                          Pattern.Discrs.Binder.B_Name;
                     begin
                        Arg_Array (Index) :=
                          New_Deref
                            (Right => Discr_Name, Typ => Get_Typ (Discr_Name));
                     end;
                  else
                     Arg_Array (Index) :=
                       New_Discriminants_Access
                         (Name => Pre_Expr, Ty => Pattern.Typ);
                  end if;

                  Index := Index + 1;

                  --  If Pattern.Typ has mutable discriminants, add the init
                  --  flag. Discriminants are always initialized at toplevel.

                  if Has_Mutable_Discriminants (Pattern.Typ)
                    and then Relaxed_Init
                  then
                     Arg_Array (Index) := +True_Term;
                     Index := Index + 1;
                  end if;
               end if;

               if Pattern.Tag.Present then
                  Arg_Array (Index) :=
                    New_Tag_Access
                      (Domain => EW_Prog, Name => Pre_Expr, Ty => Pattern.Typ);

                  Index := Index + 1;
               end if;

               return
                 +Record_From_Split_Form
                    (A            => Arg_Array (1 .. Index - 1),
                     Ty           => Pattern.Typ,
                     Relaxed_Init => Relaxed_Init);
            end;

         when Pointer         =>
            declare
               Formal_Typ   : constant Entity_Id := Pattern.P_Typ;
               Relaxed_Init : constant Boolean :=
                 Is_Init_Wrapper_Type (Get_Why_Type_From_Item (Pattern));

               Arg_Array : W_Expr_Array (1 .. (if Relaxed_Init then 3 else 2));

            begin
               --  For value, use the temporary variable

               Arg_Array (1) :=
                 New_Deref
                   (Right => Pattern.Value.B_Name,
                    Typ   => Get_Typ (Pattern.Value.B_Name));

               --  If we have introduced a temporary reference for is_null, use
               --  it.

               if Pattern.Mutable then
                  Arg_Array (2) :=
                    New_Deref
                      (Right => Pattern.Is_Null,
                       Typ   => Get_Typ (Pattern.Is_Null));

               --  The value of is_null from the actual has not been modified.
               --  Take it from Pre_Expr.

               else
                  Arg_Array (2) :=
                    New_Pointer_Is_Null_Access (Formal_Typ, Pre_Expr);
               end if;

               --  The init flag is always true after the call

               if Relaxed_Init then
                  Arg_Array (3) := +True_Term;
               end if;

               return
                 +Pointer_From_Split_Form
                    (A            => Arg_Array,
                     Ty           => Formal_Typ,
                     Relaxed_Init => Relaxed_Init);
            end;

         when Subp            =>
            raise Program_Error;
      end case;
   end Reconstruct_Formal_From_Item;

   ------------------
   -- Shift_Rvalue --
   ------------------

   procedure Shift_Rvalue
     (N            : in out N_Subexpr_Id;
      Expr         : in out W_Expr_Id;
      Last_Access  : in out Opt_N_Subexpr_Id;
      Domain       : EW_Domain := EW_Prog;
      Check_Prefix : Boolean := True;
      Index_Map    : Ada_Node_To_Why_Id.Map := Ada_Node_To_Why_Id.Empty_Map) is
   begin
      case Nkind (N) is
         when N_Identifier | N_Expanded_Name =>
            null;

         --  We include a type qualification here even if it may not occur
         --  on the left-hand side of an assignment, due to the use of
         --  Shift_Rvalue on borrowed expressions, where a type qualification
         --  may appear.

         when N_Type_Conversion
            | N_Unchecked_Type_Conversion
            | N_Qualified_Expression         =>

            --  Insert a conversion to make sure that the reconstructed
            --  value fullfils the type constraint.

            if Domain = EW_Prog then

               --  For scalar types, the Do_Range_Check flag is set on the
               --  expression. Insert a conversion with Lvalue set to True
               --  to generate the checks.

               if Do_Range_Check (Expression (N)) then
                  Expr :=
                    +Insert_Checked_Conversion
                       (Ada_Node => Expression (N),
                        Domain   => EW_Prog,
                        Expr     => Expr,
                        To       =>
                          EW_Abstract
                            (Retysp (Etype (Expression (N))),
                             Is_Init_Wrapper_Type (Get_Type (Expr))),
                        Lvalue   => True);

               else
                  declare
                     Tmp_Expr : W_Expr_Id := New_Temp_For_Expr (Expr);
                  begin
                     Expr :=
                       +Sequence
                          (Left  =>
                             New_Ignore
                               (Prog =>
                                  +Insert_Checked_Conversion
                                     (Ada_Node => N,
                                      Domain   => EW_Prog,
                                      Expr     => Tmp_Expr,
                                      To       =>
                                        EW_Abstract
                                          (Etype (N),
                                           Is_Init_Wrapper_Type
                                             (Get_Type (Expr))))),
                           Right => +Tmp_Expr);
                     Expr :=
                       Binding_For_Temp
                         (Tmp => Tmp_Expr, Context => Expr, Domain => Domain);
                  end;

                  --  If the origin of the conversion has predicates, they
                  --  might not be checked. Do it here.

                  if Has_Predicates (Etype (Expression (N))) then
                     Expr :=
                       +Insert_Predicate_Check
                          (Ada_Node => Expression (N),
                           Check_Ty => Etype (Expression (N)),
                           W_Expr   => +Expr);
                  end if;
               end if;

               --  In view conversions, check that the type of the conversion
               --  is compatible with the tag of the expression.

               if Is_Tagged_Type (Etype (N))
                 and then Nkind (N) /= N_Qualified_Expression
                 and then not Is_Ancestor (Etype (N), Etype (Expression (N)))
               then
                  Expr :=
                    +Insert_Tag_Check
                       (Ada_Node => N, Check_Ty => Etype (N), Expr => +Expr);
               end if;
            end if;

            N := Expression (N);

         when N_Selected_Component
            | N_Indexed_Component
            | N_Slice
            | N_Explicit_Dereference         =>
            Last_Access := N;

            --  Go to the expected type before performing a record update to
            --  avoid conversion on component types which could be discriminant
            --  dependent.

            if Nkind (N) = N_Selected_Component then
               Expr :=
                 +Insert_Simple_Conversion
                    (Domain => Domain,
                     Expr   => Expr,
                     To     =>
                       EW_Abstract
                         (Retysp (Etype (N)),
                          Is_Init_Wrapper_Type (Get_Type (Expr))));
            end if;

            declare
               Prefix_Type : constant W_Type_Id :=
                 Expected_Type_Of_Prefix (Prefix (N));

               Subdomain : constant EW_Domain :=
                 (if Domain = EW_Prog then EW_Pterm else Domain);
               --  We compute the expression for the Prefix in the EW_Term
               --  domain so that checks are not done for it as they are
               --  duplicates of those done in One_Level_Update.

               Prefix_Expr : constant W_Expr_Id :=
                 Insert_Simple_Conversion
                   (Domain         => Subdomain,
                    Expr           =>
                      Transform_Expr
                        (Domain => Subdomain,
                         Expr   => Prefix (N),
                         Params => Body_Params),
                    To             => Prefix_Type,
                    Force_No_Slide => True);
               --  The type of the type prefix might not match Prefix_Type if
               --  it is a discriminant dependent subcomponent. In this case,
               --  Prefix_Type might have bounds that reference discriminants
               --  whose value is not known in the context. Sliding is not
               --  necessary but could cause crashes.

               Prefix_Var : constant W_Expr_Id :=
                 New_Temp_For_Expr (Prefix_Expr);
            begin
               Expr :=
                 One_Level_Update
                   (N,
                    +Prefix_Var,
                    Expr,
                    Domain,
                    Params       => Body_Params,
                    Check_Prefix => Check_Prefix,
                    Index_Map    => Index_Map);
               Expr :=
                 Binding_For_Temp
                   (Domain => Domain, Tmp => Prefix_Var, Context => Expr);
               N := Prefix (N);
            end;

         when others                         =>
            Ada.Text_IO.Put_Line
              ("[Shift_Rvalue] kind =" & Node_Kind'Image (Nkind (N)));
            raise Not_Implemented;
      end case;
   end Shift_Rvalue;

   -----------------------
   -- Transform_Actions --
   -----------------------

   function Transform_Actions
     (Actions : List_Id;
      Expr    : W_Expr_Id;
      Domain  : EW_Domain;
      Params  : Transformation_Params) return W_Expr_Id
   is
      T : W_Expr_Id;
      N : Node_Id;

      Subdomain : constant EW_Domain :=
        (if Domain = EW_Pred then EW_Term else Domain);

   begin
      T := Expr;
      N := Last (Actions);
      while Present (N) loop
         case Nkind (N) is

            --  Currently ignore type declarations in actions. A more precise
            --  treatment would factor out the code of Transform_Declaration
            --  to possibly generate an assumption here.

            when N_Subtype_Declaration | N_Full_Type_Declaration =>
               null;

            when N_Object_Declaration                            =>
               declare
                  Name : constant Entity_Id := Defining_Identifier (N);
                  Item : constant Item_Type :=
                    Mk_Item_Of_Entity (Name, Local => True);

               begin
                  pragma Assert (Ekind (Name) = E_Constant);
                  pragma Assert (Item.Kind = Regular);

                  T :=
                    New_Typed_Binding
                      (Domain  => Subdomain,
                       Name    => Item.Main.B_Name,
                       Def     =>
                         Transform_Expr
                           (Expression (N),
                            Get_Typ (Item.Main.B_Name),
                            Subdomain,
                            Params),
                       Context => T);
               end;

            when N_Ignored_In_SPARK                              =>
               null;

            --  For an Itype reference, simply check for possible RTE in
            --  the program domain.

            when N_Itype_Reference                               =>
               if Domain = EW_Prog then
                  declare
                     Cut_Assertion_Prag : Node_Id;
                     Cut_Assertion_Expr : Node_Id;
                     Cut_Assertion      : W_Pred_Id;
                  begin
                     Prepend
                       (Transform_Statement_Or_Declaration
                          (N,
                           Params,
                           Cut_Assertion_Prag,
                           Cut_Assertion_Expr,
                           Cut_Assertion),
                        T);
                  end;
               end if;

            --  For an object renaming, simply check for possible RTE in
            --  the program domain.

            when N_Object_Renaming_Declaration                   =>
               if Domain = EW_Prog then
                  Prepend (Transform_Declaration (N, Params), T);
               end if;

            --  Introduce a check for assertions in the program domain

            when N_Pragma                                        =>
               pragma Assert (Is_Pragma (N, Pragma_Check));

               if not Is_Ignored_Pragma_Check (N) and then Domain = EW_Prog
               then
                  Prepend (Transform_Pragma (N, Params, Force => False), T);
               end if;

            when others                                          =>
               raise Program_Error;
         end case;

         Prev (N);
      end loop;

      return T;
   end Transform_Actions;

   -----------------------------------
   -- Transform_Actions_Preparation --
   -----------------------------------

   procedure Transform_Actions_Preparation (Actions : List_Id) is
      N : Node_Id;

   begin
      N := First (Actions);
      while Present (N) loop
         case Nkind (N) is

            --  Currently ignore type declarations in actions. A more precise
            --  treatment would factor out the code of Transform_Declaration
            --  to possibly generate an assumption here.

            when N_Subtype_Declaration | N_Full_Type_Declaration =>
               null;

            --  Create an item for the declared object, bind it to the Ada
            --  entity in the Symbol_Table and store the definition in Values
            --  to create the binding afterward.

            when N_Object_Declaration                            =>
               declare
                  Name : constant Entity_Id := Defining_Identifier (N);
                  Item : constant Item_Type :=
                    Mk_Item_Of_Entity (Name, Local => True);
               begin
                  pragma Assert (Ekind (Name) = E_Constant);
                  pragma Assert (Item.Kind = Regular);

                  Ada_Ent_To_Why.Insert (Symbol_Table, Name, Item);
               end;

            when N_Ignored_In_SPARK
               | N_Itype_Reference
               | N_Object_Renaming_Declaration                   =>
               null;

            when N_Pragma                                        =>
               pragma Assert (Is_Pragma (N, Pragma_Check));

            when others                                          =>
               raise Program_Error;
         end case;

         Next (N);
      end loop;
   end Transform_Actions_Preparation;

   -------------------------------
   -- Transform_Array_Aggregate --
   -------------------------------

   function Transform_Array_Aggregate
     (Params        : Transformation_Params;
      Domain        : EW_Domain;
      Expr          : N_Aggregate_Kind_Id;
      Update_Prefix : Opt_N_Subexpr_Id := Empty;
      Relaxed_Init  : Boolean) return W_Expr_Id
   is
      --  The aggregate is the argument of a 'Update attribute_reference or a
      --  delta aggregate if and only if Update_Prefix has been supplied.

      In_Delta_Aggregate : constant Boolean := Present (Update_Prefix);
      Empty_Aggregate    : constant Boolean :=
        Nkind (Expr) = N_Aggregate and then Is_Null_Aggregate (Expr);
      --  True if Expr is []

      Expr_Typ  : constant Entity_Id := Type_Of_Node (Expr);
      Ret_Type  : constant W_Type_Id :=
        EW_Abstract (Expr_Typ, Relaxed_Init => Relaxed_Init);
      Comp_Type : constant Entity_Id := Retysp (Component_Type (Expr_Typ));

      Nb_Dim : constant Positive := Positive (Number_Dimensions (Expr_Typ));
      subtype Dimensions is Positive range 1 .. Nb_Dim;

      Needs_Bounds : constant Boolean :=
        not In_Delta_Aggregate and then not Is_Static_Array_Type (Expr_Typ);
      --  In general, we need to take the bound as additional elements as they
      --  can be dynamically determined. We do not need them for
      --  * Delta aggregates, as they can be read from the element for prefix
      --  * Static array types, as the bounds are already baked in the type.

      Bound_Count : constant Natural :=
        (if Needs_Bounds then 2 * Nb_Dim else 0);
      --  Number of additional bound arguments

      Index_Types : array (Dimensions) of Node_Id;
      --  Store index types of Expr_Type for each dimension. Not a constant
      --  because it needs a loop for initialization.

      type Aggregate_Element is record
         Value : Node_Id;
         Typ   : Node_Id;
      end record;
      --  Aggregate elements corresponds to the subexpression of the aggregate
      --  that dynamically parameterize it. This include the component values
      --  of the aggregate, the index expressions used in choices of delta
      --  aggregates, and the update prefix if any. We do not include there
      --  component values which are located inside iterated component
      --  associations, as they may depend on index parameters. This does not
      --  cover bounds, which are treated outside.

      package Aggregate_Element_Lists is new
        Ada.Containers.Vectors
          (Index_Type   => Positive,
           Element_Type => Aggregate_Element);

      package Node_To_Why_Id is new
        Ada.Containers.Hashed_Maps
          (Key_Type        => Node_Id,
           Element_Type    => W_Identifier_Id,
           Hash            => Node_Hash,
           Equivalent_Keys => "=");
      --  To store mapping from aggregate nodes to Why bindings.

      -----------------------
      -- Local subprograms --
      -----------------------

      function Should_Use_Function_Translation return Boolean;
      --  Detect whether we should use a function-based translation. The
      --  presence of contextual elements (like 'Old, 'Loop_Entry, target name,
      --  variables, ...) make this fairly complex for iterated component
      --  association, so this return False if it is encountered in Expr.
      --  Instead, we use an epsilon (in term domain) or an any (in program
      --  domain) for the aggregate.

      procedure Get_Aggregate_Elements
        (Values              : out Aggregate_Element_Lists.Vector;
         Variables           : out Flow_Id_Sets.Set;
         Elements_From_Nodes : out Node_To_Why_Id.Map;
         Bounds              : out W_Expr_Array);
      --  Extract elements of the aggregate Expr. Those will be passed in
      --  parameter to the logic function of the aggregate if one is generated.
      --
      --  @param Values is set to the sequence of subexpressions that
      --  corresponds to an element. The order of Values is used to generate
      --  the signature of the logic function.
      --  @param Variables corresponds to additional variables that are needed
      --  for guards within the defining proposition (and also for default
      --  value under iterated component association). Those variables need to
      --  be additional parameters for function-based translation.
      --  @param Elements_From_Nodes corresponds to the mapping from element
      --    subexrepssions to their name in Why.
      --  @param Bounds corresponds to the sequence of name for bound elements,
      --    if they are needed as parameters.

      procedure Generate_Aggregate_Functions
        (Values              : Aggregate_Element_Lists.Vector;
         Variables           : Flow_Id_Sets.Set;
         Elements_From_Nodes : Node_To_Why_Id.Map;
         Bounds              : W_Expr_Array)
      with Pre => Should_Use_Function_Translation;
      --  Generate the logic function definition for the aggregate Expr, with a
      --  suitable defining axiom, as well as a program function with a post:
      --
      --     function F (<params>) : <type of aggregate>
      --
      --     axiom A:
      --       forall id:<type of aggregate>. forall <params>.
      --         <proposition for the aggregate F(<params>)>
      --
      --     val F (<params>) : <type of aggregate>
      --       ensures { <proposition for the aggregate result> }

      function Make_Defining_Proposition
        (Arr                 : W_Term_Id;
         Elements_From_Nodes : Node_To_Why_Id.Map;
         Bounds              : W_Expr_Array;
         Params              : Transformation_Params;
         Skip_Guards         : Boolean := False) return W_Pred_Id;
      --  Generates a proposition stating that array Arr contains the result of
      --  aggregate Expr, using Elements_From_Nodes to map nodes for indices
      --  and components to Why3 identifiers, and Bounds to figure out the
      --  bounds when Needs_Bounds = True.
      --  If Skip_Guards is True, does not generate guards to guarantee the
      --  soundness of the proposition.

      function Transform_Array_Component_Associations
        (Arr                 : W_Term_Id;
         Elements_From_Nodes : Node_To_Why_Id.Map;
         Bounds              : W_Expr_Array;
         Params              : Transformation_Params;
         Skip_Guards         : Boolean := False) return W_Pred_Id;
      --  Generates the proposition defining the content of components of
      --  aggregate Arr, based on a mapping between Ada nodes and corresponding
      --  Why identifiers.
      --  If Skip_Guards is True, does not generate guards to guarantee the
      --  soundness of the proposition.

      function Complete_Translation
        (Func                : W_Identifier_Id;
         Values              : Aggregate_Element_Lists.Vector;
         Variables           : Flow_Id_Sets.Set;
         Elements_From_Nodes : Node_To_Why_Id.Map;
         Bounds              : W_Expr_Array) return W_Expr_Id
      with Pre => (Func /= Why_Empty) = Should_Use_Function_Translation;
      --  Given a logic function Func previously defined for the aggregate,
      --  generate the actual call to Func by translating arguments Values
      --  of type Types in the context given by Params. If Func is empty,
      --  use a translation based on any/epsilon otherwise.

      procedure Insert_Check_For_Choices
        (T : in out W_Expr_Id; Array_Expr : W_Term_Id)
      with Pre => Domain = EW_Prog;
      --  Insert checks for the choices of the aggregate and for component
      --  values inside iterated component associations.

      function Transform_Aggregate_Value
        (Value  : Node_Id;
         Typ    : Entity_Id;
         Domain : EW_Domain;
         Params : Transformation_Params) return W_Expr_Id;
      --  Transform a value of the aggregate. Value can be either a component
      --  value or an index value.

      --------------------------
      -- Complete_Translation --
      --------------------------

      function Complete_Translation
        (Func                : W_Identifier_Id;
         Values              : Aggregate_Element_Lists.Vector;
         Variables           : Flow_Id_Sets.Set;
         Elements_From_Nodes : Node_To_Why_Id.Map;
         Bounds              : W_Expr_Array) return W_Expr_Id
      is
         R            : W_Expr_Id;
         Use_Function : constant Boolean := (Func /= Why_Empty);
      begin
         if Use_Function then
            declare
               Cnt      : Positive;
               Args     : W_Expr_Array (1 .. Natural (Values.Length));
               Bnd_Args : W_Expr_Array (1 .. Bound_Count);
               Var_Args : constant W_Expr_Array :=
                 Get_Args_From_Variables
                   (Variables, Ref_Allowed => Params.Ref_Allowed);
            begin
               --  Compute the arguments for the function call. The values are
               --  given directly as parameters.

               Cnt := 1;
               for Value of Values loop
                  Args (Cnt) :=
                    Transform_Aggregate_Value
                      (Value  => Value.Value,
                       Typ    => Value.Typ,
                       Domain => Domain,
                       Params => Params);
                  Cnt := Cnt + 1;
               end loop;

               --  Compute the bounds of the type to be given as additional
               --  arguments to the aggregate function.

               if Needs_Bounds then
                  for Dim in Dimensions loop
                     Bnd_Args (2 * Dim - 1) :=
                       +Get_Array_Attr
                          (Term_Domain (Domain),
                           Expr_Typ,
                           Attribute_First,
                           Dim,
                           Params);
                     Bnd_Args (2 * Dim) :=
                       +Get_Array_Attr
                          (Term_Domain (Domain),
                           Expr_Typ,
                           Attribute_Last,
                           Dim,
                           Params);
                  end loop;
               end if;

               --  If we are in a delta aggregate and we need checks, use the
               --  identifier for the updated expression so that it can be
               --  reused for checks of bounds of choices.

               if In_Delta_Aggregate and then Domain = EW_Prog then
                  Args (1) := New_Temp_For_Expr (Args (1));
               end if;

               --  Compute the call

               R :=
                 New_Call
                   (Ada_Node => Expr,
                    Domain   => Domain,
                    Name     => Func,
                    Args     => Args & Bnd_Args & Var_Args,
                    Typ      => Ret_Type);

               --  Insert checks for the choices of the aggregate, binding
               --  temporary variable for update prefix when present.

               if Domain = EW_Prog then
                  if In_Delta_Aggregate then
                     Insert_Check_For_Choices (R, +Args (1));
                     R :=
                       Binding_For_Temp
                         (Domain => Domain, Tmp => Args (1), Context => R);
                  else
                     Insert_Check_For_Choices (R, Why_Empty);
                  end if;
               end if;
            end;
         else
            --  Depending on domain, translate aggregate to an epsilon or an
            --  any. This translates variables/contextual elements in-place
            --  and leaves to Why3 to turn the variable content in them into
            --  additional parameters.

            declare
               Aggr_Name : W_Identifier_Id;
            begin
               case Domain is
                  when EW_Term            =>
                     Aggr_Name := New_Temp_Identifier (Typ => Ret_Type);
                     R :=
                       New_Epsilon
                         (Ada_Node => Expr,
                          Domain   => EW_Term,
                          Name     => Aggr_Name,
                          Typ      => Ret_Type,
                          Pred     =>
                            Make_Defining_Proposition
                              (Arr                 => +Aggr_Name,
                               Elements_From_Nodes => Elements_From_Nodes,
                               Bounds              => Bounds,
                               Params              => Params));

                  --  The postcondition of the any expression is only
                  --  assumed in the current context. No need to emit guards
                  --  for soundness.

                  when EW_Pterm | EW_Prog =>
                     Aggr_Name := New_Result_Ident (Ret_Type);
                     R :=
                       New_Any_Expr
                         (Ada_Node    => Expr,
                          Post        =>
                            Make_Defining_Proposition
                              (Arr                 => +Aggr_Name,
                               Elements_From_Nodes => Elements_From_Nodes,
                               Bounds              => Bounds,
                               Params              => Params,
                               Skip_Guards         => True),
                          Return_Type => Ret_Type,
                          Labels      => Symbol_Sets.Empty_Set);

                  when others             =>
                     raise Program_Error;
               end case;
            end;

            --  Insert checks for choices.

            if Domain = EW_Prog then
               Insert_Check_For_Choices
                 (R,
                  (if In_Delta_Aggregate
                   then +Elements_From_Nodes.Element (Update_Prefix)
                   else Why_Empty));
            end if;

            --  Bind the temporaries for elements, for bounds and
            --  subexpressions.

            if Needs_Bounds then
               for Dim in reverse Dimensions loop
                  R :=
                    New_Typed_Binding
                      (Domain  => Domain,
                       Name    => +Bounds (2 * Dim),
                       Def     =>
                         +Get_Array_Attr
                            (Term_Domain (Domain),
                             Expr_Typ,
                             Attribute_Last,
                             Dim,
                             Params),
                       Context => R);
                  R :=
                    New_Typed_Binding
                      (Domain  => Domain,
                       Name    => +Bounds (2 * Dim - 1),
                       Def     =>
                         +Get_Array_Attr
                            (Term_Domain (Domain),
                             Expr_Typ,
                             Attribute_First,
                             Dim,
                             Params),
                       Context => R);
               end loop;
            end if;

            for Value of reverse Values loop
               R :=
                 New_Typed_Binding
                   (Domain  => Domain,
                    Name    => Elements_From_Nodes.Element (Value.Value),
                    Def     =>
                      Transform_Aggregate_Value
                        (Value  => Value.Value,
                         Typ    => Value.Typ,
                         Domain => Domain,
                         Params => Params),
                    Context => R);
            end loop;
         end if;

         --  Possibly check the predicate on the aggregate

         if Domain = EW_Prog and then Has_Predicates (Expr_Typ) then
            R :=
              +Insert_Predicate_Check
                 (Ada_Node => Expr, Check_Ty => Expr_Typ, W_Expr => +R);
         end if;

         return R;
      end Complete_Translation;

      ----------------------------------
      -- Generate_Aggregate_Functions --
      ----------------------------------

      procedure Generate_Aggregate_Functions
        (Values              : Aggregate_Element_Lists.Vector;
         Variables           : Flow_Id_Sets.Set;
         Elements_From_Nodes : Node_To_Why_Id.Map;
         Bounds              : W_Expr_Array)
      is
         function Get_Name_For_Aggregate (Aggr : Node_Id) return String;
         --  Return a suitable name for the aggregate Aggr. If Aggr is the
         --  initialization expression in an object declaration, then use the
         --  name of the object as basis, which ensures stable naming across
         --  changes in GNATprove. Otherwise, use a temporary name based on a
         --  counter.

         ----------------------------
         -- Get_Name_For_Aggregate --
         ----------------------------

         function Get_Name_For_Aggregate (Aggr : Node_Id) return String is
            Obj : constant Entity_Id := Get_Initialized_Object (Aggr);

         begin
            --  If Expr is used to initialize an object, reuse the object name
            --  to get a stable name.

            if Present (Obj) then
               return
                 Get_Module_Name (E_Module (Obj))
                 & To_String (WNE_Aggregate_Def_Suffix);
            else
               return
                 New_Temp_Identifier (To_String (WNE_Aggregate_Def_Suffix));
            end if;
         end Get_Name_For_Aggregate;

         --  Generate name for the function based on the location of the
         --  aggregate.

         Name : constant String :=
           Lower_Case_First (Get_Name_For_Aggregate (Expr));

         --  Predicate used to define the aggregate/updated object

         Params_No_Ref : constant Transformation_Params :=
           (Logic_Params with delta Old_Policy => Raise_Error);

         --  Arrays of binders and arguments, and mapping of nodes to names

         Call_Params : Binder_Array (1 .. Natural (Values.Length));
         Call_Args   : W_Expr_Array (1 .. Natural (Values.Length));

         --  Additional arguments for the array bounds

         Bnd_Params : constant Binder_Array :=
           (for I in 1 .. Bound_Count =>
              (Ada_Node => Standard.Types.Empty,
               B_Name   => +Bounds (I),
               B_Ent    => Null_Entity_Name,
               Mutable  => False,
               Labels   => <>));

         --  Additional arguments for variables occurring in dynamic invariant/
         --  default init.

         Var_Items  : constant Item_Array :=
           Get_Localized_Binders_From_Variables
             (Variables, Only_Variables => False);
         Var_Params : constant Binder_Array := To_Binder_Array (Var_Items);
         Var_Args   : constant W_Expr_Array :=
           Get_Args_From_Binders (Var_Params, Ref_Allowed => False);

         --  Counter

         Cnt : Positive;

         --  Variables for the call, guard and proposition for the axiom

         Func       : W_Identifier_Id;
         Aggr       : W_Term_Id;
         Def_Pred   : W_Pred_Id;
         Axiom_Body : W_Pred_Id := True_Pred;
         Post       : W_Pred_Id := True_Pred;

         Aggr_Temp : constant W_Identifier_Id :=
           New_Temp_Identifier (Typ => Ret_Type);

         Th : Theory_UC;

         --  Start of processing for Generate_Logic_Function

      begin
         --  Insert new modules for the program and logic functions in the
         --  module map. The translation follows the same schema as regular
         --  functions: an early declaration for the logic function exported
         --  again in the regular module for the aggregate, a defining axiom in
         --  the axiom module linked to the regular module, and a program
         --  function with an instance of the defining axiom inlined in its
         --  postcondition.

         Insert_Extra_Module
           (Expr,
            New_Module (Ada_Node => Expr, File => No_Symbol, Name => Name));
         Insert_Extra_Module
           (Expr,
            New_Module (File => No_Symbol, Name => Name & "___logic_fun"),
            Logic_Function_Decl);
         Insert_Extra_Module
           (Expr,
            New_Module (File => No_Symbol, Name => Name & "___program_fun"),
            Program_Function_Decl);
         Insert_Extra_Module
           (Expr,
            New_Module
              (File => No_Symbol, Name => Name & To_String (WNE_Axiom_Suffix)),
            Axiom);

         --  Compute the parameters/arguments for the axiom/call

         Cnt := 1;
         for Value of Values loop
            Call_Params (Cnt) :=
              (Ada_Node => Standard.Types.Empty,
               B_Name   => Elements_From_Nodes.Element (Value.Value),
               B_Ent    => Null_Entity_Name,
               Mutable  => False,
               Labels   => Symbol_Sets.Empty_Set);
            Cnt := Cnt + 1;
         end loop;

         Call_Args :=
           Get_Args_From_Binders (Call_Params, Ref_Allowed => False);
         pragma Assert (Cnt = Call_Params'Last + 1);

         --  Push localized binders for variables to the symbol table. This is
         --  important so that the translation of the aggregate can be reused
         --  even if the mappings in the symbol table are updated (typically,
         --  for formal parameters in postconditions).

         Ada_Ent_To_Why.Push_Scope (Symbol_Table);
         Push_Binders_To_Symbol_Table (Var_Items);

         --  Compute the call, guard and proposition for the axiom

         Axiom_Body :=
           Make_Defining_Proposition
             (Arr                 => +Aggr_Temp,
              Elements_From_Nodes => Elements_From_Nodes,
              Bounds              => Bounds,
              Params              => Params_No_Ref);

         --  The postcondition of the program function is only assumed in the
         --  context of the call. No need to emit guards for soundness.

         Post :=
           Make_Defining_Proposition
             (Arr                 => +New_Result_Ident (Typ => Ret_Type),
              Elements_From_Nodes => Elements_From_Nodes,
              Bounds              => Bounds,
              Params              => Params_No_Ref,
              Skip_Guards         => True);

         Ada_Ent_To_Why.Pop_Scope (Symbol_Table);

         --  Like for regular functions, call the early declaration of the
         --  logic function to avoid pulling the axiom when using the program
         --  function.

         Func :=
           New_Identifier
             (Ada_Node => Expr,
              Domain   => Domain,
              Module   => E_Module (Expr, Logic_Function_Decl),
              Symb     => NID (Name));

         Aggr :=
           New_Call
             (Ada_Node => Expr,
              Name     => Func,
              Args     => Call_Args & Bounds & Var_Args,
              Typ      => Ret_Type);

         Def_Pred :=
           New_Typed_Binding
             (Name => Aggr_Temp, Def => Aggr, Context => Axiom_Body);

         --  Add the equality with the logic function to the post of the
         --  program function.

         Post :=
           New_And_Pred
             (Left  => Post,
              Right =>
                New_Comparison
                  (Symbol => Why_Eq,
                   Left   => +New_Result_Ident (Typ => Ret_Type),
                   Right  => Aggr));

         --  Generate the logic function declaration in its specific module

         Th :=
           Open_Theory
             (WF_Context,
              E_Module (Expr, Logic_Function_Decl),
              Comment =>
                "Module for initial declaration of the logic function for the "
                & (if Nkind (Expr) = N_Delta_Aggregate
                   then "delta aggregate"
                   elsif In_Delta_Aggregate
                   then "update attribute"
                   else "aggregate")
                & " at "
                & (if Sloc (Expr) > 0
                   then Build_Location_String (Sloc (Expr))
                   else "<no location>")
                & ", created in "
                & GNAT.Source_Info.Enclosing_Entity);

         Emit
           (Th,
            New_Function_Decl
              (Domain      => EW_Pterm,
               Name        => To_Local (Func),
               Labels      => Symbol_Sets.Empty_Set,
               Location    => No_Location,
               Binders     => Call_Params & Bnd_Params & Var_Params,
               Return_Type => Ret_Type));

         Close_Theory (Th, Kind => Definition_Theory);

         --  Export the logic symbol in Expr's regular module

         Th :=
           Open_Theory
             (WF_Context,
              E_Module (Expr),
              Comment =>
                "Module for declaring a logic function for the "
                & (if Nkind (Expr) = N_Delta_Aggregate
                   then "delta aggregate"
                   elsif In_Delta_Aggregate
                   then "update attribute"
                   else "aggregate")
                & " at "
                & (if Sloc (Expr) > 0
                   then Build_Location_String (Sloc (Expr))
                   else "<no location>")
                & ", created in "
                & GNAT.Source_Info.Enclosing_Entity);

         Add_With_Clause (Th, E_Module (Expr, Logic_Function_Decl), EW_Export);

         Close_Theory (Th, Kind => Definition_Theory);

         --  Generate the program function declaration in its specific module

         Th :=
           Open_Theory
             (WF_Context,
              E_Module (Expr, Program_Function_Decl),
              Comment =>
                "Module for declaring a program function for the "
                & (if Nkind (Expr) = N_Delta_Aggregate
                   then "delta aggregate"
                   elsif In_Delta_Aggregate
                   then "update attribute"
                   else "aggregate")
                & " at "
                & (if Sloc (Expr) > 0
                   then Build_Location_String (Sloc (Expr))
                   else "<no location>")
                & ", created in "
                & GNAT.Source_Info.Enclosing_Entity);

         Emit
           (Th,
            New_Function_Decl
              (Domain      => EW_Prog,
               Name        => To_Local (Func),
               Labels      => Symbol_Sets.Empty_Set,
               Location    => No_Location,
               Binders     => Call_Params & Bnd_Params & Var_Params,
               Return_Type => Ret_Type,
               Post        => Post));

         Close_Theory (Th, Kind => Definition_Theory);

         --  Generate the axiom in an axiom module always included with Expr's
         --  regular module.

         Th :=
           Open_Theory
             (WF_Context,
              E_Module (Expr, Axiom),
              Comment =>
                "Module for declaring an axiom defining the value of the "
                & (if Nkind (Expr) = N_Delta_Aggregate
                   then "delta aggregate"
                   elsif In_Delta_Aggregate
                   then "update attribute"
                   else "aggregate")
                & " at "
                & (if Sloc (Expr) > 0
                   then Build_Location_String (Sloc (Expr))
                   else "<no location>")
                & ", created in "
                & GNAT.Source_Info.Enclosing_Entity);

         Emit
           (Th,
            New_Guarded_Axiom
              (Name    => NID (Def_Axiom),
               Binders => Call_Params & Bnd_Params & Var_Params,
               Def     => Def_Pred,
               Dep     =>
                 New_Axiom_Dep (Name => Func, Kind => EW_Axdep_Func)));

         Close_Theory (Th, Kind => Axiom_Theory, Defined_Entity => Expr);
      end Generate_Aggregate_Functions;

      ----------------------------
      -- Get_Aggregate_Elements --
      ----------------------------

      procedure Get_Aggregate_Elements
        (Values              : out Aggregate_Element_Lists.Vector;
         Variables           : out Flow_Id_Sets.Set;
         Elements_From_Nodes : out Node_To_Why_Id.Map;
         Bounds              : out W_Expr_Array)
      is
         In_Iterated_Assoc : Boolean := False;
         --  Register whether we have traversed iterated component associations

         -----------------------
         -- Local subprograms --
         -----------------------

         procedure Add_Element (E : Aggregate_Element);
         --  Append a new entry in the Value sequence, and add a corresponding
         --  Why identifier in the Elements_From_Nodes map. If this would cause
         --  a pre-existing node to be added again, the entry is discarded.
         --  This could happen if someone were to use the same subtype mark as
         --  choice twice in a delta aggregate (although the point of doing so
         --  is dubious, this is legal Ada).

         procedure Traverse_Value_At_Index
           (Dim : Dimensions; Expr_Or_Association : Node_Id);
         --  Traverse the value Expr_Or_Association to collect desired elements

         procedure Traverse_Rec_Aggregate
           (Dim : Dimensions; Subexpr : Node_Id);
         --  Main recursive function operating over multi-dimensional array
         --  aggregates.

         -----------------
         -- Add_Element --
         -----------------

         procedure Add_Element (E : Aggregate_Element) is
            Typ      : constant Node_Id := E.Typ;
            Ident    : constant W_Identifier_Id :=
              New_Temp_Identifier
                (Typ =>
                 --  Special case for associations standing boxes in the
                 --  aggregate.
                   (if Nkind (E.Value)
                       in N_Iterated_Component_Association
                        | N_Component_Association
                    then
                      EW_Abstract
                        (Typ,
                         Relaxed_Init =>
                           (if Relaxed_Init
                            then Has_Init_Wrapper (Typ)
                            else Has_Relaxed_Init (Typ)))
                    elsif Expr_Has_Relaxed_Init (E.Value, No_Eval => False)
                    then EW_Abstract (Typ, Relaxed_Init => True)
                    else Type_Of_Node (Typ)));
            Position : Node_To_Why_Id.Cursor;
            Inserted : Boolean;
         begin
            Elements_From_Nodes.Insert (E.Value, Ident, Position, Inserted);
            if Inserted then
               Values.Append (E);
            end if;
         end Add_Element;

         -----------------------------
         -- Traverse_Value_At_Index --
         -----------------------------

         procedure Traverse_Value_At_Index
           (Dim : Dimensions; Expr_Or_Association : Node_Id)
         is
            Value_Expr             : Node_Id;
            Choice                 : Node_Id;
            Rng                    : Node_Id;
            In_Iterated_Assoc_Save : constant Boolean := In_Iterated_Assoc;

         begin
            --  For delta aggregates, we need the choices as parameters since
            --  they can be dynamic. If Expr_Or_Association is a component
            --  association, first we go through the component association and
            --  collect them.

            if In_Delta_Aggregate
              and then
                Nkind (Expr_Or_Association)
                in N_Component_Association | N_Iterated_Component_Association
            then
               if Is_Others_Choice (Choice_List (Expr_Or_Association)) then
                  Choice := Empty;
               else
                  Choice := First (Choice_List (Expr_Or_Association));
               end if;

               --  Collect the choices as parameters. Populate Values with
               --  the parameters needed. Choices of delta aggregates can never
               --  be in iterated component associations.

               pragma Assert (not In_Iterated_Assoc);

               while Present (Choice) loop
                  case Nkind (Choice) is
                     when N_Subtype_Indication | N_Range =>

                        --  The high and low bounds of a range both
                        --  need to be parameters. We don't use the index
                        --  type for them as bounds can be outside of the
                        --  index sutype in case of empty ranges.

                        Rng := Get_Range (Choice);
                        Add_Element
                          (Aggregate_Element'
                             (Value => Low_Bound (Rng),
                              Typ   => Etype (Low_Bound (Rng))));
                        Add_Element
                          (Aggregate_Element'
                             (Value => High_Bound (Rng),
                              Typ   => Etype (High_Bound (Rng))));

                     when N_Aggregate                    =>

                        --  This is a special choice, the LHS of an
                        --  association of a 'Update of a
                        --  multi-dimensional array,
                        --  for example: (I, J, K) of
                        --  'Update((I, J, K) => New_Val)

                        pragma
                          Assert
                            (Nb_Dim /= 1
                             and then Dim = 1
                             and then No (Component_Associations (Choice)));
                        declare
                           Multi_Expr : Node_Id :=
                             Nlists.First (Expressions (Choice));
                        begin
                           for Dim in Dimensions loop
                              Add_Element
                                (Aggregate_Element'
                                   (Value => Multi_Expr,
                                    Typ   => Index_Types (Dim)));
                              Next (Multi_Expr);
                           end loop;
                           pragma Assert (No (Multi_Expr));
                        end;

                     when others                         =>
                        if Is_Entity_Name (Choice)
                          and then Is_Type (Entity (Choice))
                        then
                           declare
                              Rng : constant Node_Id :=
                                Get_Range (Entity (Choice));
                           begin
                              Add_Element
                                (Aggregate_Element'
                                   (Value => Low_Bound (Rng),
                                    Typ   => Etype (Low_Bound (Rng))));
                              Add_Element
                                (Aggregate_Element'
                                   (Value => High_Bound (Rng),
                                    Typ   => Etype (High_Bound (Rng))));
                           end;
                        else
                           Add_Element
                             (Aggregate_Element'
                                (Value => Choice, Typ => Index_Types (Dim)));
                        end if;
                  end case;
                  Next (Choice);
               end loop;
            end if;

            --  Next, for both positional and named associations, and for
            --  both normal and for delta aggregates, we fill the
            --  component expressions to the arrays Values and Types, to
            --  later be used as parameters.

            if Nkind (Expr_Or_Association) = N_Component_Association
              and then Box_Present (Expr_Or_Association)
            then

               --  Collecting variables of the default expression for later use
               --  as parameter.

               if In_Iterated_Assoc then
                  Variables_In_Default_Init (Comp_Type, Variables);

               --  The default expression is directly used as parameter. Use
               --  the association as a placeholder.

               else
                  Add_Element
                    (Aggregate_Element'
                       (Value => Expr_Or_Association, Typ => Comp_Type));
               end if;
            else
               --  Get the expression from the association and set
               --  In_Iterated_Assoc.

               case Nkind (Expr_Or_Association) is
                  when N_Iterated_Component_Association =>
                     Value_Expr := Expression (Expr_Or_Association);
                     In_Iterated_Assoc := True;

                  when N_Component_Association          =>
                     Value_Expr := Expression (Expr_Or_Association);

                  when others                           =>
                     Value_Expr := Expr_Or_Association;
               end case;

               if Dim /= Nb_Dim and then not In_Delta_Aggregate then

                  --  Normal, multidimensional aggregate, for example:
                  --  Array_2D'(1      => (2 => Expr_1, others => Expr_2),
                  --            others => (others => Expr_3))
                  --
                  --  The components are aggregates as long as Dim < Nb_Dim.
                  --  Keep recursively peeling the aggregates off.

                  pragma Assert (Nkind (Value_Expr) = N_Aggregate);
                  Traverse_Rec_Aggregate (Dim + 1, Value_Expr);
               else

                  --  Two cases here:
                  --
                  --  1) A single dimensional aggregate, normal or delta,
                  --  (for example an innermost of a multidimensional
                  --  aggregate), or
                  --
                  --  2) A multidimensional 'Update aggregate of the form
                  --  'Update((I, J, K) => New_Val)
                  --
                  --  in both cases there are no more aggregates to peel off.

                  pragma
                    Assert
                      (Dim = Nb_Dim
                       or else (In_Delta_Aggregate and then Dim = 1));

                  if not In_Iterated_Assoc then
                     Add_Element
                       (Aggregate_Element'
                          (Value => Value_Expr, Typ => Comp_Type));
                  end if;
               end if;

               In_Iterated_Assoc := In_Iterated_Assoc_Save;
            end if;
         end Traverse_Value_At_Index;

         ----------------------------
         -- Traverse_Rec_Aggregate --
         ----------------------------

         procedure Traverse_Rec_Aggregate (Dim : Dimensions; Subexpr : Node_Id)
         is
            Positionals : constant List_Id :=
              (if Nkind (Subexpr) = N_Delta_Aggregate
               then No_List
               else Expressions (Subexpr));
            Assocs      : constant List_Id := Component_Associations (Subexpr);
            Positional  : Node_Id := Nlists.First (Positionals);
            Association : Node_Id := Nlists.First (Assocs);

         begin
            --  Positional association is not allowed in delta aggregate
            --  (except in an inner aggregate that is the choice in a
            --  component association of a multidimensional 'Update
            --  aggregate, but never on the outer level we are at here).

            pragma
              Assert (if Present (Positional) then not In_Delta_Aggregate);

            while Present (Positional) loop
               Traverse_Value_At_Index (Dim, Positional);
               Next (Positional);
            end loop;

            --  Although named association is not allowed after positional
            --  association, an "others" case is allowed, and this is included
            --  in the list of associations, so we always do the following.

            while Present (Association) loop
               Traverse_Value_At_Index (Dim, Association);
               Next (Association);
            end loop;
         end Traverse_Rec_Aggregate;

         --  Start of processing for Get_Aggregate_Elements

      begin
         --  We call the dynamic invariant of Comp_Type in the logic
         --  function to compute the guards. Add its variable to Variables.

         Variables_In_Dynamic_Invariant
           (Comp_Type, Variables, Scop => Current_Subp);

         --  In the case of a delta aggregate, add the prefix to be
         --  a parameter to the logic function.

         if In_Delta_Aggregate then
            Add_Element
              (Aggregate_Element'
                 (Value => Update_Prefix, Typ => Etype (Update_Prefix)));
         end if;

         Traverse_Rec_Aggregate (Dim => 1, Subexpr => Expr);

         --  If the bounds of the aggregate should be given as additional
         --  parameters to the call, also bind identifiers for them.

         if Needs_Bounds then
            for Dim in Dimensions loop
               declare
                  BT   : constant W_Type_Id :=
                    Base_Why_Type_No_Bool (Index_Types (Dim));
                  F_Id : constant W_Identifier_Id :=
                    New_Temp_Identifier (Base_Name => "first", Typ => BT);
                  L_Id : constant W_Identifier_Id :=
                    New_Temp_Identifier (Base_Name => "last", Typ => BT);
               begin
                  Bounds (2 * Dim - 1) := +F_Id;
                  Bounds (2 * Dim) := +L_Id;
               end;
            end loop;
         end if;

      end Get_Aggregate_Elements;

      ------------------------------
      -- Insert_Check_For_Choices --
      ------------------------------

      procedure Insert_Check_For_Choices
        (T : in out W_Expr_Id; Array_Expr : W_Term_Id)
      is
         Choice_Checks     : W_Statement_Sequence_Id := Void_Sequence;
         Comp_Checks       : W_Statement_Sequence_Id := Void_Sequence;
         In_Iterated_Assoc : Boolean := False;
         --  Register whether we have traversed iterated component associations

         Last_Uniq_Dim : Dimensions := 1;
         --  Register the last dimensional index with a single subaggregate.
         --  Used to eliminate redundant bound checks as much as possible.

         procedure Insert_Checks (Subexpr : Node_Id; Dim : Dimensions);
         --  Introduce checks for choices of an expression. Recursively call
         --  itself to check choices for upper dimensions in regular
         --  multidimensional aggregates.

         -------------------
         -- Insert_Checks --
         -------------------

         procedure Insert_Checks (Subexpr : Node_Id; Dim : Dimensions) is
            Assocs       : constant List_Id :=
              Component_Associations (Subexpr);
            Association  : Node_Id := Nlists.First (Assocs);
            Positionals  : constant List_Id :=
              (if Nkind (Subexpr) = N_Delta_Aggregate
               then No_List
               else Expressions (Subexpr));
            Positional   : Node_Id := Nlists.First (Positionals);
            Index_Typ    : constant Entity_Id := Index_Types (Dim);
            Index_Base   : constant W_Type_Id :=
              Base_Why_Type_No_Bool (Index_Typ);
            Save_In_Iter : constant Boolean := In_Iterated_Assoc;
            Save_Checks  : W_Statement_Sequence_Id := Why_Empty;
            Choice       : Node_Id;
            Idx          : W_Identifier_Id := Why_Empty;
            Binding      : W_Prog_Id := Why_Empty;
            Others_Guard : W_Pred_Id :=
              +Range_Expr
                 (N      => Get_Range (Index_Typ),
                  T      => +New_Result_Ident (Index_Base),
                  Domain => EW_Pred,
                  Params => Params);

         begin
            --  Deal with the special case of an empty (sub)aggregate []. Those
            --  do not have any explicit choices. They use the default ranges
            --  Index_Type'First .. Index_Type'Base'Pred (Index_Type'First),
            --  under the GNATprove limitation that [] cannot show up in
            --  aggregates with multiple association. Make sure that the
            --  computation of the last bound does not overflow.
            --
            --  The limitation comes from the fact that the front-end might not
            --  provide properly all bounds for null subaggregates. Recomputing
            --  them in general is tricky as this requires knowing whether
            --  there is an applicable index constraint from the context. For
            --  that reason, we do not support null subaggregates when there
            --  should be subject to matching bound checks. Those cases are
            --  rejected by marking.
            --
            --  Return once done, this completely deal with [] case.

            if No (Association) and then No (Positional) then
               --  Make sure we do not need bound checks

               pragma
                 Assert (not In_Delta_Aggregate and then Dim <= Last_Uniq_Dim);

               declare
                  Dim_Cursor : Positive := 1;
                  Index      : Node_Id := First_Index (Expr_Typ);
                  Index_Base : Node_Id := First_Index (Base_Retysp (Expr_Typ));

               begin
                  --  Walk through indexes of the aggregate until the current
                  --  dimension.

                  while Dim_Cursor /= Dim loop
                     Next_Index (Index);
                     Next_Index (Index_Base);
                     Dim_Cursor := Dim_Cursor + 1;
                  end loop;

                  while Present (Index) loop
                     --  For multi-dimensional aggregates, add the dimension as
                     --  a continuation.

                     if Nb_Dim /= 1 then
                        Continuation_Stack.Append
                          (Continuation_Type'
                             (Ada_Node => Index_Base,
                              Message  =>
                                To_Unbounded_String
                                  ("for array dimension" & Dim_Cursor'Image)));
                     end if;

                     --  For checks that fail statically, the frontend uses a
                     --  N_Raise_xxx_Error node for the lower bound.

                     if Nkind (High_Bound (Index)) in N_Raise_xxx_Error then
                        Emit_Static_Proof_Result
                          (Subexpr,
                           VC_Range_Check,
                           False,
                           Current_Subp,
                           Explanation =>
                             "empty aggregates cannot be used if there is no"
                             & " element before the first element of their"
                             & " index type");

                     --  Otherwise, check that Index'First is not the first
                     --  element of its base type.

                     else
                        Append
                          (Choice_Checks,
                           New_Located_Assert
                             (Ada_Node => Subexpr,
                              Reason   => VC_Range_Check,
                              Pred     =>
                                New_Not
                                  (Right =>
                                     New_Comparison
                                       (Symbol => Why_Eq,
                                        Left   =>
                                          Transform_Term
                                            (Expr          =>
                                               Low_Bound (Index),
                                             Expected_Type =>
                                               Base_Why_Type_No_Bool
                                                 (Etype (Index)),
                                             Params        => Body_Params),
                                        Right  =>
                                          +New_Attribute_Expr
                                             (Base_Type (Etype (Index)),
                                              EW_Term,
                                              Attribute_First,
                                              Body_Params))),
                              Kind     => EW_Assert));
                     end if;

                     if Nb_Dim /= 1 then
                        Continuation_Stack.Delete_Last;
                     end if;

                     Next_Index (Index);
                     Next_Index (Index_Base);
                     Dim_Cursor := Dim_Cursor + 1;
                  end loop;
               end;

               --  There is no other check to generate for null subaggregates,
               --  exit here.

               return;
            end if;

            --  When aggregate has positional associations, we need additional
            --  checks that the implicit indexes of the positional associations
            --  are all between the bounds, when computed as plain position
            --  numbers (no modular arithmetic should be involved in their
            --  computation). It is sufficient to make that check for the last
            --  positional index:
            --  * All elements are necessarily >= the lower bound chosen for
            --    the (sub)aggregate by definition, since they are at a >= 0
            --    offset from it.
            --  * All elements are necessarily <= the upper bound if the
            --    last element is.
            --  This also means that it is sufficient to test the upper
            --  bound only. But since we have bitvectors in Why3 when the index
            --  uses modular integers, we have no proof-convenient way to make
            --  the translation a check on plain mathematical integers. If we
            --  carry this check in bitvector arithmetic, it could fail due to
            --  wraparound. We need to add a no-wraparound check in that case.
            --  Thanks to the front-end already rejecting the situation where
            --  there is more positional associations that values in the type,
            --  in case of wraparound, the index computed in modular arithmetic
            --  ends up being strictly below the lower bound. So we can reject
            --  wraparound by testing the lower bound as well.
            --
            --  The check we generate for this case is an in-range check for
            --  the last positional index, with:
            --  * The upper bound check removed if there is no others case. In
            --    that case, it is redundant with the matching bound check of
            --    the subaggregate. This is because subagggregate bounds are
            --    derived from the number of positional elements in that case,
            --    so the implicit indices (as position numbers) are between
            --    those bounds by construction. Matching bound checks make sure
            --    those actually are the index type bounds of the aggregate.
            --  * The lower bound check removed for signed integer type,
            --    as wraparound is only a concern for modular types.
            --  If there are no others case and the type is not modular, there
            --  is no need to generate anything.

            if Present (Positional)
              and then
                (Present (Association)
                 or else Why_Type_Is_BitVector (Index_Base))
            then
               declare
                  Pred : W_Pred_Vectors.Vector;
                  --  Accumulate checks

                  Bounds : constant Node_Id := Aggregate_Bounds (Subexpr);
                  pragma Assert (Present (Bounds));
                  Low    : constant W_Term_Id :=
                    New_Temp_For_Expr
                      (W_Term_Id'
                         (+Transform_Expr
                             (Low_Bound (Bounds),
                              Index_Base,
                              EW_Term,
                              Params)));
                  --  Translate lower bound

                  Offset : constant W_Term_Id :=
                    New_Discrete_Constant
                      (Value =>
                         UI_From_Int (Nlists.List_Length (Positionals) - 1),
                       Typ   => Index_Base);

                  Last_Index : constant W_Term_Id :=
                    (if Why_Type_Is_BitVector (Index_Base)
                     then
                       +New_Binary_Op_Expr
                          (Op          => N_Op_Add,
                           Left        => +Low,
                           Right       => +Offset,
                           Left_Type   => Index_Typ,
                           Right_Type  => Index_Typ,
                           Return_Type => Index_Typ,
                           Domain      => EW_Term)
                     else
                       +New_Discrete_Add
                          (Domain => EW_Term, Left => +Low, Right => +Offset));
                  --  Construct implicit index of last positional association.
                  --  Note that we must not compute in the base type for the
                  --  bitvector case, as using the base modulus may miscompute
                  --  the upper bound.

               begin
                  if Why_Type_Is_BitVector (Index_Base) then
                     --  Generate no-wraparound check.

                     W_Pred_Vectors.Append
                       (V    => Pred,
                        Pred =>
                          New_Comparison
                            (Symbol => MF_BVs (Index_Base).Ule,
                             Left   => Low,
                             Right  => Last_Index));
                  end if;

                  if Present (Association) then
                     --  'others' choice. Generate upper bound check.

                     pragma
                       Assert (Is_Others_Choice (Choice_List (Association)));
                     W_Pred_Vectors.Append
                       (V    => Pred,
                        Pred =>
                          New_Comparison
                            (Symbol =>
                               (if Why_Type_Is_BitVector (Index_Base)
                                then MF_BVs (Index_Base).Ule
                                else Int_Infix_Le),
                             Left   => Last_Index,
                             Right  =>
                               +Transform_Expr
                                  (High_Bound (Bounds),
                                   Index_Base,
                                   EW_Term,
                                   Params)));
                  end if;

                  pragma Assert (not W_Pred_Vectors.Is_Empty (Pred));

                  Append
                    (Choice_Checks,
                     New_Located_Assert
                       (Ada_Node => Nlists.Last (Positionals),
                        Reason   => VC_Range_Check,
                        Kind     => EW_Assert,
                        Pred     =>
                          Binding_For_Temp
                            (Tmp     => Low,
                             Context =>
                               New_And_Pred
                                 (W_Pred_Vectors.To_Array (Pred)))));
               end;
            end if;

            --  Go over the list of associations to insert checks

            while Present (Association) loop
               if not Is_Others_Choice (Choice_List (Association)) then
                  Choice := First (Choice_List (Association));

                  while Present (Choice) loop

                     --  For delta aggregates, choices are passed as parameters
                     --  and checks inserted in Transform_Expr when arguments
                     --  for the function call are computed, so we don't need
                     --  to check absence of RTE for them. We still need to
                     --  check that choices are in the bounds of the updated
                     --  expression. In the case of simple values of an array
                     --  constrained type, this check may be redundant.

                     if In_Delta_Aggregate then

                        --  For multidimensional 'Update, we generate an
                        --  index check for each value of the choice aggregate.
                        --  For (I1, I2) => ... we generate:
                        --  index_check <I1>; index_check <I2>

                        if Nb_Dim > 1 then
                           pragma Assert (Nkind (Choice) = N_Aggregate);
                           declare
                              Multi_Expr : Node_Id :=
                                Nlists.First (Expressions (Choice));
                           begin
                              for I in Dimensions loop
                                 pragma Assert (Present (Multi_Expr));
                                 Append
                                   (Choice_Checks,
                                    New_Ignore
                                      (Prog =>
                                         Do_Index_Check
                                           (Ada_Node => Multi_Expr,
                                            Arr_Expr => Array_Expr,
                                            W_Expr   =>
                                              Transform_Expr
                                                (Expr          => Multi_Expr,
                                                 Domain        => EW_Pterm,
                                                 Params        => Params,
                                                 Expected_Type =>
                                                   Base_Why_Type_No_Bool
                                                     (Index_Types (I))),
                                            Dim      => I)));
                                 Next (Multi_Expr);
                              end loop;
                              pragma Assert (No (Multi_Expr));
                           end;

                        --  Choices of unary aggregates can involve ranges or
                        --  subtype indications in addition to values. We reuse
                        --  translation of choices to generate:
                        --  let index = any <Index_Type> { result in <Choice> }
                        --    in index_check index

                        else
                           declare
                              Tmp : constant W_Identifier_Id :=
                                New_Temp_Identifier
                                  (Base_Name => "index", Typ => Index_Base);
                           begin
                              Append
                                (Choice_Checks,
                                 (New_Ignore
                                    (Prog =>
                                       New_Binding
                                         (Name    => Tmp,
                                          Def     =>
                                            New_Any_Expr
                                              (Post        =>
                                                 +Transform_Discrete_Choice
                                                    (Choice      => Choice,
                                                     Choice_Type => Index_Typ,
                                                     Expr        =>
                                                       +New_Result_Ident
                                                          (Index_Base),
                                                     Domain      => EW_Pred,
                                                     Params      => Params),
                                               Return_Type => Index_Base,
                                               Labels      =>
                                                 Symbol_Sets.Empty_Set),
                                          Context =>
                                            Do_Index_Check
                                              (Ada_Node => Choice,
                                               Arr_Expr => Array_Expr,
                                               W_Expr   => +Tmp,
                                               Dim      => 1)))));
                           end;
                        end if;

                     --  For normal aggregates, check absence of RTE in Choice

                     else
                        Append
                          (Choice_Checks,
                           (New_Ignore
                              (Prog =>
                                 +Transform_Discrete_Choice
                                    (Choice      => Choice,
                                     Choice_Type => Index_Typ,
                                     Expr        =>
                                     --  The value does not matter here
                                       New_Discrete_Constant
                                            (Value => Uint_0,
                                             Typ   => Index_Base),
                                     Domain      => EW_Prog,
                                     Params      => Params))));
                     end if;

                     --  If Choice is a subtype indication, insert check for
                     --  range constraint.

                     case Nkind (Choice) is
                        when N_Subtype_Indication =>
                           Append
                             (Choice_Checks,
                              Check_Scalar_Range
                                (Params => Params,
                                 N      => Get_Range (Choice),
                                 Base   => Entity (Subtype_Mark (Choice))));

                        when others               =>
                           null;
                     end case;
                     Next (Choice);
                  end loop;
               end if;

               --  If we are in an iterated component association, we need to
               --  wrap the checks introduced for the association in a let
               --  binding. Introduce a name for the index parameter and store
               --  it in the Symbol_Table. Save Checks in All_Checks and
               --  restart a fresh sequence of checks which will be wrapped in
               --  the binding. Also set In_Iterated_Assoc.

               if Nkind (Association) = N_Iterated_Component_Association then
                  In_Iterated_Assoc := True;

                  Save_Checks := Comp_Checks;
                  Comp_Checks := Void_Sequence;

                  declare
                     Quant_Var : constant Entity_Id :=
                       Defining_Identifier (Association);
                     Choices   : constant List_Id := Choice_List (Association);
                     Constr    : W_Pred_Id;
                  begin
                     --  Store in Constr the known constraints for the
                     --  quantified variables. If Choices is not others, also
                     --  update the Others_Guard to exclude the current choice.

                     if Is_Others_Choice (Choices) then
                        Constr := Others_Guard;
                     else
                        Constr :=
                          Transform_Discrete_Choices
                            (Choices      => Choices,
                             Choice_Type  => Etype (Quant_Var),
                             Matched_Expr => +New_Result_Ident (Index_Base),
                             Params       => Params);
                        Others_Guard :=
                          New_And_Pred
                            (Left  => Others_Guard,
                             Right => New_Not (Right => Constr));
                     end if;

                     Idx :=
                       New_Temp_Identifier
                         (Typ       => Index_Base,
                          Base_Name => Short_Name (Quant_Var));
                     Binding :=
                       New_Any_Expr
                         (Post        => Constr,
                          Return_Type => Index_Base,
                          Labels      => Symbol_Sets.Empty_Set);
                     Insert_Tmp_Item_For_Entity (Quant_Var, Idx);

                     if Present (Loop_Actions (Association)) then
                        Ada_Ent_To_Why.Push_Scope (Symbol_Table);
                        Transform_Actions_Preparation
                          (Loop_Actions (Association));
                     end if;
                  end;
               end if;

               --  In regular multidimensional aggregates, we also need to
               --  check choices in upper dimensions.

               if not In_Delta_Aggregate and then Dim /= Nb_Dim then
                  Insert_Checks (Expression (Association), Dim + 1);

               --  If we have reached a value which depends on iterated
               --  component associations, we must check the value.

               elsif In_Iterated_Assoc then
                  Append
                    (Comp_Checks,
                     New_Ignore
                       (Ada_Node => Expression (Association),
                        Prog     =>
                          +Transform_Aggregate_Value
                             (Value  =>
                                (if Box_Present (Association)
                                 then Association
                                 else Expression (Association)),
                              Typ    => Comp_Type,
                              Domain => Domain,
                              Params => Params)));
               end if;

               --  For iterated component associations, bind the name of the
               --  index parameter and restore the Checks sequence. Also reset
               --  In_Iterated_Assoc.

               if Nkind (Association) = N_Iterated_Component_Association then
                  if Present (Loop_Actions (Association)) then
                     Comp_Checks :=
                       +Transform_Actions
                          (Actions => Loop_Actions (Association),
                           Expr    => +Comp_Checks,
                           Domain  => EW_Prog,
                           Params  => Params);
                     Ada_Ent_To_Why.Pop_Scope (Symbol_Table);
                  end if;

                  Append
                    (Save_Checks,
                     New_Binding
                       (Name    => Idx,
                        Def     => Binding,
                        Context => +Comp_Checks,
                        Typ     => EW_Unit_Type));
                  Comp_Checks := Save_Checks;

                  In_Iterated_Assoc := Save_In_Iter;
               end if;

               Next (Association);
            end loop;

            --  If needed, generate checks that bounds of the sub-aggregates
            --  match that of the type.

            if not In_Delta_Aggregate
              and then Dim > Last_Uniq_Dim
              and then
                (No (Assocs)
                 or else No (Nlists.Last (Assocs))
                 or else
                   not Is_Others_Choice (Choice_List (Nlists.Last (Assocs))))
            then
               --  In a regular aggregate without an 'others' choice, we need
               --  to check that bounds match the ones expected from the
               --  aggregate Etype. One subaggregate check is redundant per
               --  dimension, for the subaggregate whose bounds are taken by
               --  the front-end. We filter out checks at dimensions where
               --  there is a single subaggregate since they must be redundant.

               declare
                  Low_Bnd  : constant W_Term_Id :=
                    Insert_Simple_Conversion
                      (Expr =>
                         Get_Array_Attr
                           (EW_Term, Expr_Typ, Attribute_First, Dim, Params),
                       To   => Index_Base);
                  High_Bnd : constant W_Term_Id :=
                    Insert_Simple_Conversion
                      (Expr =>
                         Get_Array_Attr
                           (EW_Term, Expr_Typ, Attribute_Last, Dim, Params),
                       To   => Index_Base);
                  --  Expected bounds

                  Bounds : constant Node_Id := Aggregate_Bounds (Subexpr);
                  pragma Assert (Present (Bounds));
                  --  Aggregate bounds should always be computed for
                  --  sub-aggregates supported by SPARK (they should be
                  --  unknown only for iterator_specification aggregates)

                  Low  : constant W_Expr_Id :=
                    Transform_Expr
                      (Low_Bound (Bounds), Index_Base, EW_Term, Params);
                  High : constant W_Expr_Id :=
                    Transform_Expr
                      (High_Bound (Bounds), Index_Base, EW_Term, Params);

               begin
                  Append
                    (Choice_Checks,
                     New_Located_Assert
                       (Ada_Node => Subexpr,
                        Reason   => VC_Index_Check,
                        Kind     => EW_Assert,
                        Pred     =>
                          New_And_Pred
                            (Left  =>
                               New_Comparison
                                 (Symbol => Why_Eq,
                                  Left   => +Low,
                                  Right  => Low_Bnd),
                             Right =>
                               New_Comparison
                                 (Symbol => Why_Eq,
                                  Left   => +High,
                                  Right  => High_Bnd))));
               end;
            end if;

            --  In regular multidimensional aggregates, we may need to check
            --  choices in upper dimensions.
            --  If we have reached a value which depends on iterated
            --  component associations, we must check the value.

            if (not In_Delta_Aggregate and then Dim /= Nb_Dim)
              or else In_Iterated_Assoc
            then
               while Present (Positional) loop
                  if not In_Delta_Aggregate and then Dim /= Nb_Dim then
                     Insert_Checks (Positional, Dim + 1);
                  else
                     pragma Assert (In_Iterated_Assoc);
                     Append
                       (Comp_Checks,
                        New_Ignore
                          (Ada_Node => Positional,
                           Prog     =>
                             +Transform_Aggregate_Value
                                (Value  => Positional,
                                 Typ    => Comp_Type,
                                 Domain => Domain,
                                 Params => Params)));
                  end if;
                  Next (Positional);
               end loop;
            end if;
         end Insert_Checks;

         --  Start of processing of Insert_Check_For_Choices

      begin
         --  Compute Last_Uniq_Dim.

         if not In_Delta_Aggregate then
            declare
               Subexpr : Node_Id := Expr;
            begin
               loop
                  exit when Last_Uniq_Dim = Nb_Dim;
                  declare
                     Assocs      : constant List_Id :=
                       Component_Associations (Subexpr);
                     Association : constant Node_Id := Nlists.First (Assocs);
                     Exprs       : constant List_Id := Expressions (Subexpr);
                     Num_Assocs  : constant Nat := Nlists.List_Length (Assocs);
                     Num_Exprs   : constant Nat := Nlists.List_Length (Exprs);
                  begin
                     exit when Num_Assocs >= 2;
                     exit when Num_Exprs >= 2;
                     exit when Num_Exprs = Num_Assocs;
                     if Num_Assocs = 0 then
                        pragma Assert (Num_Exprs = 1);
                        Subexpr := Nlists.First (Exprs);
                     else
                        pragma Assert (Num_Assocs = 1);
                        pragma Assert (Num_Exprs = 0);
                        Subexpr := Expression (Association);
                     end if;
                     Last_Uniq_Dim := Last_Uniq_Dim + 1;
                  end;
               end loop;
            end;
         end if;

         --  For regular aggregates, check the scalar ranges of the
         --  aggregate subtype against its Etype. It is not necessary for
         --  delta aggregates where the bounds come from the prefix. In a
         --  similar way, if the aggregate contains an others choice, then the
         --  index type is taken from the context so we do not need to check
         --  it. It is also unnecessary for empty aggregates, as each range
         --  will either be empty, or the computation of predecessor will
         --  wraparound (for modular types only) and the associated range check
         --  from Insert_Checks will fail.

         if not Empty_Aggregate
           and then not In_Delta_Aggregate
           and then
             (Nb_Dim > 1
              or else Is_Empty_List (Component_Associations (Expr))
              or else
                not Is_Others_Choice
                      (Choice_List
                         (Nlists.Last (Component_Associations (Expr)))))
         then
            declare
               Index      : Node_Id := First_Index (Expr_Typ);
               Index_Base : Node_Id := First_Index (Retysp (Etype (Expr_Typ)));
            begin
               while Present (Index) loop
                  Append
                    (Choice_Checks,
                     Check_Scalar_Range
                       (Params => Body_Params,
                        N      => Etype (Index),
                        Base   => Etype (Index_Base)));
                  Next_Index (Index);
                  Next_Index (Index_Base);
               end loop;
            end;
         end if;

         --  Check the actual choice values

         Ada_Ent_To_Why.Push_Scope (Symbol_Table);

         Insert_Checks (Expr, 1);

         Ada_Ent_To_Why.Pop_Scope (Symbol_Table);
         Prepend (+Choice_Checks, +Comp_Checks, T);
      end Insert_Check_For_Choices;

      -------------------------------
      -- Make_Defining_Proposition --
      -------------------------------

      function Make_Defining_Proposition
        (Arr                 : W_Term_Id;
         Elements_From_Nodes : Node_To_Why_Id.Map;
         Bounds              : W_Expr_Array;
         Params              : Transformation_Params;
         Skip_Guards         : Boolean := False) return W_Pred_Id
      is
         Result : W_Pred_Id := True_Pred;
      begin
         --  Assume values of the aggregate's bounds. For delta aggregates,
         --  take the bounds of the array argument, otherwise, bounds are given
         --  as parameters.

         if not Is_Static_Array_Type (Expr_Typ) then
            pragma Assert (In_Delta_Aggregate or Needs_Bounds);

            for Dim in Dimensions loop
               declare
                  Prefix   : constant W_Term_Id :=
                    (if In_Delta_Aggregate
                     then +Elements_From_Nodes.Element (Update_Prefix)
                     else Why_Empty);
                  F_Expr   : constant W_Term_Id :=
                    (if In_Delta_Aggregate
                     then Get_Array_Attr (Prefix, Attribute_First, Dim)
                     else +Bounds (2 * Dim - 1));
                  First_Eq : constant W_Pred_Id :=
                    New_Comparison
                      (Symbol => Why_Eq,
                       Left   => Get_Array_Attr (Arr, Attribute_First, Dim),
                       Right  => F_Expr);
                  L_Expr   : constant W_Term_Id :=
                    (if In_Delta_Aggregate
                     then Get_Array_Attr (Prefix, Attribute_Last, Dim)
                     else +Bounds (2 * Dim));
                  Last_Eq  : constant W_Pred_Id :=
                    New_Comparison
                      (Symbol => Why_Eq,
                       Left   => Get_Array_Attr (Arr, Attribute_Last, Dim),
                       Right  => L_Expr);

               begin
                  --  Add equalities to the axiom's body

                  Result := New_And_Pred ([First_Eq, Last_Eq, Result]);
               end;
            end loop;

            --  If bounds are taken as parameters, we should add a guard to the
            --  axiom for the dynamic property of the array to avoid generating
            --  an unsound axiom if the bounds are not in their type.

            if Needs_Bounds and then not Skip_Guards then
               Result :=
                 New_Conditional
                   (Condition =>
                      +New_Dynamic_Property
                         (EW_Pred, Base_Type (Expr_Typ), Bounds, Params),
                    Then_Part => Result,
                    Typ       => EW_Bool_Type);
            end if;
         end if;

         Result :=
           New_And_Pred
             (Result,
              Transform_Array_Component_Associations
                (Arr,
                 Elements_From_Nodes,
                 Bounds,
                 Params,
                 Skip_Guards => Skip_Guards));

         return Result;
      end Make_Defining_Proposition;

      -------------------------------------
      -- Should_Use_Function_Translation --
      -------------------------------------

      function Should_Use_Function_Translation return Boolean is
         function Contains_Iterated_Association
           (Subaggr : Node_Id; Dim : Dimensions) return Boolean;
         --  Recursive search over subaggregate.

         -----------------------------------
         -- Contains_Iterated_Association --
         -----------------------------------

         function Contains_Iterated_Association
           (Subaggr : Node_Id; Dim : Dimensions) return Boolean
         is

            Positional  : Node_Id :=
              (if In_Delta_Aggregate
               then Types.Empty
               else First (Expressions (Subaggr)));
            Association : Node_Id := First (Component_Associations (Subaggr));
            --  Cursors

         begin
            if Dim /= Nb_Dim and then not In_Delta_Aggregate then
               while Present (Positional) loop
                  if Contains_Iterated_Association (Positional, Dim + 1) then
                     return True;
                  end if;
                  Next (Positional);
               end loop;
            end if;

            while Present (Association) loop
               if Nkind (Association) = N_Iterated_Component_Association
                 or else
                   (Dim /= Nb_Dim
                    and then not In_Delta_Aggregate
                    and then
                      Contains_Iterated_Association
                        (Expression (Association), Dim + 1))
               then
                  return True;
               end if;
               Next (Association);
            end loop;

            return False;
         end Contains_Iterated_Association;

         --  Start of processing for Should_Use_Function_Translation

      begin
         return not Contains_Iterated_Association (Expr, 1);
      end Should_Use_Function_Translation;

      -------------------------------
      -- Transform_Aggregate_Value --
      -------------------------------

      function Transform_Aggregate_Value
        (Value  : Node_Id;
         Typ    : Entity_Id;
         Domain : EW_Domain;
         Params : Transformation_Params) return W_Expr_Id
      is
         Result : W_Expr_Id;

      begin
         --  Value might be an association with a box. In this case, the
         --  component is initialized by default.

         if Nkind (Value)
            in N_Component_Association | N_Iterated_Component_Association
         then
            pragma Assert (Box_Present (Value));
            declare
               Comp_Relaxed : constant Boolean :=
                 (if Relaxed_Init
                  then Has_Init_Wrapper (Comp_Type)
                  else Has_Relaxed_Init (Comp_Type));

            begin
               --  If Expr_Typ has a Default_Component_Value aspect, use its
               --  value.

               if Has_Default_Aspect (Expr_Typ) then
                  Result :=
                    Transform_Expr
                      (Expr          =>
                         Default_Aspect_Component_Value (Expr_Typ),
                       Expected_Type => EW_Abstract (Comp_Type, Comp_Relaxed),
                       Domain        => Domain,
                       Params        => Params);

               --  Otherwise, use the default value of the type

               else
                  Result :=
                    Compute_Default_Value
                      (Value, Comp_Type, Comp_Relaxed, Domain, Params);
               end if;
            end;
         else
            Result :=
              Transform_Expr
                (Value,
                 (if Expr_Has_Relaxed_Init (Value, No_Eval => False)
                  then EW_Abstract (Typ, Relaxed_Init => True)
                  else Type_Of_Node (Typ)),
                 --  If a value which is not a scalar type has relaxed
                 --  initialization, so will the aggregate. Go to the wrapper
                 --  type to avoid spurious initialization checks.

                 Domain,
                 Params);
         end if;

         return Result;
      end Transform_Aggregate_Value;

      --------------------------------------------
      -- Transform_Array_Component_Associations --
      --------------------------------------------

      function Transform_Array_Component_Associations
        (Arr                 : W_Term_Id;
         Elements_From_Nodes : Node_To_Why_Id.Map;
         Bounds              : W_Expr_Array;
         Params              : Transformation_Params;
         Skip_Guards         : Boolean := False) return W_Pred_Id
      is
         Binders : Binder_Array (Dimensions);

         Indexes : W_Expr_Array (Dimensions);
         --  This array contains either the identifiers for indexes in the
         --  normal translation, or the actual values of indexes in the
         --  translation for "simple" aggregates. For example, in the first
         --  case it could be:
         --     (tmp1, tmp2, tmp3)
         --  while in the second case it could be:
         --     (1, 3, 2)
         --  This allows using Constrain_Value_At_Index in both cases to get
         --  the value of the aggregate at the desired indexes.

         -----------------------
         -- Local subprograms --
         -----------------------

         function Constrain_Value_At_Index
           (Subexpr : Node_Id; Indexes : W_Expr_Array) return W_Pred_Id;
         --  Return the proposition that the array Arr at the indices Indexes
         --  is equal to the value given in Subexpr.

         function Lookup_Value (Arg : Node_Id) return W_Term_Id;
         --  Lookup the value associated to Arg in the Args and convert it
         --  to the base type for the index.

         function Select_Nth_Index
           (Dim : Dimensions; Offset : Nat) return W_Term_Id;
         --  Return the value for Index at Offset from Arr'First (Dim)

         function Select_These_Choices
           (Dim : Dimensions; L : List_Id) return W_Pred_Id;
         --  Return a proposition that expresses that Indexes satisfies one
         --  choice in the list of choices L at dimension Dim. In the case of
         --  an aggregate of a delta aggregate, the (possibly dynamic) choices
         --  will be pulled from the arguments to the logic function.

         procedure Transform_Aggregate_Values
           (Simple_Ranges : out W_Pred_Id;
            Simple_Assocs : out W_Pred_Id;
            Other_Assocs  : out W_Pred_Id);
         --  Main recursive function operating over multi-dimensional array
         --  aggregates.

         ------------------------------
         -- Constrain_Value_At_Index --
         ------------------------------

         function Constrain_Value_At_Index
           (Subexpr : Node_Id; Indexes : W_Expr_Array) return W_Pred_Id
         is
            --  Note that Subexpr here can be the updated expression in the
            --  default case of the logic function of a delta aggregate.
            Curs    : constant Node_To_Why_Id.Cursor :=
              Elements_From_Nodes.Find (Subexpr);
            Read    : W_Term_Id;
            Arg_Val : W_Term_Id;
         begin
            --  Whenever possible, take advantage of the why3 construct
            --  for range constants. This improves counterexamples.

            if Nkind (Subexpr)
               not in N_Component_Association
                    | N_Iterated_Component_Association
              and then Is_Range_Type_In_Why (Comp_Type)
              and then Compile_Time_Known_Value (Subexpr)
            then
               return
                 New_Comparison
                   (Symbol => Why_Eq,
                    Left   =>
                      New_Array_Access
                        (Ada_Node => Subexpr, Ar => Arr, Index => Indexes),
                    Right  =>
                      (if Has_Relaxed_Init (Comp_Type) or else Relaxed_Init
                       then
                         Insert_Simple_Conversion
                           (Expr =>
                              New_Range_Constant
                                (Value => Expr_Value (Subexpr),
                                 Typ   => EW_Abstract (Comp_Type)),
                            To   =>
                              EW_Abstract (Comp_Type, Relaxed_Init => True))
                       else
                         New_Range_Constant
                           (Value => Expr_Value (Subexpr),
                            Typ   => EW_Abstract (Comp_Type))));
            end if;

            --  Create array access and comparison

            Read :=
              New_Array_Access
                (Ada_Node => Subexpr, Ar => Arr, Index => Indexes);

            --  We may not have a mapping for Subexpr in Args if Subexpr is
            --  part of an iterated association component. In this case, we
            --  need to translate the expression on the fly.

            if Node_To_Why_Id.Has_Element (Curs) then
               Arg_Val := +Node_To_Why_Id.Element (Curs);
            else
               Arg_Val :=
                 +Transform_Aggregate_Value
                    (Value  => Subexpr,
                     Typ    => Comp_Type,
                     Domain => EW_Term,
                     Params => Params);
            end if;

            --  Array components have the tag of their types

            if Is_Record_Type_In_Why (Comp_Type) then
               Arg_Val :=
                 New_Tag_And_Ext_Update (Name => Arg_Val, Ty => Comp_Type);
            end if;

            --  Special case for the expression of the delta aggregate. In
            --  that case, we want to build the value Prefix(i,j..) with the
            --  default indexes.
            --  We generate:
            --    arr (indexes) = arg_val (indexes)

            if In_Delta_Aggregate and then Subexpr = Update_Prefix then
               declare
                  Prefix_Read : constant W_Term_Id :=
                    New_Array_Access (Ar => Arg_Val, Index => Indexes);
               begin
                  --  In general, the aggregate and its prefix have the same
                  --  Why3 type. This might not be the case when the delta
                  --  aggregate has relaxed initialization and not the prefix.
                  --  Insert a conversion in this case.

                  pragma
                    Assert
                      (Get_Ada_Node (+Get_Type (+Prefix_Read))
                       = Get_Ada_Node (+Get_Type (+Read))
                       and then
                         (if Get_Relaxed_Init (Get_Type (+Prefix_Read))
                          then Get_Relaxed_Init (Get_Type (+Read))));

                  return
                    New_Comparison
                      (Symbol => Why_Eq,
                       Left   => Read,
                       Right  =>
                         Insert_Simple_Conversion
                           (Expr => Prefix_Read, To => Get_Type (+Read)));
               end;

            --  Use the split form of the component type for the
            --  comparison to avoid introducing unnecessary
            --  conversions whenever possible (see Type_Of_Node). For this
            --  to be correct, we need to guard the axiom so that
            --  Arg_Val is always in the appropriate type.
            --  We generate:
            --    is_initialized (arr (indexes)) /\
            --    let tmp = arg_val in
            --      dyn_prop tmp ->
            --      to_base (arr (indexes)) = tmp

            else
               declare
                  Is_Init : W_Pred_Id := True_Pred;
                  Value   : W_Term_Id;
                  Prop    : W_Pred_Id;

               begin
                  Value := New_Temp_For_Expr (Arg_Val);

                  --  If the value has a type which does not have
                  --  relaxed initialization, it must be initialized.

                  if (Has_Relaxed_Init (Comp_Type) or else Relaxed_Init)
                    and then
                      (Has_Scalar_Type (Comp_Type)
                       or else not Is_Init_Wrapper_Type (Get_Type (+Value)))
                  then
                     Is_Init :=
                       +Compute_Is_Initialized
                          (Comp_Type,
                           +Read,
                           Params,
                           EW_Pred,
                           Exclude_Components => Relaxed);
                  end if;

                  Read :=
                    Insert_Simple_Conversion
                      (Expr => Read, To => Get_Type (+Value));

                  Prop :=
                    New_Comparison
                      (Symbol => Why_Eq, Left => Read, Right => Value);

                  if not Skip_Guards then
                     declare
                        Dyn_Prop : constant W_Pred_Id :=
                          Compute_Dynamic_Invariant
                            (Expr => Value, Ty => Comp_Type, Params => Params);
                     begin
                        Prop :=
                          New_Conditional
                            (Condition => Dyn_Prop, Then_Part => Prop);
                     end;
                  end if;

                  return
                    New_And_Pred
                      (Left  =>
                         Binding_For_Temp (Tmp => Value, Context => Prop),
                       Right => Is_Init);
               end;
            end if;
         end Constrain_Value_At_Index;

         ------------------
         -- Lookup_Value --
         ------------------

         function Lookup_Value (Arg : Node_Id) return W_Term_Id is
            Val : constant W_Term_Id := +Elements_From_Nodes.Element (Arg);
         begin
            return
              Insert_Simple_Conversion
                (Expr => Val, To => Base_Why_Type_No_Bool (+Val));
         end Lookup_Value;

         ----------------------
         -- Select_Nth_Index --
         ----------------------

         function Select_Nth_Index
           (Dim : Dimensions; Offset : Nat) return W_Term_Id
         is
            Rng   : constant Node_Id := Get_Range (Index_Types (Dim));
            Typ   : constant W_Type_Id :=
              Base_Why_Type_No_Bool (Index_Types (Dim));
            Low   : constant Node_Id := Low_Bound (Rng);
            First : W_Term_Id;
            Val   : W_Term_Id;

         begin
            if Is_Static_Expression (Low) then
               Val :=
                 New_Discrete_Constant
                   (Value => Expr_Value (Low) + UI_From_Int (Offset),
                    Typ   => Typ);
            else
               First := +Bounds (2 * Dim - 1);

               Val :=
                 +New_Discrete_Add
                    (Domain => Domain,
                     Left   => +First,
                     Right  =>
                       New_Discrete_Constant
                         (Value => UI_From_Int (Offset), Typ => Typ));
            end if;

            return Val;
         end Select_Nth_Index;

         --------------------------
         -- Select_These_Choices --
         --------------------------

         function Select_These_Choices
           (Dim : Dimensions; L : List_Id) return W_Pred_Id
         is
            Result   : W_Pred_Id := False_Pred;
            Choice   : Node_Id := First (L);
            Rng_Expr : W_Pred_Id;
         begin
            while Present (Choice) loop

               --  For delta aggregates, values used in choices are stored in
               --  Args. Retrieve them from here.

               if In_Delta_Aggregate then
                  case Nkind (Choice) is
                     when N_Range | N_Subtype_Indication =>
                        declare
                           Low  : constant Node_Id :=
                             Low_Bound (Get_Range (Choice));
                           High : constant Node_Id :=
                             High_Bound (Get_Range (Choice));
                        begin
                           Rng_Expr :=
                             New_Range_Expr
                               (Low  => Lookup_Value (Low),
                                High => Lookup_Value (High),
                                Expr => +Indexes (Integer (Dim)));
                        end;

                     when N_Aggregate                    =>
                        pragma Assert (Nb_Dim /= 1 and then Dim = 1);

                        --  This is a choice of a multidimensional 'Update,
                        --  for example (I, J, K) of
                        --  'Update((I, J, K) => New_Val).
                        --  Create a conjunction of comparisons, one for
                        --  each dimension.

                        declare
                           Conjunct     : W_Pred_Id := True_Pred;
                           Multi_Assocs : constant List_Id :=
                             Component_Associations (Choice);
                           Multi_Expr   : Node_Id :=
                             Nlists.First (Expressions (Choice));
                        begin
                           pragma Assert (No (Multi_Assocs));

                           for Current_Dim in Dimensions loop
                              Rng_Expr :=
                                New_Comparison
                                  (Symbol => Why_Eq,
                                   Left   => +Indexes (Current_Dim),
                                   Right  => Lookup_Value (Multi_Expr));
                              Conjunct :=
                                New_And_Pred
                                  (Left => Conjunct, Right => Rng_Expr);
                              Next (Multi_Expr);
                           end loop;
                           pragma Assert (No (Multi_Expr));

                           Rng_Expr := Conjunct;
                        end;

                     when others                         =>
                        if Is_Entity_Name (Choice)
                          and then Is_Type (Entity (Choice))
                        then
                           declare
                              Rng : constant Node_Id :=
                                Get_Range (Entity (Choice));
                           begin
                              Rng_Expr :=
                                New_Range_Expr
                                  (Low  => Lookup_Value (Low_Bound (Rng)),
                                   High => Lookup_Value (High_Bound (Rng)),
                                   Expr => +Indexes (Integer (Dim)));
                           end;
                        else
                           Rng_Expr :=
                             New_Comparison
                               (Symbol => Why_Eq,
                                Left   => +Indexes (Integer (Dim)),
                                Right  => Lookup_Value (Choice));
                        end if;
                  end case;

               --  The choices are not arguments, proceed with standard
               --  transformation of discrete choice.

               else
                  Rng_Expr :=
                    +Transform_Discrete_Choice
                       (Choice      => Choice,
                        Choice_Type => Empty,
                        Expr        => Indexes (Integer (Dim)),
                        Domain      => EW_Pred,
                        Params      => Params);
               end if;

               Result := New_Or_Pred (Left => Result, Right => Rng_Expr);
               Next (Choice);
            end loop;

            return Result;
         end Select_These_Choices;

         --------------------------------
         -- Transform_Aggregate_Values --
         --------------------------------

         procedure Transform_Aggregate_Values
           (Simple_Ranges : out W_Pred_Id;
            Simple_Assocs : out W_Pred_Id;
            Other_Assocs  : out W_Pred_Id)
         is
            function Transform_Complex_Association
              (Dim : Dimensions; Expr_Or_Assoc : Node_Id) return W_Pred_Id;
            --  Either constrains the value at Aggr (Indexes) with the value
            --  Expr_Or_Assoc if we have reached the last dimension, or call
            --  Transform_Rec_Complex_Aggregate recursively.
            --  Also stores indexes of iterated component association in the
            --  symbol map when necessary.

            procedure Transform_Rec_Aggregate
              (Dim : Dimensions; Subexpr : Node_Id; Pre : W_Pred_Id)
            with Pre => (Dim = 1) = (Pre = True_Pred);
            --  Stores in V_Simple_Assocs the association corresponding to a
            --  single value of each index and in V_Other_Assocs the other
            --  associations. V_Other_Assocs links values of Aggr (Indexes)
            --  while V_Simple_Assocs gives the value of each association
            --  directly.
            --  Pre is the guard expressing that all indexes up to Dim have
            --  the values of Values.

            function Transform_Rec_Complex_Aggregate
              (Dim : Dimensions; Subexpr : Node_Id) return W_Pred_Id;
            --  Generate a predicate giving the definition of Aggr (Indexes)
            --  for values in Expr.

            Values          : W_Expr_Array (Dimensions);
            --  Array in which the specific value of each simple index is
            --  stored.
            use all type W_Pred_Vectors.Vector;
            V_Simple_Ranges : W_Pred_Vectors.Vector;
            V_Simple_Assocs : W_Pred_Vectors.Vector;
            V_Other_Assocs  : W_Pred_Vectors.Vector;

            -----------------------------------
            -- Transform_Complex_Association --
            -----------------------------------

            function Transform_Complex_Association
              (Dim : Dimensions; Expr_Or_Assoc : Node_Id) return W_Pred_Id
            is
               Expr    : constant Node_Id :=
                 (if Nkind (Expr_Or_Assoc)
                     in N_Iterated_Component_Association
                      | N_Component_Association
                    and then not Box_Present (Expr_Or_Assoc)
                  then Expression (Expr_Or_Assoc)
                  else Expr_Or_Assoc);
               Actions : constant List_Id :=
                 (if Nkind (Expr_Or_Assoc) in N_Iterated_Component_Association
                  then Loop_Actions (Expr_Or_Assoc)
                  else No_List);
               --  Actions associated with iterated component associations
               Result  : W_Pred_Id;

            begin
               --  For iterated component associations, we need to introduce
               --  quantified variable in the symbol table. We map it to the
               --  current index variable.

               if Nkind (Expr_Or_Assoc) = N_Iterated_Component_Association then
                  Insert_Tmp_Item_For_Entity
                    (Defining_Identifier (Expr_Or_Assoc), +Indexes (Dim));
               end if;

               if Present (Actions) then
                  Ada_Ent_To_Why.Push_Scope (Symbol_Table);
                  Transform_Actions_Preparation (Actions);
               end if;

               if Dim /= Nb_Dim and then not In_Delta_Aggregate then
                  Result := Transform_Rec_Complex_Aggregate (Dim + 1, Expr);
               else
                  Result := Constrain_Value_At_Index (Expr, Indexes);
               end if;

               if Present (Actions) then
                  Result :=
                    +Transform_Actions
                       (Actions => Actions,
                        Expr    => +Result,
                        Domain  => EW_Pred,
                        Params  => Params);
                  Ada_Ent_To_Why.Pop_Scope (Symbol_Table);
               end if;

               return Result;
            end Transform_Complex_Association;

            -----------------------------
            -- Transform_Rec_Aggregate --
            -----------------------------

            procedure Transform_Rec_Aggregate
              (Dim : Dimensions; Subexpr : Node_Id; Pre : W_Pred_Id)
            is
               Positionals : constant List_Id :=
                 (if In_Delta_Aggregate
                  then Empty_List
                  else Expressions (Subexpr));
               Assocs      : constant List_Id :=
                 Component_Associations (Subexpr);
               Assocs_Len  : constant Natural :=
                 Integer (List_Length (Assocs));
               Association : Node_Id;
               Positional  : Node_Id;
               Condition   : W_Pred_Vectors.Vector;

            begin
               Positional := Nlists.First (Positionals);
               Association := Nlists.First (Assocs);

               --  On a positional aggregate, all associations are simple.
               --  Store the nth index in Values and either constrain the
               --  value of Aggr or continue the recursion.

               if Present (Positional) then
                  for Offset in 1 .. List_Length (Positionals) loop
                     declare
                        Value : constant W_Term_Id :=
                          Select_Nth_Index (Dim, Offset - 1);
                        Cond  : constant W_Pred_Id :=
                          New_Comparison
                            (Symbol => Why_Eq,
                             Left   => +Indexes (Dim),
                             Right  => Value);

                     begin
                        Values (Dim) := +Value;
                        Append
                          (V => Condition, Pred => New_Not (Right => Cond));

                        Append
                          (V    => V_Simple_Ranges,
                           Pred =>
                             New_Range_Expr
                               (Low  =>
                                  Get_Array_Attr (Arr, Attribute_First, Dim),
                                High =>
                                  Get_Array_Attr (Arr, Attribute_Last, Dim),
                                Expr => Value));

                        if Dim = Nb_Dim then
                           Append
                             (V    => V_Simple_Assocs,
                              Pred =>
                                Constrain_Value_At_Index (Positional, Values));
                        else
                           Transform_Rec_Aggregate
                             (Dim     => Dim + 1,
                              Subexpr => Positional,
                              Pre     => New_And_Pred (Pre, Cond));
                        end if;
                     end;
                     Next (Positional);
                  end loop;

               elsif Present (Association) then

                  --  Go over the choices which are not the others choice.
                  --  Note that a single choice is handled as an others choice.
                  --  Along the way, store in Condition, the condition for the
                  --  others or default choice.

                  if In_Delta_Aggregate or else Assocs_Len > 1 then
                     loop
                        declare
                           Cond : constant W_Pred_Id :=
                             Select_These_Choices
                               (Dim, Choice_List (Association));

                        begin
                           Append
                             (V => Condition, Pred => New_Not (Right => Cond));

                           --  An association is simple if there is only one
                           --  choice, and it is neither a range nor an
                           --  iterated component association.

                           if Nkind (Association)
                             /= N_Iterated_Component_Association
                             and then
                               List_Length (Choice_List (Association)) = 1
                             and then
                               not Discrete_Choice_Is_Range
                                     (First (Choice_List (Association)))
                           then

                              --  The choice is simple, store the value in
                              --  Values and continue the recursion.

                              declare
                                 Choice : constant Node_Id :=
                                   First (Choice_List (Association));
                              begin
                                 Values (Integer (Dim)) :=
                                   (if In_Delta_Aggregate
                                    then +Lookup_Value (Choice)
                                    else
                                      Transform_Expr
                                        (Expr          => Choice,
                                         Expected_Type =>
                                           Base_Why_Type_No_Bool
                                             (Etype (Choice)),
                                         Domain        => EW_Term,
                                         Params        => Params));
                              end;

                              Append
                                (V    => V_Simple_Ranges,
                                 Pred =>
                                   New_Range_Expr
                                     (Low  =>
                                        Get_Array_Attr
                                          (Arr, Attribute_First, Dim),
                                      High =>
                                        Get_Array_Attr
                                          (Arr, Attribute_Last, Dim),
                                      Expr => +Values (Integer (Dim))));

                              if Dim = Nb_Dim then
                                 Append
                                   (V    => V_Simple_Assocs,
                                    Pred =>
                                      Constrain_Value_At_Index
                                        ((if Box_Present (Association)
                                          then Association
                                          else Expression (Association)),
                                         Values));
                              else
                                 Transform_Rec_Aggregate
                                   (Dim     => Dim + 1,
                                    Subexpr => Expression (Association),
                                    Pre     => New_And_Pred (Pre, Cond));
                              end if;

                           --  The choice is not simple, we resort to the
                           --  translation involving a quantifier. We store it
                           --  in Other_Assocs.

                           else
                              Append
                                (V    => V_Other_Assocs,
                                 Pred =>
                                   New_Conditional
                                     (Condition => New_And_Pred (Pre, Cond),
                                      Then_Part =>
                                        Transform_Complex_Association
                                          (Dim, Association)));
                           end if;
                           Next (Association);

                           --  Exit the loop when we have reached the end of
                           --  the associations or the others choice.

                           exit when
                             No (Association)
                             or else
                               (not In_Delta_Aggregate
                                and then
                                  List_Length (Choice_List (Association)) = 1
                                and then
                                  Nkind (First (Choice_List (Association)))
                                  = N_Others_Choice);
                        end;
                     end loop;
                  end if;
               end if;

               --  For delta aggregates, the prefix is used for the default
               --  value in the logic function.

               if In_Delta_Aggregate then
                  Append
                    (V    => V_Other_Assocs,
                     Pred =>
                       New_Conditional
                         (Condition =>
                            New_And_Pred (Pre & To_Array (Condition)),
                          Then_Part =>
                            Constrain_Value_At_Index
                              (Update_Prefix, Indexes)));

               --  Special case for "others" choice, which must appear alone as
               --  last association and for aggregates with only one
               --  association, as their choice might not be static.

               elsif Present (Association) then
                  pragma Assert (No (Next (Association)));

                  Append
                    (V    => V_Other_Assocs,
                     Pred =>
                       New_Conditional
                         (Condition =>
                            New_And_Pred (Pre & To_Array (Condition)),
                          Then_Part =>
                            Transform_Complex_Association (Dim, Association)));
               end if;
            end Transform_Rec_Aggregate;

            -------------------------------------
            -- Transform_Rec_Complex_Aggregate --
            -------------------------------------

            function Transform_Rec_Complex_Aggregate
              (Dim : Dimensions; Subexpr : Node_Id) return W_Pred_Id
            is
               Positionals : constant List_Id :=
                 (if In_Delta_Aggregate
                  then Empty_List
                  else Expressions (Subexpr));
               Assocs      : constant List_Id :=
                 Component_Associations (Subexpr);
               Association : Node_Id :=
                 (if Is_Empty_List (Assocs)
                  then Empty
                  else Nlists.Last (Assocs));
               Positional  : Node_Id := Nlists.First (Positionals);
               Assocs_Len  : constant Natural :=
                 Integer (List_Length (Assocs));
               Has_Others  : constant Boolean :=
                 not In_Delta_Aggregate
                 and then Present (Association)
                 and then List_Length (Choice_List (Association)) = 1
                 and then
                   Nkind (First (Choice_List (Association))) = N_Others_Choice;
               Else_Part   : constant W_Pred_Id :=
                 (if In_Delta_Aggregate
                  then Constrain_Value_At_Index (Update_Prefix, Indexes)
                  elsif Has_Others
                    and then (Assocs_Len > 1 or else Present (Positional))
                  then Transform_Complex_Association (Dim, Association)
                  else True_Pred);

            begin
               --  We go over the expressions/associations and generate:
               --
               --  if <Choice1> then Aggr (Indexes) = <Expr1>
               --  elsif <Choice2> then ...
               --  else Aggr (Indexes) = <Expr_Others>
               --      or Update_Prefix (Indexes) in case of delta aggregates
               --
               --  Associations are taken in the reverse order to accomodate
               --  the semantics of delta aggregates.

               if Present (Positional) then
                  pragma
                    Assert
                      (No (Association)
                       or else (Assocs_Len = 1 and then Has_Others));

                  declare
                     Then_Part   : constant W_Pred_Id :=
                       Transform_Complex_Association (Dim, Positional);
                     Elsif_Parts :
                       W_Pred_Array
                         (1 .. Integer (List_Length (Positionals)) - 1);
                  begin
                     Next (Positional);

                     for Offset in 1 .. List_Length (Positionals) - 1 loop
                        pragma Assert (Present (Positional));
                        Elsif_Parts (Integer (Offset)) :=
                          New_Elsif
                            (Condition =>
                               +New_Comparison
                                  (Symbol => Why_Eq,
                                   Left   => +Indexes (Integer (Dim)),
                                   Right  => +Select_Nth_Index (Dim, Offset),
                                   Domain => EW_Pred),
                             Then_Part =>
                               +Transform_Complex_Association
                                  (Dim, Positional));
                        Next (Positional);
                     end loop;

                     pragma Assert (No (Positional));
                     return
                       New_Conditional
                         (Condition   =>
                            New_Comparison
                              (Symbol => Why_Eq,
                               Left   => +Indexes (Integer (Dim)),
                               Right  => Select_Nth_Index (Dim, 0)),
                          Then_Part   => Then_Part,
                          Elsif_Parts => Elsif_Parts,
                          Else_Part   => Else_Part);
                  end;

               elsif Present (Association) then
                  declare
                     Cond        : W_Pred_Id;
                     Then_Part   : W_Pred_Id;
                     Elsif_Parts :
                       W_Pred_Array
                         (1 .. Assocs_Len - (if Has_Others then 2 else 1));

                  begin
                     --  If there is an "others" choice, skip it

                     if Assocs_Len > 1 and then Has_Others then
                        Prev (Association);
                     end if;

                     --  Store the last not "others" choice in Then_Part. We
                     --  only store the condition in Cond if there is more than
                     --  1 choice.

                     Cond :=
                       (if Assocs_Len = 1 and then not In_Delta_Aggregate
                        then True_Pred
                        else
                          Select_These_Choices
                            (Dim, Choice_List (Association)));

                     Then_Part :=
                       Transform_Complex_Association (Dim, Association);
                     Prev (Association);

                     --  Go over the remaining associations in reverse order

                     for Count in Elsif_Parts'Range loop
                        pragma Assert (Present (Association));

                        Elsif_Parts (Count) :=
                          +New_Elsif
                             (Condition =>
                                Select_These_Choices
                                  (Dim, Choice_List (Association)),
                              Then_Part =>
                                Transform_Complex_Association
                                  (Dim, Association));

                        Prev (Association);
                     end loop;

                     pragma Assert (No (Association));

                     if Assocs_Len = 1 and then not In_Delta_Aggregate then
                        return Then_Part;
                     else
                        return
                          New_Conditional
                            (Condition   => Cond,
                             Then_Part   => Then_Part,
                             Elsif_Parts => Elsif_Parts,
                             Else_Part   => Else_Part);
                     end if;
                  end;

               --  Subexpr is the empty string or a null aggregate

               else
                  return True_Pred;
               end if;
            end Transform_Rec_Complex_Aggregate;

            --  Start of processing for Transform_Aggregate_Values

         begin
            --  Use a new scope for indexes of iterated component associations

            Ada_Ent_To_Why.Push_Scope (Symbol_Table);

            --  For now, do not try to optimize the translation of delta
            --  aggregate as the order of values is relevant.

            if In_Delta_Aggregate then
               Simple_Ranges := True_Pred;
               Simple_Assocs := True_Pred;
               Other_Assocs := Transform_Rec_Complex_Aggregate (1, Expr);
            else
               Transform_Rec_Aggregate (1, Expr, True_Pred);
               Simple_Ranges := New_And_Pred (To_Array (V_Simple_Ranges));
               Simple_Assocs := New_And_Pred (To_Array (V_Simple_Assocs));
               Other_Assocs := New_And_Pred (To_Array (V_Other_Assocs));
            end if;

            Ada_Ent_To_Why.Pop_Scope (Symbol_Table);
         end Transform_Aggregate_Values;

         --  Start of processing for Transform_Array_Component_Associations

      begin
         --  Define index variables

         for Dim in Dimensions loop
            Binders (Dim) :=
              (B_Name =>
                 New_Temp_Identifier
                   (Typ => Base_Why_Type_No_Bool (Index_Types (Dim))),
               B_Ent  => Null_Entity_Name,
               others => <>);
            Indexes (Dim) := +Binders (Dim).B_Name;
         end loop;

         --  Create the proposition defining the aggregate

         declare
            Simple_Ranges : W_Pred_Id;
            Simple_Assocs : W_Pred_Id;
            Other_Assocs  : W_Pred_Id;
         begin
            Transform_Aggregate_Values
              (Simple_Ranges => Simple_Ranges,
               Simple_Assocs => Simple_Assocs,
               Other_Assocs  => Other_Assocs);

            --  Add the well_formed predicate. It is only valid if all simple
            --  associations are in range. For complex associations, the range
            --  is enforced on the quantification.

            if Skip_Guards then
               Simple_Assocs :=
                 New_And_Pred
                   (Left  => Simple_Assocs,
                    Right => New_Well_Formed_Pred (Arr));
            else
               Simple_Assocs :=
                 New_And_Pred
                   (Left  => Simple_Assocs,
                    Right =>
                      New_Conditional
                        (Condition => Simple_Ranges,
                         Then_Part => New_Well_Formed_Pred (Arr)));
            end if;

            if Is_True_Boolean (+Other_Assocs) then
               return Simple_Assocs;
            else
               declare
                  Range_Preds : W_Pred_Array (1 .. Nb_Dim);

               begin
                  for Dim in Range_Preds'Range loop
                     Range_Preds (Dim) :=
                       New_Range_Expr
                         (Low  => Get_Array_Attr (Arr, Attribute_First, Dim),
                          High => Get_Array_Attr (Arr, Attribute_Last, Dim),
                          Expr => +Indexes (Dim));
                  end loop;

                  Other_Assocs :=
                    New_Universal_Quantif
                      (Binders  => Binders,
                       Triggers =>
                         New_Triggers
                           (Triggers =>
                              (1 =>
                                 New_Trigger
                                   (Terms =>
                                      (1 =>
                                         +New_Array_Access
                                            (Ar => Arr, Index => Indexes))))),
                       Pred     =>
                         New_Conditional
                           (Condition => New_And_Pred (Range_Preds),
                            Then_Part => Other_Assocs));
               end;

               return
                 New_And_Pred (Left => Simple_Assocs, Right => Other_Assocs);
            end if;
         end;
      end Transform_Array_Component_Associations;

      --  Start of processing for Transform_Array_Aggregate

   begin
      --  Initialize the array of index types.

      declare
         Index : Node_Id := First_Index (Expr_Typ);
      begin
         for Dim in Dimensions loop
            Index_Types (Dim) := Etype (Index);
            Next_Index (Index);
         end loop;
         pragma Assert (No (Index));
      end;

      declare
         Values              : Aggregate_Element_Lists.Vector;
         Variables           : Flow_Id_Sets.Set;
         Elements_From_Nodes : Node_To_Why_Id.Map;
         Bounds              : W_Expr_Array (1 .. Bound_Count);
         Func                : W_Identifier_Id := Why_Empty;
      begin
         --  Get the aggregate elements that should be passed in parameter

         Get_Aggregate_Elements
           (Values, Variables, Elements_From_Nodes, Bounds);

         --  If using function-based translation and not done already, generate
         --  the logic function.

         if Should_Use_Function_Translation then

            declare
               M : W_Module_Id := E_Module (Expr);
            begin
               if M = Why_Empty then
                  Generate_Aggregate_Functions
                    (Values, Variables, Elements_From_Nodes, Bounds);
                  M := E_Module (Expr);
               end if;

               --  For program terms, use the program function declared in the
               --  axiom module. It has an instance of the defining axiom as a
               --  post.

               Func :=
                 New_Identifier
                   (Ada_Node => Expr,
                    Domain   => Domain,
                    Module   =>
                      (if Domain in EW_Term | EW_Pred
                       then M
                       else E_Module (Expr, Program_Function_Decl)),
                    Symb     => NID (Lower_Case_First (Img (Get_Name (M)))));
            end;
         end if;
         return
           Complete_Translation
             (Func, Values, Variables, Elements_From_Nodes, Bounds);
      end;
   end Transform_Array_Aggregate;

   --------------------------------
   -- Transform_Array_Comparison --
   --------------------------------

   function Transform_Array_Comparison
     (Op       : N_Op_Compare;
      Left     : W_Expr_Id;
      Right    : W_Expr_Id;
      Domain   : EW_Domain;
      Ada_Node : Node_Id) return W_Expr_Id
   is
      Subdomain : constant EW_Domain :=
        (if Domain = EW_Pred then EW_Term else Domain);
      Args      : W_Expr_Array (1 .. 6);
      T         : W_Expr_Id;

      --  Check that operands are initialized

      Left_Type  : constant Entity_Id := Etype (Left_Opnd (Ada_Node));
      Left_Expr  : constant W_Expr_Id :=
        New_Temp_For_Expr
          (Insert_Initialization_Check
             (Left_Opnd (Ada_Node),
              Left_Type,
              Left,
              Domain,
              Exclude_Components => None));
      Right_Expr : constant W_Expr_Id :=
        New_Temp_For_Expr
          (Insert_Initialization_Check
             (Right_Opnd (Ada_Node),
              Etype (Right_Opnd (Ada_Node)),
              Right,
              Domain,
              Exclude_Components => None));
      Arg_Ind    : Positive := 1;
   begin
      Add_Array_Arg (Subdomain, Args, Left_Expr, Arg_Ind);
      Add_Array_Arg (Subdomain, Args, Right_Expr, Arg_Ind);

      --  Add conversions from wrapper types if needed. Initialization checks
      --  are inserted earlier.

      if Is_Init_Wrapper_Type (Get_Type (Left_Expr)) then
         Args (1) :=
           New_Call
             (Ada_Node => Ada_Node,
              Domain   => Subdomain,
              Name     => Get_Array_Of_Wrapper_Name (Left_Type),
              Args     => (1 => Args (1)),
              Typ      => EW_Split (Left_Type));
      end if;
      if Is_Init_Wrapper_Type (Get_Type (Right_Expr)) then
         Args (4) :=
           New_Call
             (Ada_Node => Ada_Node,
              Domain   => Subdomain,
              Name     => Get_Array_Of_Wrapper_Name (Left_Type),
              Args     => (1 => Args (4)),
              Typ      => EW_Split (Left_Type));
      end if;

      T :=
        New_Call
          (Ada_Node => Ada_Node,
           Domain   => Subdomain,
           Name     => Get_Array_Theory_1_Comp (Left_Type).Compare,
           Args     => Args,
           Typ      => EW_Int_Type);
      T := Binding_For_Temp (Domain => Domain, Tmp => Left_Expr, Context => T);
      T :=
        Binding_For_Temp (Domain => Domain, Tmp => Right_Expr, Context => T);
      T :=
        New_Comparison
          (Symbol => Transform_Compare_Op (Op, EW_Int_Type, Domain),
           Left   => T,
           Right  => New_Integer_Constant (Value => Uint_0),
           Domain => Domain);
      return T;
   end Transform_Array_Comparison;

   ------------------------------
   -- Transform_Array_Equality --
   ------------------------------

   function Transform_Array_Equality
     (Op        : N_Op_Compare;
      Left      : W_Expr_Id;
      Right     : W_Expr_Id;
      Left_Type : Type_Kind_Id;
      Domain    : EW_Domain;
      Ada_Node  : Node_Id) return W_Expr_Id
   is
      Dim        : constant Positive :=
        Positive (Number_Dimensions (Retysp (Left_Type)));
      Subdomain  : constant EW_Domain :=
        (if Domain = EW_Pred then EW_Term else Domain);
      Args       : W_Expr_Array (1 .. 4 * Dim + 2);
      T          : W_Expr_Id;
      Left_Expr  : W_Expr_Id;
      Right_Expr : W_Expr_Id;
      Arg_Ind    : Positive := 1;
   begin

      --  Check that operands are initialized

      Left_Expr :=
        Insert_Initialization_Check
          (Left_Opnd (Ada_Node),
           Left_Type,
           Left,
           Domain,
           Exclude_Components => For_Eq);
      Right_Expr :=
        Insert_Initialization_Check
          (Right_Opnd (Ada_Node),
           Etype (Right_Opnd (Ada_Node)),
           Right,
           Domain,
           Exclude_Components => For_Eq);

      --  Potentially check invariants if subcomponents of the array type have
      --  a user-defined equality.

      Left_Expr :=
        Insert_Invariant_Check_For_Eq
          (Left_Opnd (Ada_Node), Left_Type, Left_Expr, Domain);
      Right_Expr :=
        Insert_Invariant_Check_For_Eq
          (Right_Opnd (Ada_Node),
           Etype (Right_Opnd (Ada_Node)),
           Right_Expr,
           Domain);

      Left_Expr := New_Temp_For_Expr (Left_Expr);
      Right_Expr := New_Temp_For_Expr (Right_Expr);

      Add_Array_Arg (Subdomain, Args, Left_Expr, Arg_Ind);
      Add_Array_Arg (Subdomain, Args, Right_Expr, Arg_Ind);

      --  Add conversions from wrapper types if needed. Initialization checks
      --  are inserted earlier.

      if Is_Init_Wrapper_Type (Get_Type (Left_Expr)) then
         Args (1) :=
           New_Call
             (Ada_Node => Ada_Node,
              Domain   => Subdomain,
              Name     => Get_Array_Of_Wrapper_Name (Left_Type),
              Args     => (1 => Args (1)),
              Typ      => EW_Split (Left_Type));
      end if;
      if Is_Init_Wrapper_Type (Get_Type (Right_Expr)) then
         Args (2 + 2 * Dim) :=
           New_Call
             (Ada_Node => Ada_Node,
              Domain   => Subdomain,
              Name     => Get_Array_Of_Wrapper_Name (Left_Type),
              Args     => (1 => Args (2 + 2 * Dim)),
              Typ      => EW_Split (Left_Type));
      end if;

      T :=
        New_Call
          (Ada_Node => Ada_Node,
           Domain   => Subdomain,
           Name     => Get_Array_Theory (Etype (Left_Opnd (Ada_Node))).Bool_Eq,
           Args     => Args,
           Typ      => EW_Bool_Type);
      T := Binding_For_Temp (Domain => Domain, Tmp => Left_Expr, Context => T);
      T :=
        Binding_For_Temp (Domain => Domain, Tmp => Right_Expr, Context => T);
      if Domain = EW_Pred then
         T :=
           New_Comparison
             (Symbol => Transform_Compare_Op (Op, EW_Bool_Type, Domain),
              Left   => T,
              Right  => New_Literal (Domain => Subdomain, Value => EW_True),
              Domain => Domain);
      elsif Op = N_Op_Ne then
         pragma
           Annotate (Xcov, Exempt_On, "A /= B is expanded into not (A = B)");
         T :=
           New_Call
             (Domain => Domain,
              Name   => M_Boolean.Notb,
              Args   => (1 => T),
              Typ    => EW_Bool_Type);
         pragma Annotate (Xcov, Exempt_Off);
      end if;
      return T;
   end Transform_Array_Equality;

   --------------------------------
   -- Transform_Array_Logical_Op --
   --------------------------------

   function Transform_Array_Logical_Op
     (Op        : N_Binary_Op;
      Left      : W_Expr_Id;
      Right     : W_Expr_Id;
      Left_Type : Type_Kind_Id;
      Domain    : EW_Domain;
      Ada_Node  : Node_Id;
      Do_Check  : Boolean) return W_Expr_Id
   is
      Subdomain : constant EW_Domain :=
        (if Domain = EW_Pred then EW_Term else Domain);
      Args      : W_Expr_Array (1 .. 6);
      T         : W_Expr_Id;
      Arg_Ind   : Positive := 1;

      --  Insert initialization checks for operands

      Left_Expr    : constant W_Term_Id :=
        New_Temp_For_Expr
          (Insert_Initialization_Check
             (Left_Opnd (Ada_Node),
              Left_Type,
              Left,
              Domain,
              Exclude_Components => None));
      Right_Expr   : constant W_Term_Id :=
        New_Temp_For_Expr
          (Insert_Initialization_Check
             (Right_Opnd (Ada_Node),
              Etype (Right_Opnd (Ada_Node)),
              Right,
              Domain,
              Exclude_Components => None));
      Array_Theory : constant M_Array_1_Bool_Op_Type :=
        Get_Array_Theory_1_Bool_Op (Etype (Left_Opnd (Ada_Node)));
      W_Op         : constant W_Identifier_Id :=
        (case Op is
           when N_Op_And => Array_Theory.Andb,
           when N_Op_Or  => Array_Theory.Orb,
           when N_Op_Xor => Array_Theory.Xorb,
           when others   => raise Program_Error);

      Left_Length  : constant W_Expr_Id :=
        Build_Length_Expr (Domain => EW_Term, Expr => +Left_Expr, Dim => 1);
      Length_Check : constant W_Expr_Id :=
        +New_Length_Equality
           (Left_Arr => Left_Expr, Right_Arr => Right_Expr, Dim => 1);

      Index_Type : constant W_Type_Id :=
        (if First_Index (Retysp (Left_Type)) = Empty
         then EW_Int_Type
         else Base_Why_Type_No_Bool (First_Index (Retysp (Left_Type))));

      --  if Length (Left) > 0 then not (Left'First = Left'Last and
      --                                 Left'Last  = 1);
      Range_Check : constant W_Expr_Id :=
        New_Conditional
          (Domain    => EW_Pred,
           Condition =>
             New_Call
               (Domain => EW_Pred,
                Typ    => EW_Bool_Type,
                Name   => Int_Infix_Gt,
                Args   =>
                  (+Left_Length, New_Integer_Constant (Value => Uint_0))),
           Then_Part =>
             New_Not
               (Domain => EW_Pred,
                Right  =>
                  New_And_Expr
                    (Left   =>
                       New_Call
                         (Domain => EW_Pred,
                          Typ    => EW_Bool_Type,
                          Name   => Why_Eq,
                          Args   =>
                            (1 =>
                               +E_Symb
                                  (Component_Type (Retysp (Left_Type)),
                                   WNE_Attr_First),
                             2 =>
                               +E_Symb
                                  (Component_Type (Retysp (Left_Type)),
                                   WNE_Attr_Last))),
                     Right  =>
                       New_Call
                         (Domain => EW_Pred,
                          Name   => Why_Eq,
                          Typ    => EW_Bool_Type,
                          Args   =>
                            (1 =>
                               New_Discrete_Constant
                                 (Value => Uint_1, Typ => Index_Type),
                             2 =>
                               +E_Symb
                                  (Component_Type (Retysp (Left_Type)),
                                   WNE_Attr_Last))),
                     Domain => EW_Pred)));
   begin
      Add_Array_Arg (Subdomain, Args, +Left_Expr, Arg_Ind);
      Add_Array_Arg (Subdomain, Args, +Right_Expr, Arg_Ind);

      --  Add conversions from wrapper types if needed. Initialization checks
      --  are inserted earlier.

      if Is_Init_Wrapper_Type (Get_Type (+Left_Expr)) then
         Args (1) :=
           New_Call
             (Ada_Node => Ada_Node,
              Domain   => Subdomain,
              Name     => Get_Array_Of_Wrapper_Name (Left_Type),
              Args     => (1 => Args (1)),
              Typ      => EW_Split (Left_Type));
      end if;
      if Is_Init_Wrapper_Type (Get_Type (+Right_Expr)) then
         Args (4) :=
           New_Call
             (Ada_Node => Ada_Node,
              Domain   => Subdomain,
              Name     => Get_Array_Of_Wrapper_Name (Left_Type),
              Args     => (1 => Args (4)),
              Typ      => EW_Split (Left_Type));
      end if;

      --  Call to operator

      T :=
        New_Call
          (Ada_Node => Ada_Node,
           Domain   => Subdomain,
           Name     => W_Op,
           Args     => Args,
           Typ      => Type_Of_Node (Left_Type));

      if Do_Check then

         --  Length check, Left and Right should have the same length

         Prepend
           (New_Ignore
              (Prog =>
                 New_Located_Assert
                   (Ada_Node, +Length_Check, VC_Length_Check, EW_Assert)),
            T);

         --  Range check : for all I, Left (I) Op Right (I) should be in range.
         --  The only way to generate an element not in range using a binary
         --  operator is to call xor on arrays of the singleton subtype True of
         --  boolean.

         if not Is_Standard_Boolean_Type (Component_Type (Retysp (Left_Type)))
           and then W_Op = Array_Theory.Xorb
         then
            Prepend
              (New_Ignore
                 (Prog =>
                    New_Located_Assert
                      (Ada_Node, +Range_Check, VC_Range_Check, EW_Assert)),
               T);
         end if;
      end if;

      --  Conversion from base, first and right are attributes of left

      if not Has_Static_Array_Type (Left_Type) then
         T :=
           Array_Convert_From_Base
             (Domain => Subdomain,
              Ty     => Left_Type,
              Ar     => T,
              First  =>
                +Get_Array_Attr
                   (Expr => Left_Expr, Attr => Attribute_First, Dim => 1),
              Last   =>
                +Get_Array_Attr
                   (Expr => Left_Expr, Attr => Attribute_Last, Dim => 1));
      end if;

      T :=
        Binding_For_Temp (Domain => Domain, Tmp => +Left_Expr, Context => T);
      T :=
        Binding_For_Temp (Domain => Domain, Tmp => +Right_Expr, Context => T);
      return T;
   end Transform_Array_Logical_Op;

   ------------------------------
   -- Transform_Array_Negation --
   ------------------------------

   function Transform_Array_Negation
     (Right      : W_Expr_Id;
      Right_Type : Type_Kind_Id;
      Domain     : EW_Domain;
      Ada_Node   : Node_Id;
      Do_Check   : Boolean) return W_Expr_Id
   is
      Subdomain : constant EW_Domain :=
        (if Domain = EW_Pred then EW_Term else Domain);
      Args      : W_Expr_Array (1 .. 3);
      T         : W_Expr_Id;
      Arg_Ind   : Positive := 1;

      --  Insert initialization checks for operand

      Right_Expr : constant W_Term_Id :=
        New_Temp_For_Expr
          (Insert_Initialization_Check
             (Right_Opnd (Ada_Node),
              Right_Type,
              Right,
              Domain,
              Exclude_Components => None));

      Right_Length : constant W_Expr_Id :=
        Build_Length_Expr (Domain => EW_Term, Expr => +Right_Expr, Dim => 1);
      Range_Check  : constant W_Expr_Id :=
        New_Conditional
          (Domain    => EW_Pred,
           Condition =>
             New_Call
               (Domain => EW_Pred,
                Typ    => EW_Bool_Type,
                Name   => Int_Infix_Gt,
                Args   =>
                  (1 => +Right_Length,
                   2 => New_Integer_Constant (Value => Uint_0))),
           Then_Part =>
             New_Call
               (Domain => EW_Pred,
                Name   => Int_Infix_Lt,
                Typ    => EW_Bool_Type,
                Args   =>
                  (1 => +E_Symb (Component_Type (Right_Type), WNE_Attr_First),
                   2 =>
                     +E_Symb (Component_Type (Right_Type), WNE_Attr_Last))));
   begin
      Add_Array_Arg (Subdomain, Args, +Right_Expr, Arg_Ind);

      --  Add conversions from wrapper types if needed. Initialization checks
      --  are inserted earlier.

      if Is_Init_Wrapper_Type (Get_Type (+Right_Expr)) then
         Args (1) :=
           New_Call
             (Ada_Node => Ada_Node,
              Domain   => Subdomain,
              Name     => Get_Array_Of_Wrapper_Name (Right_Type),
              Args     => (1 => Args (1)),
              Typ      => EW_Split (Right_Type));
      end if;

      --  Call to operator

      T :=
        New_Call
          (Ada_Node => Ada_Node,
           Domain   => Subdomain,
           Name     => Get_Array_Theory_1_Bool_Op (Etype (Ada_Node)).Notb,
           Args     => Args,
           Typ      => Type_Of_Node (Right_Type));

      if Do_Check then

         --  Range check : for all I, Not Right (I) should be in range.
         --  The only way to generate an element not in range using negation
         --  is to call it on an array of a singleton subtype of boolean.

         if not Is_Standard_Boolean_Type (Component_Type (Right_Type)) then
            Prepend
              (New_Ignore
                 (Prog =>
                    New_Located_Assert
                      (Ada_Node, +Range_Check, VC_Range_Check, EW_Assert)),
               T);
         end if;
      end if;

      --  Conversion from base

      if not Has_Static_Array_Type (Right_Type) then
         T :=
           Array_Convert_From_Base
             (Domain => Subdomain,
              Ty     => Right_Type,
              Ar     => T,
              First  =>
                +Get_Array_Attr
                   (Expr => Right_Expr, Attr => Attribute_First, Dim => 1),
              Last   =>
                +Get_Array_Attr
                   (Expr => Right_Expr, Attr => Attribute_Last, Dim => 1));
      end if;

      T :=
        Binding_For_Temp (Domain => Domain, Tmp => +Right_Expr, Context => T);
      return T;
   end Transform_Array_Negation;

   ------------------------------------
   -- Transform_Assignment_Statement --
   ------------------------------------

   function Transform_Assignment_Statement
     (Stmt : N_Assignment_Statement_Id; Params : Transformation_Params)
      return W_Prog_Id
   is
      Lvalue : constant Node_Id := SPARK_Atree.Name (Stmt);
      Typ    : constant Entity_Id := Retysp (Etype (Lvalue));
      L_Type : constant W_Type_Id :=
        (if Expr_Has_Relaxed_Init (Lvalue, No_Eval => False)
         then EW_Init_Wrapper (Type_Of_Node (Typ))
         else Type_Of_Node (Typ));
      --  We go to the wrapper type if lvalue has relaxed initialization
      --  except for scalar types for which a copy is a read.

      T : W_Prog_Id;

      Do_Valid : constant Boolean := Is_Potentially_Invalid_Expr (Lvalue);
      --  Whether we need to assign the validity flag of Lvalue

      --  Context and validity flag to handle potentially invalid values

      Valid_Flag : W_Expr_Id :=
        (if Do_Valid then +New_Valid_Value_For_Type (Typ) else Why_Empty);
      Context    : Ref_Context;

      --  For length checks and discriminant checks, look through conversions
      --  to get the object which is actually modified.

      Exp_Ty     : constant Entity_Id := Expected_Type_Of_Prefix (Lvalue);
      Lgth_Check : constant Boolean :=
        (Is_Array_Type (Exp_Ty) and then not Is_Static_Array_Type (Exp_Ty));
      --  Length check needed for assignment into a non-static array type

      Disc_Check : constant Boolean :=
        (if Is_Access_Type (Exp_Ty)
         then
           Has_Discriminants (Directly_Designated_Type (Exp_Ty))
           and then not Is_Constrained (Directly_Designated_Type (Exp_Ty))
         else Has_Discriminants (Exp_Ty) and then not Is_Constrained (Exp_Ty));
      --  Discriminant check needed for assignment into a non-constrained
      --  record type. Constrained record type are handled by the
      --  conversion.

      --  Tag checks are only necessary if the LHS is classwide

      Tag_Check : constant Boolean :=
        Is_Class_Wide_Type (Etype (Lvalue))
        and then not Is_Tag_Indeterminate (Expression (Stmt));

      Tmp : W_Expr_Id;

   begin
      --  Handle the potential propagation of invalid values

      if Propagates_Validity_Flag (Stmt) then
         T :=
           +Transform_Potentially_Invalid_Expr
              (Expr          => Expression (Stmt),
               Expected_Type => L_Type,
               Domain        => EW_Prog,
               Params        => Params,
               Context       => Context,
               Valid_Flag    => Valid_Flag);
      else
         T := Transform_Prog (Expression (Stmt), L_Type, Params);
      end if;

      Tmp :=
        New_Temp_For_Expr
          (+T,
           Lgth_Check or else Disc_Check or else Tag_Check or else Do_Valid);
      --  The Exp_Entity type is in fact the type that is expected in Why.
      --  The L_Type is a more precise type entity in Ada. We have to
      --  respect both constraints here, so we first convert to the Ada type
      --  (to get checks), and then convert to Why (without checks) to get the
      --  types right.

      if Lgth_Check then
         declare
            Lval  : constant W_Term_Id :=
              New_Temp_For_Expr
                (Transform_Expr
                   (Lvalue, EW_Prog, Params, No_Validity_Check => True));
            Dim   : constant Positive :=
              Positive (Number_Dimensions (Get_Ada_Node (+L_Type)));
            Check : constant W_Pred_Id :=
              New_Length_Equality
                (Left_Arr => +Tmp, Right_Arr => Lval, Dim => Dim);

         begin
            T :=
              Sequence
                (New_Located_Assert (Stmt, Check, VC_Length_Check, EW_Assert),
                 +Tmp);
            T :=
              +Binding_For_Temp
                 (Ada_Node => Empty,
                  Domain   => EW_Prog,
                  Tmp      => +Lval,
                  Context  => +T);
         end;

      elsif Disc_Check then

         --  Discriminants should be preserved by assignment except if the
         --  object is not constrained.

         declare
            Ty    : constant Entity_Id := Get_Ada_Node (+L_Type);
            Check : W_Expr_Id := +True_Pred;
            Lval  : constant W_Expr_Id :=
              New_Temp_For_Expr
                (Transform_Expr
                   (Lvalue, EW_Pterm, Params, No_Init_Check => True),
                 Need_Temp => True);
            Discr : Node_Id :=
              (if Has_Discriminants (Ty)
               then First_Discriminant (Ty)
               else Empty);
            D_Ty  : constant Entity_Id := Retysp (Ty);
         begin
            while Present (Discr) loop
               declare
                  Input_Discr    : constant W_Expr_Id :=
                    New_Ada_Record_Access (Empty, EW_Term, Tmp, Discr, D_Ty);
                  Expected_Discr : constant W_Expr_Id :=
                    New_Ada_Record_Access (Empty, EW_Term, Lval, Discr, D_Ty);
               begin
                  Check :=
                    New_And_Then_Expr
                      (Domain => EW_Pred,
                       Left   => Check,
                       Right  =>
                         New_Call
                           (Domain => EW_Pred,
                            Name   => Why_Eq,
                            Typ    => EW_Bool_Type,
                            Args   => (+Input_Discr, +Expected_Discr)));
               end;
               Next_Discriminant (Discr);
            end loop;

            if Has_Defaulted_Discriminants (Ty) then
               Check :=
                 New_Conditional
                   (Domain    => EW_Pred,
                    Condition =>
                      New_Constrained_Attribute_Expr (Lvalue, EW_Term),
                    Then_Part => Check);
            end if;

            T :=
              Sequence
                (New_Located_Assert
                   (Stmt, +Check, VC_Discriminant_Check, EW_Assert),
                 +Tmp);
            T :=
              +Binding_For_Temp
                 (Ada_Node => Empty,
                  Domain   => EW_Prog,
                  Tmp      => Lval,
                  Context  => +T);
         end;
      end if;

      --  If the right hand side is a classwide type, introduce a tag check. Do
      --  not introduce this check for calls with dispatching results as in
      --  this case the tag will depend on the context.

      if Tag_Check then
         declare
            Lval : constant W_Expr_Id :=
              New_Temp_For_Expr
                (Transform_Expr
                   (Lvalue, EW_Pterm, Params, No_Init_Check => True),
                 Need_Temp => True);
            Pred : constant W_Pred_Id :=
              New_Call
                (Name => Why_Eq,
                 Typ  => EW_Bool_Type,
                 Args =>
                   (1 =>
                      New_Tag_Access
                        (Name   => Lval,
                         Domain => EW_Term,
                         Ty     => Etype (Lvalue)),
                    2 =>
                      New_Tag_Access
                        (Name   => Tmp,
                         Domain => EW_Term,
                         Ty     => Get_Ada_Node (+Get_Type (Tmp)))));
         begin
            T :=
              Sequence
                (New_Located_Assert (Stmt, +Pred, VC_Tag_Check, EW_Assert),
                 +Tmp);
            T :=
              +Binding_For_Temp
                 (Ada_Node => Empty,
                  Domain   => EW_Prog,
                  Tmp      => Lval,
                  Context  => +T);
         end;
      end if;

      --  T might not have type Type_Of_Node (Lvalue) for several reasons:
      --    * Type_Of_Node (Lvalue) uses the Actual_Subtype
      --    * Type_Of_Node (Lvalue) may have relaxed init even though T is
      --      a scalar.
      --  In both cases, the conversion can be done without checks.

      if Do_Valid then

         --  For array types, it might be necessary to slide the validity
         --  tree.

         if Has_Array_Type (Etype (Lvalue))
           and then Needs_Slide (Typ, Get_Ada_Node (+Type_Of_Node (Lvalue)))
         then
            Valid_Flag :=
              +New_Validity_Tree_Slide
                 (Tree   => +Valid_Flag,
                  Expr   => Tmp,
                  To     => Type_Of_Node (Lvalue),
                  Domain => EW_Prog,
                  Params => Params);
         end if;
      end if;

      T :=
        +Binding_For_Temp
           (Empty,
            EW_Prog,
            Tmp,
            Insert_Simple_Conversion
              (Domain => EW_Pterm, Expr => +T, To => Type_Of_Node (Lvalue)));

      declare
         Do_Move : Boolean;
      begin
         Insert_Move_Of_Deep_Parts
           (Rhs     => Expression (Stmt),
            Lhs_Typ => Typ,
            Expr    => T,
            Do_Move => Do_Move);

         --  If a move may be needed, force the use of a temporary to hold
         --  the value of the expression including any moves. This is because
         --  New_Assignment does not expect the rhs expression to modify the
         --  target of the assignment.

         declare
            Tmp : constant W_Expr_Id := New_Temp_For_Expr (+T, Do_Move);
         begin
            T :=
              Gnat2Why.Expr.New_Assignment
                (Ada_Node => Stmt,
                 Lvalue   => Lvalue,
                 Expr     => +Tmp,
                 Do_Check =>
                   (if Has_Target_Names (Stmt)
                    then Only_Vars
                    else All_Checks));

            --  Check that the assignment does not cause a resource leak. This
            --  is done after moves, so that we properly handle the case where
            --  the target of the assignment is moved by the expression of the
            --  assignment, e.g. an aggregate with the target as element. This
            --  also deals with the special case X:=X so that we avoid issuing
            --  a message here.

            if Is_Deep (Typ) and then not Is_Anonymous_Access_Type (Typ) then
               T := +Sequence (Check_No_Memory_Leaks (Stmt, Lvalue), T);
            end if;

            T := +Binding_For_Temp (Empty, EW_Prog, Tmp, +T);
         end;
      end;

      --  Handle the propagation of the validity flag if any

      if Do_Valid then
         declare
            Index_Map : Ada_Node_To_Why_Id.Map;

         begin
            --  Collect indexes for Lvalue before the assignment. No need to
            --  generate checks.

            Collect_Index_Expressions
              (Lvalue, EW_Pterm, Params, Context, Index_Map);

            T :=
              Sequence
                (T,
                 New_Validity_Tree_Assignment
                   (LHS       => Lvalue,
                    New_Tree  => +Valid_Flag,
                    Params    => Params,
                    Index_Map => Index_Map));

            T := +Bindings_For_Ref_Context (+T, Context, EW_Prog);
         end;
      end if;

      --  Update the value at end of local borrowers. This needs to be done
      --  prior to the assignment, as the assumtion generated during the
      --  update needs to refer to the old value of the borrower.
      --  New_Update_For_Borrow_At_End does not assume the dynamic property of
      --  the borrower at the end of the borrow on reborrows as it could
      --  be unsound prior to the assignment. We add the assumption afterward.

      if Nkind (Lvalue) in N_Identifier | N_Expanded_Name
        and then Is_Local_Borrower (Entity (Lvalue))
      then

         declare
            Brower : constant Entity_Id := Entity (Lvalue);
         begin
            T :=
              Sequence
                ((1 =>
                    New_Update_For_Borrow_At_End
                      (Brower => Brower, Path => Expression (Stmt)),
                  2 => T,
                  3 =>
                    New_Assume_Statement
                      (Ada_Node => Stmt,
                       Pred     =>
                         Compute_Dynamic_Inv_And_Initialization
                           (Expr   =>
                              New_Deref
                                (Right => Get_Brower_At_End (Brower),
                                 Typ   =>
                                   Get_Typ (Get_Brower_At_End (Brower))),
                            Ty     => Etype (Brower),
                            Params => Params))));
         end;
      end if;

      return T;
   end Transform_Assignment_Statement;

   ----------------------------------
   -- Transform_At_End_Borrow_Call --
   ----------------------------------

   function Transform_At_End_Borrow_Call
     (Call   : N_Function_Call_Id;
      Domain : EW_Domain;
      Params : Transformation_Params) return W_Expr_Id
   is
      Brower           : constant Entity_Id :=
        Borrower_For_At_End_Borrow_Call (Call);
      Is_Simple_Borrow : constant Boolean :=
        Ekind (Brower) = E_Function
        or else
          Nkind (Get_Borrowed_Expr (Brower))
          in N_Defining_Identifier | N_Identifier | N_Expanded_Name;
      --  True if borrowed_at_end stands for the entire borrowed object

      Expr   : constant Node_Id := First_Actual (Call);
      W_Expr : W_Expr_Id;

   begin
      --  If Expr is a reference to the result of a traversal function, use
      --  the Brower_At_End of the function. We might need a dereference if
      --  we are verifying the body of the traversal function
      --  (Result_Is_Mutable is True).

      if Nkind (Expr) = N_Attribute_Reference
        and then Attribute_Name (Expr) = Name_Result
      then
         pragma Assert (Entity (Prefix (Expr)) = Brower);
         declare
            Brower_At_End : constant W_Identifier_Id :=
              Get_Brower_At_End (Brower);
         begin
            if Result_Is_Mutable then
               W_Expr :=
                 New_Deref
                   (Right => Brower_At_End, Typ => Get_Typ (Brower_At_End));
            else
               W_Expr := +Brower_At_End;
            end if;
         end;

      --  If Expr is rooted at a borrower (or if it is a reference to the 'Old
      --  attribute, in which case its prefix is rooted at a borrower) then
      --  we translate Expr in a context where Brower is its value at the end
      --  of the borrow.

      elsif Nkind (Expr) = N_Attribute_Reference
        or else Brower = Get_Root_Object (Expr)
      then
         pragma
           Assert
             (if Nkind (Expr) = N_Attribute_Reference
              then
                Attribute_Name (Expr) = Name_Old
                and then Brower = Get_Root_Object (Prefix (Expr)));

         Ada_Ent_To_Why.Push_Scope (Symbol_Table);
         Insert_Tmp_Item_For_Entity
           (Brower, Get_Brower_At_End (Brower), Mutable => True);
         W_Expr :=
           Transform_Expr (Expr => Expr, Domain => Domain, Params => Params);
         Ada_Ent_To_Why.Pop_Scope (Symbol_Table);

      --  Otherwise, Expr is rooted at the borrowed entity of Brower. If
      --  we have a simple borrow, we have an identifier for the value at end
      --  of the borrowed entity. We translate Expr in a context where the
      --  borrowed entity maps to its value at the end of the borrow.

      elsif Is_Simple_Borrow then
         pragma Assert (Get_Root_Object (Expr) = Get_Borrowed_Entity (Brower));

         declare
            Borrowed_Entity : constant Entity_Id :=
              Get_Borrowed_Entity (Brower);
            Borrowed_At_End : constant W_Identifier_Id :=
              (if Ekind (Brower) = E_Function
               then To_Local (Get_Borrowed_At_End (Brower))
               else Get_Borrowed_At_End (Brower));
         begin
            Ada_Ent_To_Why.Push_Scope (Symbol_Table);
            Insert_Tmp_Item_For_Entity (Borrowed_Entity, Borrowed_At_End);
            W_Expr :=
              Transform_Expr
                (Expr => Expr, Domain => Domain, Params => Params);
            Ada_Ent_To_Why.Pop_Scope (Symbol_Table);
         end;

      --  If we don't have a simple borrow, we do not have an identifier for
      --  the value of the borrowed object at the end of the borrow. Since
      --  we know that Expr is necessarily a part of the borrowed entity frozen
      --  by the borrow, we can use here the current value of the borrowed
      --  entity updated at the borrowed expression by its value at the end
      --  of the borrow.

      else
         pragma Assert (Get_Root_Object (Expr) = Get_Borrowed_Entity (Brower));

         declare
            Subdomain       : constant EW_Domain := Term_Domain (Domain);
            Borrowed_Entity : constant Entity_Id :=
              Get_Borrowed_Entity (Brower);
            Borrowed_Expr   : constant Node_Id := Get_Borrowed_Expr (Brower);
            Borrowed_Id     : constant W_Identifier_Id :=
              New_Temp_Identifier
                (Typ       => Type_Of_Node (Etype (Borrowed_Entity)),
                 Base_Name => Short_Name (Borrowed_Entity));
            Path            : Node_Id := Borrowed_Expr;
            W_Borrowed      : W_Expr_Id := +Get_Borrowed_At_End (Brower);
            Dummy           : Node_Id := Path;

         begin
            --  We compute in W_Borrowed:
            --    { borrowed_entity with borrowed_expr => borrowed_at_end }

            loop
               case Nkind (Path) is
                  when N_Identifier | N_Expanded_Name =>
                     pragma Assert (Entity (Path) = Borrowed_Entity);
                     exit;

                  when others                         =>
                     Shift_Rvalue
                       (N           => Path,
                        Expr        => W_Borrowed,
                        Last_Access => Dummy,
                        Domain      => Subdomain);
               end case;
            end loop;

            --  Translate Expr in a context where the borrowed entity maps to
            --  Borrowed_Id.

            Ada_Ent_To_Why.Push_Scope (Symbol_Table);
            Insert_Tmp_Item_For_Entity (Borrowed_Entity, Borrowed_Id);
            W_Expr :=
              Transform_Expr
                (Expr => Expr, Domain => Domain, Params => Params);
            Ada_Ent_To_Why.Pop_Scope (Symbol_Table);

            --  Generate:
            --    let borrowed_id = w_borrowed in expr

            W_Expr :=
              New_Binding
                (Ada_Node => Call,
                 Domain   => Domain,
                 Name     => Borrowed_Id,
                 Def      => W_Borrowed,
                 Context  => W_Expr,
                 Typ      => Type_Of_Node (Expr));
         end;
      end if;

      return W_Expr;
   end Transform_At_End_Borrow_Call;

   -----------------------------
   -- Transform_Attribute_Old --
   -----------------------------

   function Transform_Attribute_Old
     (Expr              : N_Subexpr_Id;
      Domain            : EW_Domain;
      Params            : Transformation_Params;
      No_Validity_Check : Boolean := False) return W_Expr_Id is
   begin
      --  If no old attributes are expected here, raise an exception

      if Params.Old_Policy = Raise_Error then
         raise Program_Error;

      --  Do not generate old when they are not allowed (eg in postconditions
      --  of functions or inside prefixes of 'Old attributes) or when the
      --  expression contains no variables.

      elsif Params.Old_Policy = Ignore
        or else Get_Variables_For_Proof (Expr, Expr).Is_Empty
      then
         return
           Transform_Expr
             (Expr, Domain, Params, No_Validity_Check => No_Validity_Check);
      end if;

      --  Expressions that cannot be translated to predicates directly are
      --  translated to (boolean) terms, and compared to "True".

      if Domain = EW_Pred then
         return
           New_Call
             (Ada_Node => Expr,
              Domain   => EW_Pred,
              Typ      => EW_Bool_Type,
              Name     => Why_Eq,
              Args     =>
                (1 =>
                   +Transform_Attribute_Old
                      (Expr, EW_Term, Params, No_Validity_Check),
                 2 =>
                   Insert_Simple_Conversion
                     (Domain => EW_Term,
                      Expr   => +True_Term,
                      To     => Type_Of_Node (Expr))));

      --  Use the map for old when references are not allowed

      elsif Params.Old_Policy = Use_Map then
         declare
            Old_Id : constant W_Identifier_Id := Name_For_Old (Expr);
         begin
            --  Validity checks are not introduced when building the map
            --  except for scalars for which copy is disallowed. Do it here.

            if Domain = EW_Prog
              and then not No_Validity_Check
              and then Is_Potentially_Invalid_Expr (Expr)
              and then not Has_Scalar_Type (Etype (Expr))
            then
               return
                 +Sequence
                    (Left  =>
                       New_Assert
                         (Pred        =>
                            New_VC_Pred
                              (Expr,
                               +New_Is_Valid_Call_For_Expr
                                  (Tree   =>
                                     +Get_Valid_Flag_For_Id
                                        (Old_Id, Etype (Expr)),
                                   Ty     => Etype (Expr),
                                   Expr   => +Old_Id,
                                   Domain => EW_Pred),
                               VC_Validity_Check),
                          Assert_Kind => EW_Assert),
                     Right => +Old_Id);
            else
               return +Old_Id;
            end if;
         end;
      else
         return
           New_Old
             (Expr   =>
                Transform_Expr (Expr, Domain, Params, No_Validity_Check),
              Domain => Domain);
      end if;
   end Transform_Attribute_Old;

   --------------------
   -- Transform_Attr --
   --------------------

   function Transform_Attr
     (Expr              : N_Attribute_Reference_Id;
      Domain            : EW_Domain;
      Params            : Transformation_Params;
      Expected_Typ      : W_Type_Id;
      No_Validity_Check : Boolean := False) return W_Expr_Id
   is
      Aname   : constant Name_Id := Attribute_Name (Expr);
      Attr_Id : constant Attribute_Id := Get_Attribute_Id (Aname);
      Var     : constant Node_Id := Prefix (Expr);
      T       : W_Expr_Id := Why_Empty;

   begin
      --  The attributes supported here must be a subset of those
      --  supported by a language as a whole. This case statement
      --  must therefore maintain that relationship with that in
      --  SPARK_Definition.Mark_Attribute_Reference.

      case Attr_Id is
         when Attribute_Result                                              =>
            if Result_Is_Mutable then
               T :=
                 New_Deref
                   (Ada_Node => Expr,
                    Right    => Result_Name,
                    Typ      => Get_Type (+Result_Name));
            else
               T := +Result_Name;
            end if;

            --  In the program domain, possibly add a validity check when
            --  accessing the result.

            if Domain = EW_Prog
              and then not No_Validity_Check
              and then Is_Potentially_Invalid (Entity (Var))
            then
               declare
                  Valid_Flag : constant W_Term_Id :=
                    Get_Valid_Id_For_Result (Entity (Var));
               begin
                  T :=
                    +Sequence
                       (New_Located_Assert
                          (Ada_Node => Expr,
                           Pred     =>
                             +New_Is_Valid_Call_For_Expr
                                (Tree   => +Valid_Flag,
                                 Ty     => Etype (Entity (Var)),
                                 Expr   => T,
                                 Domain => EW_Pred),
                           Reason   => VC_Validity_Check,
                           Kind     => EW_Assert),
                        +T);
               end;
            end if;

         when Attribute_Old                                                 =>
            T :=
              Transform_Attribute_Old (Var, Domain, Params, No_Validity_Check);

         when Attribute_Pred | Attribute_Succ                               =>
            --  'Succ and 'Pred on floating-point types are modelled as calls
            --  to logic functions next_representable and prev_representable
            --  for the corresponding type.

            if Has_Floating_Point_Type (Etype (Var)) then
               declare
                  Opnd   : constant Node_Id := First (Expressions (Expr));
                  W_Type : constant W_Type_Id := Base_Why_Type (Etype (Var));
                  Oper   : constant W_Identifier_Id :=
                    (if Attr_Id = Attribute_Pred
                     then MF_Floats (W_Type).Prev_Rep
                     else MF_Floats (W_Type).Next_Rep);
                  Arg    : W_Expr_Id :=
                    Transform_Expr (Opnd, W_Type, Domain, Params);
               begin
                  if Domain = EW_Prog and then Do_Range_Check (Opnd) then
                     Arg :=
                       +Do_Range_Check
                          (Ada_Node   => Opnd,
                           Ty         => Base_Retysp (Etype (Var)),
                           W_Expr     => Arg,
                           Check_Kind =>
                             (if Attr_Id = Attribute_Succ
                              then RCK_FP_Overflow_Not_Last
                              else RCK_FP_Overflow_Not_First));
                  end if;

                  T :=
                    New_Call
                      (Ada_Node => Expr,
                       Domain   => Domain,
                       Name     => Oper,
                       Args     => (1 => Arg),
                       Typ      => W_Type);
               end;

            --  For all discrete and fixed-point types, 'Succ is modelled as
            --  adding 1 to the representation value, and 'Pred is modelled
            --  as subtracting 1 to the representation value.

            elsif Has_Modular_Integer_Type (Etype (Var)) then
               declare
                  Opnd   : constant Node_Id := First (Expressions (Expr));
                  W_Type : constant W_Type_Id := Base_Why_Type (Etype (Var));
                  Op     : constant N_Op :=
                    (if Attr_Id = Attribute_Succ
                     then N_Op_Add
                     else N_Op_Subtract);
                  Old    : W_Expr_Id;
                  Offset : constant W_Expr_Id :=
                    (if Has_No_Bitwise_Operations_Annotation (Etype (Var))
                     then New_Integer_Constant (Value => Uint_1)
                     else
                       New_Modular_Constant (Typ => W_Type, Value => Uint_1));
                  NType  : constant Entity_Id := Etype (Expr);
               begin
                  Old := Transform_Expr (Opnd, W_Type, Domain, Params);

                  pragma Assert (not Do_Range_Check (Opnd));

                  T :=
                    New_Binary_Op_Expr
                      (Op          => Op,
                       Left        => Old,
                       Right       => Offset,
                       Left_Type   => NType,
                       Right_Type  => NType,
                       Return_Type => NType,
                       Domain      => Domain,
                       Ada_Node    => Expr);
               end;

            else
               declare
                  Opnd   : constant Node_Id := First (Expressions (Expr));
                  Op     : constant W_Identifier_Id :=
                    (if Attr_Id = Attribute_Succ
                     then Int_Infix_Add
                     else Int_Infix_Subtr);
                  Old    : W_Expr_Id;
                  Offset : W_Expr_Id;
                  A_Type : constant Entity_Id := Etype (Var);
                  W_Type : W_Type_Id;

               begin
                  if Is_Discrete_Type (A_Type) then
                     W_Type := EW_Int_Type;
                     Offset := New_Integer_Constant (Value => Uint_1);
                  else
                     pragma Assert (Is_Fixed_Point_Type (A_Type));
                     W_Type := Base_Why_Type (A_Type);
                     Offset :=
                       New_Fixed_Constant (Value => Uint_1, Typ => W_Type);
                  end if;

                  Old := Transform_Expr (Opnd, W_Type, Domain, Params);

                  if Domain = EW_Prog and then Do_Range_Check (Opnd) then
                     Old :=
                       +Do_Range_Check
                          (Ada_Node   => Opnd,
                           Ty         => Base_Retysp (Etype (Var)),
                           W_Expr     => Old,
                           Check_Kind =>
                             (if Is_Enumeration_Type (Etype (Var))
                              then
                                (if Attr_Id = Attribute_Succ
                                 then RCK_Range_Not_Last
                                 else RCK_Range_Not_First)
                              elsif Attr_Id = Attribute_Succ
                              then RCK_Overflow_Not_Last
                              else RCK_Overflow_Not_First));
                  end if;

                  T :=
                    New_Call
                      (Ada_Node => Expr,
                       Domain   => Domain,
                       Name     => Op,
                       Args     => (1 => Old, 2 => Offset),
                       Typ      => W_Type);
               end;
            end if;

         when Attribute_Pos                                                 =>
            T :=
              Transform_Expr
                (First (Expressions (Expr)), EW_Int_Type, Domain, Params);

         when Attribute_Enum_Rep                                            =>
            declare
               Args   : constant List_Id := Expressions (Expr);
               Arg    : constant Node_Id :=
                 (if Is_Non_Empty_List (Args)
                  then First (Args)
                  else Prefix (Expr));
               Arg_Ty : constant Entity_Id := Retysp (Etype (Arg));
            begin
               if Is_Enumeration_Type (Arg_Ty)
                 and then Has_Enumeration_Rep_Clause (Arg_Ty)
               then
                  T :=
                    New_Call
                      (Ada_Node => Expr,
                       Domain   => Domain,
                       Name     => E_Symb (Arg_Ty, WNE_Pos_To_Rep),
                       Args     =>
                         (1 =>
                            Transform_Expr (Arg, EW_Int_Type, Domain, Params)),
                       Typ      => EW_Int_Type);
               else
                  T := Transform_Expr (Arg, EW_Int_Type, Domain, Params);
               end if;
            end;

         when Attribute_Val                                                 =>
            declare
               Val_Type : constant W_Type_Id :=
                 Type_Of_Node (Base_Type (Entity (Var)));
            begin
               T :=
                 Transform_Expr
                   (First (Expressions (Expr)), Val_Type, Domain, Params);
            end;

         when Attribute_Enum_Val                                            =>
            declare
               Val_Type : constant Entity_Id :=
                 Retysp (Base_Type (Entity (Var)));
               Args     : constant List_Id := Expressions (Expr);
               pragma Assert (List_Length (Args) = 1);
               Arg      : constant Node_Id := First (Args);
            begin
               if Is_Enumeration_Type (Val_Type)
                 and then Has_Enumeration_Rep_Clause (Val_Type)
               then
                  --  In the program domain, emit a range check

                  T :=
                    New_Operator_Call
                      (Ada_Node => Arg,
                       Domain   => Domain,
                       Reason   => VC_Range_Check,
                       Name     => E_Symb (Val_Type, WNE_Rep_To_Pos),
                       Args     =>
                         (1 =>
                            Transform_Expr (Arg, EW_Int_Type, Domain, Params)),
                       Check    => Domain = EW_Prog,
                       Typ      => EW_Int_Type);
               else
                  pragma
                    Annotate
                      (Xcov,
                       Exempt_On,
                       "T'Enum_Val is expanded into T'Val if T has no"
                       & " representation clause");
                  T :=
                    Transform_Expr
                      (Arg, Type_Of_Node (Val_Type), Domain, Params);
                  pragma Annotate (Xcov, Exempt_Off);
               end if;
            end;

         when Attribute_First | Attribute_Last | Attribute_Length           =>
            declare
               Ty_Ent : constant Entity_Id := Retysp (Etype (Var));
            begin

               case Ekind (Ty_Ent) is
                  when Array_Kind                =>
                     declare
                        Arr_Ty    : constant Entity_Id :=
                          (if Nkind (Var) in N_Identifier | N_Expanded_Name
                             and then Is_Type (Entity (Var))
                           then Entity (Var)
                           else Etype (Var));
                        Dim       : constant Positive :=
                          (if Present (Expressions (Expr))
                           then
                             Positive
                               (UI_To_Int
                                  (Intval (First (Expressions (Expr)))))
                           else 1);
                        B_Exp     : constant W_Type_Id :=
                          Base_Why_Type_No_Bool (Expected_Typ);
                        Index_Rng : constant Type_Kind_Id :=
                          Nth_Index_Type (Retysp (Arr_Ty), Dim);
                        B_Rng     : constant W_Type_Id :=
                          Base_Why_Type_No_Bool (Index_Rng);
                        Typ       : constant W_Type_Id :=
                          (if not Why_Type_Is_BitVector (B_Rng)
                             or else not Why_Type_Is_BitVector (B_Exp)
                           then EW_Int_Type
                           elsif BitVector_Type_Size (B_Rng)
                             <= BitVector_Type_Size (B_Exp)
                           then B_Exp
                           else B_Rng);
                        --  Typ is only used for the computation of 'Length.
                        --  Do computation on bitvectors only if the array
                        --  ranges over bitvectors, as otherwise the conversion
                        --  of 'First and 'Last to Typ may be incorrect. We
                        --  also use the widest of B_Rng and B_Exp for
                        --  bitvector computation. We cannot use B_Exp
                        --  systematically as it may be too short, producing
                        --  unexpected overflows.

                        Modular_Range_Check : constant Boolean :=
                          Domain = EW_Prog
                          and then Attr_Id = Attribute_Length
                          and then Why_Type_Is_BitVector (Typ)
                          and then
                            UI_Expon (2, BitVector_Type_Size (Typ))
                            = Modulus (Index_Rng);
                        --  If attribute is length, computation on plain
                        --  bitvectors may already overflow. This can only
                        --  happen when 'First = 0 and 'Last is the maximum
                        --  bitvector value. Furthermore, since additionally
                        --  Last < Modulus (range), we can use modulus value
                        --  to remove the check entirely in cases where
                        --  bitvector maximum value exceeds modulus.

                        pragma
                          Assert
                            (if Why_Type_Is_BitVector (Typ)
                             then
                               Modulus (Index_Rng)
                               <= UI_Expon (2, BitVector_Type_Size (Typ)));

                        function Prepend_Modular_Range_Check
                          (Src   : W_Prog_Id;
                           First : W_Term_Id;
                           Last  : W_Term_Id) return W_Prog_Id
                        is (Sequence
                              (Left  =>
                                 New_Located_Assert
                                   (Ada_Node => Expr,
                                    Reason   => VC_Range_Check,
                                    Kind     => EW_Assert,
                                    Pred     =>
                                      New_Or_Pred
                                        (New_Comparison
                                           (Symbol => Why_Neq,
                                            Left   =>
                                              Insert_Simple_Conversion
                                                (Expr => First, To => Typ),
                                            Right  =>
                                              New_Discrete_Constant
                                                (Value => Uint_0, Typ => Typ)),
                                         New_Comparison
                                           (Symbol => Why_Neq,
                                            Left   =>
                                              Insert_Simple_Conversion
                                                (Expr => Last, To => Typ),
                                            Right  =>
                                              New_Discrete_Constant
                                                (Value =>
                                                   UI_Sub
                                                     (Modulus (Index_Rng),
                                                      Uint_1),
                                                 Typ   => Typ)))),
                               Right => Src))
                        with Pre => Modular_Range_Check;
                        --  Prepend additional check. While this looks like an
                        --  overflow, this should be a range check as this
                        --  comes from the length not being representable in
                        --  the modular type.

                     begin
                        --  Array_Type'First/Last/Length

                        if Nkind (Var) in N_Identifier | N_Expanded_Name
                          and then Is_Type (Entity (Var))
                        then
                           T :=
                             +Get_Array_Attr
                                (Domain => Term_Domain (Domain),
                                 Ty     => Entity (Var),
                                 Attr   => Attr_Id,
                                 Dim    => Dim,
                                 Typ    => Typ);
                           if Modular_Range_Check then
                              T :=
                                +Prepend_Modular_Range_Check
                                   (+T,
                                    +Get_Array_Attr
                                       (Domain => EW_Term,
                                        Ty     => Entity (Var),
                                        Attr   => Attribute_First,
                                        Dim    => Dim),
                                    +Get_Array_Attr
                                       (Domain => EW_Term,
                                        Ty     => Entity (Var),
                                        Attr   => Attribute_Last,
                                        Dim    => Dim));
                           end if;

                        --  Object'First/Last/Length

                        else
                           declare
                              Why_Expr  : constant W_Expr_Id :=
                                Transform_Expr
                                  (Var,
                                   Domain,
                                   Params,
                                   No_Validity_Check => True);
                              Tmp       : constant W_Term_Id :=
                                New_Temp_For_Expr (Why_Expr);
                              Simpl_Var : constant Boolean :=
                                Nkind (Var) in N_Identifier | N_Expanded_Name;
                              Item      : Item_Type;

                           begin
                              if Simpl_Var then
                                 Item :=
                                   Ada_Ent_To_Why.Element
                                     (Symbol_Table, Entity (Var));
                                 T :=
                                   +Get_Array_Attr
                                      (Item, Attr_Id, Dim, Typ => Typ);
                                 if Modular_Range_Check then
                                    T :=
                                      +Prepend_Modular_Range_Check
                                         (+T,
                                          +Get_Array_Attr
                                             (Item, Attribute_First, Dim),
                                          +Get_Array_Attr
                                             (Item, Attribute_Last, Dim));
                                 end if;
                              else
                                 T :=
                                   +Get_Array_Attr
                                      (Tmp, Attr_Id, Dim, Typ => Typ);
                                 if Modular_Range_Check then
                                    T :=
                                      +Prepend_Modular_Range_Check
                                         (+T,
                                          +Get_Array_Attr
                                             (Tmp, Attribute_First, Dim),
                                          +Get_Array_Attr
                                             (Tmp, Attribute_Last, Dim));
                                 end if;
                              end if;

                              if not Simpl_Var or else Domain = EW_Prog then
                                 T :=
                                   Binding_For_Temp
                                     (Domain  => Domain,
                                      Tmp     => +Tmp,
                                      Context => T);
                              end if;
                           end;
                        end if;
                     end;

                  when Discrete_Kind | Real_Kind =>
                     T :=
                       New_Attribute_Expr
                         (Etype (Var), Domain, Attr_Id, Params);

                  when others                    =>

                     --  All possible cases should have been handled before
                     --  this point.

                     raise Program_Error;
               end case;
            end;

         when Attribute_Loop_Entry                                          =>
            declare
               Loop_Entry_Id : constant W_Identifier_Id :=
                 Name_For_Loop_Entry (Expr);
            begin
               --  Validity checks are not introduced when building the map
               --  except for scalars for which copy is disallowed. Do it here.

               if Domain = EW_Prog
                 and then not No_Validity_Check
                 and then Is_Potentially_Invalid_Expr (Expr)
                 and then not Has_Scalar_Type (Etype (Expr))
               then
                  T :=
                    +Sequence
                       (Left  =>
                          New_Assert
                            (Pred        =>
                               New_VC_Pred
                                 (Expr,
                                  +New_Is_Valid_Call_For_Expr
                                     (Tree   =>
                                        +Get_Valid_Flag_For_Id
                                           (Loop_Entry_Id, Etype (Expr)),
                                      Ty     => Etype (Expr),
                                      Expr   => +Loop_Entry_Id,
                                      Domain => EW_Pred),
                                  VC_Validity_Check),
                             Assert_Kind => EW_Assert),
                        Right => +Loop_Entry_Id);
               else
                  T := +Loop_Entry_Id;
               end if;
            end;

         when Attribute_Mod                                                 =>
            declare
               Arg      : constant Node_Id := First (Expressions (Expr));
               Arg_BTyp : constant W_Type_Id := Base_Why_Type (Arg);

               --  S'Mod for subtype S returns a value of type S'Base
               Target_Type : constant W_Type_Id :=
                 Base_Why_Type (Base_Type (Etype (Var)));

            begin
               --  If the argument is a bitvector we do the modulo on
               --  bitvectors.

               if Why_Type_Is_BitVector (Arg_BTyp) then
                  declare
                     Arg_Modulus : constant Uint := Modulus (Etype (Arg));
                     Var_Modulus : constant Uint := Modulus (Etype (Var));
                     Arg_Expr    : W_Expr_Id;
                     Mod_Expr    : W_Expr_Id;

                  begin
                     --  If the modulus of the argument is greater than the
                     --  value of the modulo operation, then apply the modulo.

                     if Arg_Modulus > Var_Modulus then
                        Arg_Expr :=
                          Transform_Expr (Arg, Arg_BTyp, Domain, Params);

                        --  If the modulo comes from a builtin type, we use the
                        --  modulus value from the Why3 theory.

                        if Var_Modulus
                          = UI_Expon (2, Modular_Size (Etype (Var)))
                        then
                           Mod_Expr :=
                             Insert_Simple_Conversion
                               (Domain => EW_Term,
                                Expr   =>
                                  +MF_BVs (Base_Why_Type (Var)).Two_Power_Size,
                                To     => Arg_BTyp);

                        --  Otherwise, we retrieve the value of the Modulus
                        --  attribute.

                        else
                           Mod_Expr :=
                             Insert_Simple_Conversion
                               (Domain => EW_Term,
                                Expr   =>
                                  New_Attribute_Expr
                                    (Etype (Var), Domain, Attribute_Modulus),
                                To     => Arg_BTyp);
                        end if;

                        T :=
                          Insert_Simple_Conversion
                            (Domain => EW_Term,
                             Expr   =>
                               New_Call
                                 (Ada_Node => Expr,
                                  Domain   => Domain,
                                  Name     => MF_BVs (Arg_BTyp).Urem,
                                  Args     => (1 => Arg_Expr, 2 => Mod_Expr),
                                  Typ      => Arg_BTyp),
                             To     => Target_Type);

                     --  If the modulus of the argument is no greater than the
                     --  value of the modulo operation, then simply convert the
                     --  value to the new type.

                     else
                        T :=
                          Insert_Simple_Conversion
                            (Domain => EW_Term,
                             Expr   => Transform_Expr (Arg, Domain, Params),
                             To     => Target_Type);
                     end if;
                  end;

               --  If not, we do the modulo on integer and convert back

               else
                  T :=
                    Insert_Simple_Conversion
                      (Domain => EW_Term,
                       Expr   =>
                         New_Call
                           (Ada_Node => Expr,
                            Domain   => Domain,
                            Name     => M_Int_Div.Mod_Id,
                            Args     =>
                              (1 =>
                                 Transform_Expr
                                   (Arg, EW_Int_Type, Domain, Params),
                               2 =>
                                 Insert_Simple_Conversion
                                   (Domain => EW_Term,
                                    Expr   =>
                                      New_Attribute_Expr
                                        (Etype (Var),
                                         Domain,
                                         Attribute_Modulus),
                                    To     => EW_Int_Type)),
                            Typ      => EW_Int_Type),
                       To     => Target_Type);
               end if;
            end;

         --  We generate the expression String.to_string (image_func (arg)),
         --  where arg may be either the prefix in the notation X'Image, or
         --  the argument in notation S'Image(X).

         when Attribute_Image | Attribute_Img                               =>
            declare
               Arg : constant Node_Id :=
                 (if Present (Expressions (Expr))
                  then First (Expressions (Expr))
                  else Var);
            begin
               T :=
                 New_Call
                   (Ada_Node => Expr,
                    Domain   => Domain,
                    Name     =>
                      +New_Attribute_Expr
                         (Etype (Var), Domain, Attribute_Image),
                    Args     =>
                      (1 =>
                         Transform_Expr
                           (Arg, Base_Why_Type (Var), Domain, Params)));

               --  To_string takes as a second argument the maximum size of the
               --  image of the corresponding type.

               T :=
                 New_Call
                   (Ada_Node => Expr,
                    Domain   => Domain,
                    Name     => To_String_Id,
                    Args     =>
                      (1 => T,
                       2 =>
                         New_Integer_Constant
                           (Value =>
                              Max_Size_Of_Img_Attr (Retysp (Etype (Var))))),
                    Typ      => EW_Abstract (Standard_String));

               Warning_Msg_N
                 (Warn_Imprecise_Image,
                  Expr,
                  Create_N
                    (Warn_Imprecise_Image,
                     Names => [To_String (Aname, Sloc (Expr))]));
            end;

         when Attribute_Size | Attribute_Value_Size | Attribute_Object_Size =>

            --  For arrays and records we do not know the exact value of
            --  attribute size, which is decided by the back-end when
            --  generating executable code. Instead, we generate call to an
            --  uninterpreted function, either:
            --
            --  * "value__size", which corresponds to
            --  ** Type'Size in Ada
            --  ** Type'Value_Size in GNAT
            --  ** RM_Size field in GNAT AST
            --
            --  or
            --
            --  * "object__size", which corresponds to
            --  ** Object'Size in Ada
            --  ** Type'Object_Size in GNAT
            --  ** Esize field in GNAT AST

            Size_Attributes : declare
               Has_Type_Prefix : constant Boolean :=
                 Nkind (Var) in N_Identifier | N_Expanded_Name
                 and then Is_Type (Entity (Var));
               Var_Type        : constant Entity_Id :=
                 (if Has_Type_Prefix then Entity (Var) else Etype (Var));

            begin
               if Has_Type_Prefix then
                  declare
                     Precise     : Boolean;
                     Explanation : Unbounded_String;
                  begin
                     Compute_Size_Of_Type
                       (Typ          => Var_Type,
                        Object_Size  => Attr_Id = Attribute_Object_Size,
                        Domain       => Domain,
                        Dynamic_Size => T,
                        Precise      => Precise,
                        Explanation  => Explanation);

                     --  If --info is given, notify the user that the attribute
                     --  is handled in an imprecise way.

                     if not Precise then
                        declare
                           Conts : Message_Lists.List;
                        begin
                           Conts.Append (Create (To_String (Explanation)));

                           Warning_Msg_N
                             (Warn_Imprecise_Size,
                              Expr,
                              Create_N
                                (Warn_Imprecise_Size,
                                 Names => [To_String (Aname, Sloc (Expr))]),
                              Continuations => Conts);
                        end;
                     end if;
                  end;

               else
                  pragma Assert (Attr_Id = Attribute_Size);

                  declare
                     Precise     : Boolean;
                     Explanation : Unbounded_String;
                  begin
                     Compute_Size_Of_Object
                       (Var, Domain, Params, T, Precise, Explanation);

                     --  If --info is given, notify the user that the attribute
                     --  is handled in an imprecise way.

                     if not Precise then
                        declare
                           Conts : Message_Lists.List;
                        begin
                           Conts.Append (Create (To_String (Explanation)));

                           Warning_Msg_N
                             (Warn_Imprecise_Size,
                              Expr,
                              Create_N
                                (Warn_Imprecise_Size,
                                 Names => [To_String (Aname, Sloc (Expr))]),
                              Continuations => Conts);
                        end;
                     end if;
                  end;

                  --  In the program domain, translate the object itself to
                  --  generate any necessary checks.

                  if Domain = EW_Prog then
                     T :=
                       New_Binding
                         (Name    =>
                            New_Temp_Identifier (Typ => Get_Type (+T)),
                          Domain  => Domain,
                          Def     =>
                            Transform_Expr
                              (Var,
                               Domain,
                               Params,
                               No_Init_Check     => True,
                               No_Validity_Check => True),
                          Context => +T,
                          Typ     => Get_Type (+T));
                  end if;
               end if;
            end Size_Attributes;

         when Attribute_Value                                               =>
            declare
               Why_Str : constant W_Type_Id := EW_Abstract (Standard_String);
               Arg     : constant W_Expr_Id :=
                 Transform_Expr
                   (First (Expressions (Expr)), Why_Str, Domain, Params);
               Func    : constant W_Identifier_Id :=
                 +New_Attribute_Expr (Etype (Var), Domain, Attr_Id);

            begin
               T :=
                 New_Call
                   (Ada_Node => Expr,
                    Domain   => Domain,
                    Name     => Of_String_Id,
                    Args     => (1 => Arg));
               T :=
                 New_Operator_Call
                   (Ada_Node => Expr,
                    Domain   => Domain,
                    Name     => Func,
                    Args     => (1 => T),
                    Check    => Domain = EW_Prog,
                    Reason   => VC_Precondition,
                    Typ      => Base_Why_Type (Var));

               Warning_Msg_N (Warn_Imprecise_Value, Expr);
            end;

         when Attribute_Update                                              =>
            T :=
              Transform_Delta_Aggregate
                (Ada_Node => Expr,
                 Pref     => Prefix (Expr),
                 Aggr     => First (Expressions (Expr)),
                 Domain   => Domain,
                 Params   => Params);

         when Attribute_Ceiling
            | Attribute_Floor
            | Attribute_Rounding
            | Attribute_Truncation                                          =>
            declare
               Typ  : constant W_Type_Id := Base_Why_Type (Etype (Var));
               Arg  : constant W_Expr_Id :=
                 Transform_Expr
                   (First (Expressions (Expr)), Typ, Domain, Params);
               Func : constant W_Identifier_Id :=
                 (if Attr_Id = Attribute_Ceiling
                  then MF_Floats (Typ).Ceil
                  elsif Attr_Id = Attribute_Floor
                  then MF_Floats (Typ).Floor
                  elsif Attr_Id = Attribute_Rounding
                  then MF_Floats (Typ).Rounding
                  else MF_Floats (Typ).Truncate);
            begin
               T :=
                 New_Call
                   (Ada_Node => Expr,
                    Domain   => Domain,
                    Name     => Func,
                    Args     => (1 => Arg),
                    Typ      => Typ);
            end;

         when Attribute_Remainder                                           =>
            declare
               Ada_Ty : constant Entity_Id := Etype (Expr);
               Base   : constant W_Type_Id := Base_Why_Type (Ada_Ty);
               Arg_1  : constant W_Expr_Id :=
                 Transform_Expr
                   (First (Expressions (Expr)), Base, Domain, Params);
               Arg_2  : constant W_Expr_Id :=
                 Transform_Expr
                   (Next (First (Expressions (Expr))), Base, Domain, Params);
            begin
               --  The front end does not insert a Do_Division_Check flag on
               --  remainder attribute so we systematically do the check.
               T :=
                 New_Operator_Call
                   (Ada_Node   => Expr,
                    Name       => MF_Floats (Base).Remainder,
                    Args       => (1 => Arg_1, 2 => Arg_2),
                    Reason     => VC_Division_Check,
                    Check_Info =>
                      New_Check_Info
                        (Divisor => Next (First (Expressions (Expr)))),
                    Check      => Domain = EW_Prog,
                    Domain     => Domain,
                    Typ        => Base);
            end;

         when Attribute_Min | Attribute_Max                                 =>
            declare
               Ada_Ty : constant Entity_Id := Retysp (Etype (Expr));
               Base   : constant W_Type_Id := Base_Why_Type_No_Bool (Ada_Ty);
               Arg1   : constant W_Expr_Id :=
                 Transform_Expr
                   (First (Expressions (Expr)), Base, Domain, Params);
               Arg2   : constant W_Expr_Id :=
                 Transform_Expr
                   (Next (First (Expressions (Expr))), Base, Domain, Params);
               Func   : constant W_Identifier_Id :=
                 (if Is_Discrete_Type (Ada_Ty)
                    or else Is_Fixed_Point_Type (Ada_Ty)
                  then
                    (if Is_Modular_Integer_Type (Ada_Ty)
                       and then
                         not Has_No_Bitwise_Operations_Annotation (Ada_Ty)
                     then
                       (if Attr_Id = Attribute_Min
                        then MF_BVs (Base).BV_Min
                        else MF_BVs (Base).BV_Max)
                     else
                       (if Attr_Id = Attribute_Min
                        then M_Int_Minmax.Min
                        else M_Int_Minmax.Max))
                  else
                    (if Attr_Id = Attribute_Min
                     then MF_Floats (Base).Min
                     else MF_Floats (Base).Max));
            begin
               T :=
                 New_Call
                   (Ada_Node => Expr,
                    Domain   => Domain,
                    Name     => Func,
                    Args     => (1 => Arg1, 2 => Arg2),
                    Typ      => Base);
            end;

         --  On potentially invalid expressions, query the validity flag.
         --  Otherwise, support attributes Valid and Valid_Scalars by assuming
         --  they always evaluate to True. Emit a warning.

         when Attribute_Valid | Attribute_Valid_Scalars                     =>

            if Is_Potentially_Invalid_Expr (Var) then
               declare
                  Context : Ref_Context;
                  Prefix  : W_Expr_Id;
                  Valid   : W_Expr_Id;
               begin
                  Transform_Potentially_Invalid_Expr
                    (Expr       => Var,
                     Domain     => Domain,
                     Params     => Params,
                     Context    => Context,
                     Valid_Flag => Valid,
                     W_Expr     => Prefix);

                  Prefix := New_Temp_For_Expr (Prefix);
                  Valid := New_Temp_For_Expr (Valid);

                  T :=
                    New_Is_Valid_Call_For_Expr
                      (Tree   => +Valid,
                       Ty     => Etype (Var),
                       Expr   => Prefix,
                       Domain => Domain);

                  T :=
                    Binding_For_Temp
                      (Tmp => Prefix, Context => T, Domain => Domain);

                  T :=
                    Binding_For_Temp
                      (Tmp => Valid, Context => T, Domain => Domain);

                  T :=
                    Bindings_For_Ref_Context
                      (Expr => T, Context => Context, Domain => Domain);
               end;

            else
               Warning_Msg_N
                 (Warn_Attribute_Valid,
                  Expr,
                  Create_N
                    (Warn_Attribute_Valid,
                     Names => [To_String (Aname, Sloc (Expr))]),
                  First => True);

               if Domain = EW_Prog then
                  declare
                     Why_Expr : constant W_Expr_Id :=
                       Transform_Expr (Var, Domain, Params);
                  begin
                     T :=
                       +Sequence (New_Ignore (Prog => +Why_Expr), +True_Term);
                  end;
               else
                  T := +True_Term;
               end if;
            end if;

         when Attribute_Constrained                                         =>
            T :=
              New_Constrained_Attribute_Expr (Domain => Domain, Prefix => Var);
            if Domain = EW_Prog then
               Prepend
                 (New_Ignore
                    (Prog =>
                       Transform_Prog
                         (Var,
                          Params,
                          No_Init_Check     => True,
                          No_Validity_Check => True)),
                  T);
            end if;

         when Attribute_Address                                             =>
            --  Attribute 'Address can only appear in address clauses. We are
            --  not interested in the concrete value of the expression, only
            --  run-time errors and alignment. So we translate the prefix to
            --  get the RTE and return an arbitrary value compatible with the
            --  alignment.

            --  ??? If an address clause uses complex features such as
            --  quantified expressions or slices, we might end up outside of
            --  the Prog domain. We exclude some of these cases in marking, but
            --  we probably missed some.

            pragma Assert (Domain = EW_Prog);

            declare
               Post  : W_Pred_Id := True_Pred;
               Align : Uint := No_Uint;
               W_Typ : W_Type_Id;
            begin
               --  For now we do not try to obtain alignment information for
               --  components.

               if Nkind (Var) in N_Expanded_Name | N_Identifier
                 and then
                   Ekind (Entity (Var))
                   in E_Constant | E_Loop_Parameter | E_Variable | Formal_Kind
               then
                  Align :=
                    Get_Attribute_Value (Entity (Var), Attribute_Alignment);
               else
                  Warning_Msg_N (Warn_Imprecise_Align, Expr);
               end if;

               --  Generate
               --
               --  ignore { Address }; (* RTE *)
               --  any { Post }
               --
               --  With Post being (result mod Alignment = 0) when alignment is
               --  known, and true otherwise.

               if Present (Align) then
                  W_Typ := Base_Why_Type_No_Bool (Etype (Expr));
                  Post :=
                    New_Comparison
                      (Symbol => Why_Eq,
                       Left   =>
                         New_Call
                           (Name =>
                              (if W_Typ = EW_Int_Type
                               then M_Int_Div.Mod_Id
                               else MF_BVs (W_Typ).Urem),
                            Args =>
                              (1 => +New_Result_Ident (Typ => W_Typ),
                               2 =>
                                 New_Discrete_Constant
                                   (Value => Align, Typ => W_Typ)),
                            Typ  => W_Typ),
                       Right  =>
                         New_Discrete_Constant
                           (Value => Uint_0, Typ => W_Typ));
               end if;

               T :=
                 +Sequence
                    (New_Ignore (Prog => Transform_Prog (Var, Params)),
                     New_Any_Expr
                       (Ada_Node    => Expr,
                        Post        => Post,
                        Labels      => Symbol_Sets.Empty_Set,
                        Return_Type => Type_Of_Node (Expr)));
            end;

         when Attribute_Callable                                            =>
            T := +True_Term;

         when Attribute_Terminated                                          =>
            T := +False_Term;

         when Attribute_Component_Size                                      =>
            declare
               Has_Type_Prefix : constant Boolean :=
                 Nkind (Var) in N_Identifier | N_Expanded_Name
                 and then Is_Type (Entity (Var));
               Typ             : constant Entity_Id :=
                 (if Has_Type_Prefix then Entity (Var) else Etype (Var));
               Precise         : Boolean;
               Explanation     : Unbounded_String;
            begin
               Compute_Array_Component_Size
                 (Typ, Domain, T, Precise, Explanation);

               --  In the program domain, translate the object itself to
               --  generate any necessary checks. Note that Component_Size may
               --  only be specified explicitly for a type, not for an object,
               --  so there is no reason here to call Known_Component_Size for
               --  more precise handling of the value of the attribute.

               if not Has_Type_Prefix and then Domain = EW_Prog then
                  T :=
                    New_Binding
                      (Name    => New_Temp_Identifier (Typ => Get_Type (+T)),
                       Domain  => Domain,
                       Def     => Transform_Expr (Var, Domain, Params),
                       Context => +T,
                       Typ     => Get_Type (+T));
               end if;

               if not Precise then
                  Warning_Msg_N (Warn_Component_Size, Expr);
               end if;
            end;

         --  Alignment may be specified explicitly on the type or object. When
         --  specified on the type, the frontend replaces T'Alignment by its
         --  value. When specified on the object, we only support cases where
         --  the alignment is known. Those are expanded by the frontend, so
         --  they never occur here.

         when Attribute_Alignment                                           =>
            if Is_Entity_Name (Var) then
               declare
                  Has_Type_Prefix : constant Boolean := Is_Type (Entity (Var));
                  Attr_Value      : constant Uint :=
                    Get_Attribute_Value (Entity (Var), Attr_Id);
               begin
                  if Present (Attr_Value) then
                     T := New_Integer_Constant (Value => Attr_Value);
                  elsif Has_Type_Prefix then
                     T := New_Attribute_Expr (Entity (Var), Domain, Attr_Id);
                  else
                     raise Program_Error;
                  end if;
               end;
            else
               raise Program_Error;
            end if;

         when Attribute_First_Bit                                           =>
            declare
               Component : constant Entity_Id := Entity (Selector_Name (Var));

               --  First_Bit is expanded by the frontend when statically known

               pragma Assert (not Known_Component_First_Bit (Component));

               Name : constant W_Identifier_Id :=
                 E_Symb (Component, WNE_Attr_First_Bit);

            begin
               Warning_Msg_N
                 (Warn_Record_Component_Attr,
                  Expr,
                  Create_N
                    (Warn_Record_Component_Attr,
                     Names => [To_String (Aname, Sloc (Expr))]));

               return
                 New_Call
                   (Ada_Node => Expr,
                    Domain   => Domain,
                    Name     => Name,
                    Typ      => EW_Int_Type);
            end;

         when Attribute_Last_Bit                                            =>
            declare
               Component : constant Entity_Id := Entity (Selector_Name (Var));

               --  Last_Bit is expanded by the frontend when statically known

               pragma Assert (not Known_Component_Last_Bit (Component));

               Name : constant W_Identifier_Id :=
                 E_Symb (Component, WNE_Attr_Last_Bit);

            begin
               Warning_Msg_N
                 (Warn_Record_Component_Attr,
                  Expr,
                  Create_N
                    (Warn_Record_Component_Attr,
                     Names => [To_String (Aname, Sloc (Expr))]));

               return
                 New_Call
                   (Ada_Node => Expr,
                    Domain   => Domain,
                    Name     => Name,
                    Typ      => EW_Int_Type);
            end;

         when Attribute_Position                                            =>
            declare
               Component : constant Entity_Id := Entity (Selector_Name (Var));

               --  Position is expanded by the frontend when statically known

               pragma Assert (No (Component_Clause (Component)));

               Name : constant W_Identifier_Id :=
                 E_Symb (Component, WNE_Attr_Position);

            begin
               Warning_Msg_N
                 (Warn_Record_Component_Attr,
                  Expr,
                  Create_N
                    (Warn_Record_Component_Attr,
                     Names => [To_String (Aname, Sloc (Expr))]));

               return
                 New_Call
                   (Ada_Node => Expr,
                    Domain   => Domain,
                    Name     => Name,
                    Typ      => EW_Int_Type);
            end;

         --  The Initialized attribute is used to express that a value has been
         --  initialized. To remain as close as possible to the executable
         --  semantics of the attribute, proof does not assume that
         --  'Initialized necessarily returns False on uninitialized data.

         when Attribute_Initialized                                         =>

            --  For discriminant, the init flag is stored in the prefix

            if Nkind (Var) = N_Selected_Component
              and then Ekind (Entity (Selector_Name (Var))) = E_Discriminant
            then
               pragma
                 Assert (Has_Mutable_Discriminants (Etype (Prefix (Var))));
               declare
                  Expr : constant W_Expr_Id :=
                    Transform_Expr
                      (Expr          => Prefix (Var),
                       Domain        => Domain,
                       Params        => Params,
                       No_Init_Check => True);
               begin
                  return
                    +New_Init_Attribute_Access (Etype (Prefix (Var)), +Expr);
               end;
            end if;

            --  If Var is an identifier and has its own Init flag, use it

            declare
               Expr : W_Expr_Id;
            begin
               T := New_Literal (Value => EW_True, Domain => Domain);

               if Nkind (Var) in N_Identifier | N_Expanded_Name then
                  declare
                     Init_Id : constant W_Expr_Id :=
                       Get_Init_Id_From_Object
                         (Entity (Var), Params.Ref_Allowed);
                  begin
                     if Init_Id /= Why_Empty then
                        T := Init_Id;
                     end if;
                  end;

                  --  Take care of not generating initialization checks for the
                  --  prefix here.

                  Expr :=
                    Transform_Identifier
                      (Expr   => Var,
                       Ent    => Entity (Var),
                       Domain =>
                         (if Domain = EW_Prog then EW_Pterm else Domain),
                       Params => Params);

               else
                  Expr :=
                    Transform_Expr
                      (Expr          => Var,
                       Domain        => Domain,
                       Params        => Params,
                       No_Init_Check => True);
               end if;

               --  Add the initialization of components if any

               T :=
                 New_And_Expr
                   (Left   => T,
                    Right  =>
                      Compute_Is_Initialized
                        (Etype (Var),
                         Expr,
                         Params,
                         Domain,
                         Exclude_Components => Relaxed),
                    Domain => Domain);
            end;

         when Attribute_Access                                              =>
            if Is_Access_Subprogram_Type (Etype (Expr)) then
               T :=
                 Transform_Access_Attribute_Of_Subprogram
                   (Expr => Expr, Domain => Domain, Params => Params);

            --  Construct a pointer object designating Var

            else
               declare
                  Relaxed_Init : constant Boolean :=
                    Expr_Has_Relaxed_Init (Expr);
                  Des_Ty       : constant Entity_Id :=
                    Directly_Designated_Type (Etype (Expr));
                  Value_Expr   : constant W_Expr_Id :=
                    Transform_Expr
                      (Expr          => Var,
                       Domain        => Domain,
                       Params        => Params,
                       Expected_Type =>
                         EW_Abstract
                           (Des_Ty,
                            Relaxed_Init =>
                              Has_Relaxed_Init (Des_Ty)
                              or else
                                (Relaxed_Init
                                 and then Has_Init_Wrapper (Des_Ty))));
                  Is_Null_Expr : constant W_Expr_Id := +False_Term;

               begin
                  T :=
                    +Pointer_From_Split_Form
                       (A            =>
                          (Value_Expr, Is_Null_Expr)
                          & (if Relaxed_Init
                             then (1 => +True_Term)
                             else (1 .. 0 => <>)),
                        Ty           => Etype (Expr),
                        Relaxed_Init => Relaxed_Init);

                  --  If the access type has a direct or inherited predicate,
                  --  generate a corresponding check.

                  if Domain = EW_Prog and then Has_Predicates (Etype (Expr))
                  then
                     T :=
                       +Insert_Predicate_Check
                          (Ada_Node => Expr,
                           Check_Ty => Etype (Expr),
                           W_Expr   => +T);
                  end if;
               end;
            end if;

         when Attribute_Copy_Sign                                           =>
            declare
               Ty   : constant W_Type_Id := Base_Why_Type (Etype (Expr));
               Arg1 : constant Node_Id := First (Expressions (Expr));
               Arg2 : constant Node_Id := Next (Arg1);
               Mag  : constant W_Expr_Id :=
                 Transform_Expr (Arg1, Ty, Domain, Params);
               Sign : constant W_Expr_Id :=
                 Transform_Expr (Arg2, Ty, Domain, Params);
            begin
               T :=
                 New_Call
                   (Domain   => Domain,
                    Ada_Node => Expr,
                    Name     => MF_Floats (Ty).Copy_Sign,
                    Args     => (1 => Mag, 2 => Sign),
                    Typ      => Ty);
            end;

         when others                                                        =>
            Ada.Text_IO.Put_Line
              ("[Transform_Attr] not implemented: "
               & Attribute_Id'Image (Attr_Id));
            raise Not_Implemented;
      end case;

      return T;
   end Transform_Attr;

   -------------------------------
   -- Transform_Block_Statement --
   -------------------------------

   function Transform_Block_Statement
     (N : N_Block_Statement_Id; Params : Transformation_Params)
      return W_Prog_Id
   is
      use Local_CFG;
      Core : W_Prog_Id :=
        Transform_Handled_Statements (Handled_Statement_Sequence (N), Params);
   begin
      if Present (Declarations (N)) then

         --  Havoc all entities borrowed in the block

         Append
           (Core,
            +Finalization_Actions
               (N, Vertex'(Kind => Completion, Node => N), Params));

         return Transform_Declarations_Block (Declarations (N), Core, Params);
      else
         return Core;
      end if;
   end Transform_Block_Statement;

   --------------------------------------
   -- Transform_Call_With_Side_Effects --
   --------------------------------------

   function Transform_Call_With_Side_Effects
     (Params : Transformation_Params; Call : Node_Id) return W_Prog_Id
   is
      Context     : Ref_Context;
      Store       : W_Statement_Sequence_Id := Void_Sequence;
      Handled_Exc : constant Exception_Sets.Set :=
        Get_Raised_Exceptions (Call, Only_Handled => True);
      Exc_Store   : W_Statement_Sequence_Id := Void_Sequence;
      Result      : W_Prog_Id;
      Subp        : constant Entity_Id := Get_Called_Entity_For_Proof (Call);

      Selector : constant Selection_Kind :=

      --  When the call is dispatching, use the Dispatch variant of the
      --  program function, which has the appropriate contract.

         (if Nkind (Call) in N_Procedure_Call_Statement | N_Function_Call
            and then Present (Controlling_Argument (Call))
          then Dispatch

          --  In the program domain, if the call has visibility over the
          --  refined postcondition or the expression function completion of
          --  the subprogram, use the Refine variant of the program function,
          --  which has the appropriate refined contract.

          elsif Entity_Body_In_SPARK (Subp)
            and then Has_Refinement (Subp)
            and then Has_Visibility_On_Refined_Expr (Call, Subp)
          then Refine

          --  Otherwise use the Standard variant of the program function
          --  (defined outside any namespace, directly in the module for
          --  the program function).

          else Why.Inter.Standard);

      Tag_Expr : constant W_Expr_Id :=
        (if Nkind (Call) = N_Function_Call and then Selector = Dispatch
         then
           Transform_Expr
             (Expr   => Controlling_Argument (Call),
              Domain => EW_Pterm,
              Params => Params)
         else Why_Empty);
      Tag_Arg  : constant W_Expr_Array :=
        (if Nkind (Call) = N_Function_Call and then Selector = Dispatch
         then
           (1 =>
              New_Tag_Access
                (Domain => EW_Pterm,
                 Name   => Tag_Expr,
                 Ty     => Get_Ada_Node (+Get_Type (Tag_Expr))))
         else (1 .. 0 => <>));
      --  Calls to dispatching function need the dispatching tag as an
      --  additional argument.

      Args : constant W_Expr_Array :=
        Tag_Arg
        & Compute_Call_Args
            (Call,
             EW_Prog,
             Context,
             Store,
             Exc_Exit  => not Handled_Exc.Is_Empty,
             Exc_Store => Exc_Store,
             Params    => Params,
             Use_Tmps  =>
               Subp_Needs_Invariant_Checks (Subp, Current_Subp)
               or else Call_Needs_Variant_Check (Call, Current_Subp));
      --  If we need to perform invariant or variant checks for this call, Args
      --  will be reused for the call to the checking procedure. Force the use
      --  of temporary identifiers to avoid duplicating checks.

   begin
      --  If Subp is hardcoded, use a specific translation

      if Is_Hardcoded_Entity (Subp) then
         Result := Transform_Hardcoded_Procedure_Call (Subp, Args, Call);

      else
         declare
            Why_Name : W_Identifier_Id;
         begin

            --  For procedures with higher order specialization, generate a
            --  specialized version if needed and call it instead.

            if Is_Specialized_Call (Call, Specialized_Call_Params) then
               Create_Theory_For_HO_Specialization_If_Needed (Call);

               declare
                  HO_Specialization : constant M_HO_Specialization_Type :=
                    M_HO_Specializations (Subp)
                      (Get_Specialization_Theory_Name (Call));
               begin
                  Why_Name := HO_Specialization.Prog_Id;
               end;
            else
               Why_Name :=
                 W_Identifier_Id
                   (Transform_Identifier
                      (Params   => Params,
                       Expr     => Call,
                       Ent      => Subp,
                       Domain   => EW_Prog,
                       Selector => Selector));
            end if;

            if Why_Subp_Has_Precondition (Subp, Selector) then
               Result :=
                 New_VC_Call
                   (Call, Why_Name, Args, VC_Precondition, Get_Typ (Why_Name));
            else
               Result := New_Call (Call, Why_Name, Args, Get_Typ (Why_Name));
            end if;
         end;
      end if;

      --  Insert a try block around the call to catch potential Ada exceptions
      --  and do the appropriate stores. The exceptions are raised again after
      --  the store, so no post processing should be appended to call if it
      --  should also be done for exceptions.

      if Has_Exceptional_Contract (Subp) then
         declare
            Ex_Name         : constant W_Identifier_Id :=
              New_Temp_Identifier (Base_Name => "exn", Typ => EW_Int_Type);
            Raise_Or_Absurd : constant W_Prog_Id :=
              New_Raise_Or_Absurd (Call, Ex_Name, Handled_Exc, Params);
         begin
            --  Put the raise at the end of the handler

            Append (Exc_Store, Raise_Or_Absurd);

            --  Construct the try block

            Result :=
              New_Try_Block
                (Ada_Node => Call,
                 Prog     => Result,
                 Handler  =>
                   (1 =>
                      New_Handler
                        (Name   => M_Main.Ada_Exc,
                         Arg_Id => Ex_Name,
                         Def    => +Exc_Store)),
                 Typ      => Get_Type (+Result));
         end;
      end if;

      --  Insert a try block around the call to catch potential program exit
      --  if the call is not allowed to exit the program.

      if Has_Program_Exit (Subp) and then not Might_Exit_Program (Call) then
         Result :=
           New_Try_Block
             (Ada_Node => Call,
              Prog     => Result,
              Handler  =>
                (1 =>
                   New_Handler
                     (Name => M_Main.Program_Exit_Exc,
                      Def  =>
                        New_Absurd_Statement
                          (Call, VC_Unexpected_Program_Exit))),
              Typ      => Get_Type (+Result));
      end if;

      --  Insert invariant check if needed

      if Subp_Needs_Invariant_Checks (Subp, Current_Subp) then
         Prepend (Check_Type_Invariants_For_Call (Call, Params), Result);
      end if;

      --  Insert tag check if needed

      if Nkind (Call) /= N_Entry_Call_Statement then
         Prepend (Compute_Tag_Check (Call, Params), Result);
      end if;

      --  Insert variant check if needed

      if Call_Needs_Variant_Check (Call, Current_Subp) then
         Prepend
           (Check_Subprogram_Variants
              (Call => Call, Args => Args, Params => Params),
            Result);
      end if;

      --  Generate termination checks if necessary

      declare
         Encl_Cond  : constant Termination_Condition :=
           Get_Termination_Condition (Current_Subp, Compute => True);
         Subp_Cond  : constant Termination_Condition :=
           Get_Termination_Condition (Subp, Compute => True);
         Ghost_Call : constant Boolean :=
           Is_Ghost_With_Respect_To_Context (Call);

      begin
         --  If the enclosing subprogram has a dynamic termination condition,
         --  termination checks are entirely done by proof. If the call
         --  might unconditionally not terminate, check that the termination
         --  condition of the enclosing subprogram evaluates to False. If the
         --  callee is ghost and not the caller, the check was done in flow
         --  analysis. Do not duplicate it here.

         if Encl_Cond.Kind = Dynamic
           and then
             (Subp_Cond = (Static, False)
              or else Call_Never_Terminates (Call, Current_Subp))
           and then not Ghost_Call
         then
            pragma Assert (Termination_Condition_Name /= Why_Empty);

            Prepend
              (New_Ignore
                 (Prog =>
                    New_Located_Assert
                      (Ada_Node => Call,
                       Pred     =>
                         New_Not (Right => +Termination_Condition_Name),
                       Reason   => VC_Termination_Check,
                       Kind     => EW_Assert)),
               Result);

         --  Check calls to subprograms with a dynamic termination conditions.
         --  This shall also be done in subprograms which always terminate
         --  and when the callee is ghost and not the caller. Other checks
         --  are deferred to flow analysis.

         elsif (Encl_Cond /= (Static, False) or else Ghost_Call)
           and then Subp_Cond.Kind = Dynamic
         then
            declare
               Term_Check : W_Prog_Id :=
                 New_VC_Call
                   (Ada_Node => Call,
                    Name     => E_Symb (Subp, WNE_Check_Termination_Condition),
                    Progs    => Args,
                    Reason   => VC_Termination_Check,
                    Typ      => EW_Unit_Type);

            begin
               --  Termination of ghost calls needs to be checked independently
               --  of the termination condition of the caller.

               if Encl_Cond.Kind = Dynamic and then not Ghost_Call then
                  Term_Check :=
                    New_Conditional
                      (Condition => +Termination_Condition_Name,
                       Then_Part => Term_Check);
               end if;

               Prepend (Term_Check, Result);
            end;
         end if;
      end;

      --  Check that the call does not cause a resource leak. Every output
      --  of the call which is not also an input should be moved prior to the
      --  call. Otherwise assigning it in the callee will produce a resource
      --  leak.

      Check_For_Memory_Leak : declare

         Outputs : Entity_Sets.Set :=
           Compute_Outputs_With_Allocated_Parts (Subp);

         procedure Check_Param (Formal : Entity_Id; Actual : Node_Id);

         procedure Check_Param (Formal : Entity_Id; Actual : Node_Id) is
            Typ : constant Entity_Id := Retysp (Etype (Formal));
         begin
            if Contains_Allocated_Parts (Typ)
              and then not Is_Anonymous_Access_Type (Typ)
              and then Ekind (Formal) = E_Out_Parameter
            then
               Outputs.Delete (Formal);
               Prepend (Check_No_Memory_Leaks (Actual, Actual), Result);
            end if;
         end Check_Param;

         procedure Iterate_Call is new Iterate_Call_Parameters (Check_Param);

      begin
         if Is_Unchecked_Deallocation_Instance (Subp) then
            Prepend
              (Check_No_Memory_Leaks
                 (Call, First_Actual (Call), Is_Uncheck_Dealloc => True),
               Result);

         else
            Iterate_Call (Call);

            for Obj of Outputs loop
               Prepend (Check_No_Memory_Leaks (Call, Obj), Result);
            end loop;
         end if;
      end Check_For_Memory_Leak;

      --  Always call Insert_Ref_Context to get the checks on store for
      --  predicates.

      Result := Insert_Ref_Context (Call, Result, Context, Store);

      --  Handle specially calls to instances of Ada.Unchecked_Deallocation. We
      --  introduce a predicate check on the output value of the parameter if
      --  the pointer type has a predicate and we assume that the argument is
      --  set to null on return, in the absence of a postcondition in the
      --  standard.

      if Is_Unchecked_Deallocation_Instance (Subp) then

         --  Generate a check that the predicate holds on the null value

         declare
            Actual    : constant Node_Id := First_Actual (Call);
            Formal_Ty : constant Entity_Id :=
              Type_Of_Node (First_Formal (Subp));
         begin
            if Has_Predicates (Formal_Ty) then

               --  Add a continuation locating the potential checks on the
               --  output value of the actual.

               Continuation_Stack.Append
                 (Continuation_Type'
                    (Ada_Node => Actual,
                     Message  =>
                       To_Unbounded_String
                         ("in value of subprogram parameter after the call")));
               Prepend
                 (New_Ignore
                    (Prog =>
                       New_Predicate_Check
                         (Ada_Node => Actual,
                          Ty       => Formal_Ty,
                          W_Expr   => +E_Symb (Formal_Ty, WNE_Null_Pointer))),
                  Result);
               Continuation_Stack.Delete_Last;
            end if;
         end;

         --  Assume that the value of the parameter is null after the call

         declare
            Actual : constant Node_Id := First_Actual (Call);
            Typ    : constant Entity_Id := Retysp (Etype (Actual));
            Ptr    : constant W_Expr_Id :=
              Transform_Expr
                (Expr => Actual, Domain => EW_Term, Params => Params);
         begin
            Append
              (Result,
               New_Assume_Statement
                 (Ada_Node => Call,
                  Pred     =>
                    Pred_Of_Boolean_Term
                      (+New_Pointer_Is_Null_Access (Typ, Ptr))));
         end;
      end if;

      return Result;
   end Transform_Call_With_Side_Effects;

   --------------------------
   -- Transform_Comparison --
   --------------------------

   function Transform_Comparison
     (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
      return W_Expr_Id
   is
      function Is_Equal_Of_Update (Expr : Node_Id) return Boolean
      with Pre => Has_Array_Type (Etype (Left_Opnd (Expr)));
      --  Return True if Expr is of the form X op E'Update (I => V) where
      --  E is either X'Old or X'Loop_Entry and op is either = or /=.

      function Transform_Equal_Of_Update
        (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
         return W_Expr_Id
      with
        Pre =>
          Has_Array_Type (Etype (Left_Opnd (Expr)))
          and then Is_Equal_Of_Update (Expr);
      --  From: X = E'Update (I => V)
      --  construct:
      --    (for all K in X'Range => X (K) = (if K = I then V else E (K)))

      ------------------------
      -- Is_Equal_Of_Update --
      ------------------------

      function Is_Equal_Of_Update (Expr : Node_Id) return Boolean is
         Var  : constant Node_Id :=
           (if Nkind (Left_Opnd (Expr)) = N_Identifier
            then Left_Opnd (Expr)
            else Right_Opnd (Expr));
         Upd  : constant Node_Id :=
           (if Nkind (Left_Opnd (Expr)) = N_Identifier
            then Right_Opnd (Expr)
            else Left_Opnd (Expr));
         Pref : constant Node_Id :=
           (if Nkind (Upd) = N_Attribute_Reference
              and then
                Get_Attribute_Id (Attribute_Name (Upd)) = Attribute_Update
            then Prefix (Upd)
            elsif Nkind (Upd) = N_Delta_Aggregate
            then Expression (Upd)
            else Empty);
         --  If Upd is a 'Update attribute or a delta aggregate, Pref is the
         --  node of the updated expression, otherwise it is empty.

      begin
         --  Var must be a variable
         --  Upd should be a 'Update attribute or a delta aggregate
         --  whose prefix is a 'Old or 'Loop_Entry attribute
         --  whose prefix is Var.

         return
           Nkind (Expr) in N_Op_Eq | N_Op_Ne
           and then Nkind (Var) = N_Identifier
           and then Present (Pref)
           and then Nkind (Pref) = N_Attribute_Reference
           and then Attribute_Name (Pref) in Name_Loop_Entry | Name_Old
           and then Nkind (Prefix (Pref)) = N_Identifier
           and then Entity (Var) = Entity (Prefix (Pref));
      end Is_Equal_Of_Update;

      -------------------------------
      -- Transform_Equal_Of_Update --
      -------------------------------

      function Transform_Equal_Of_Update
        (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
         return W_Expr_Id is
      begin
         --  This translation is done in the predicate domain to be able to
         --  use quantification. In the Prog domain, we still need some kind
         --  of translation to generate checks.

         if Domain in EW_Terms then
            declare
               Pred : constant W_Expr_Id :=
                 Transform_Equal_Of_Update (Expr, EW_Pred, Params);
            begin
               return Boolean_Expr_Of_Pred (+Pred, Domain);
            end;
         end if;

         declare
            Var    : constant Node_Id :=
              (if Nkind (Left_Opnd (Expr)) = N_Identifier
               then Left_Opnd (Expr)
               else Right_Opnd (Expr));
            pragma Assert (Nkind (Var) = N_Identifier);
            Upd    : constant Node_Id :=
              (if Nkind (Left_Opnd (Expr)) = N_Identifier
               then Right_Opnd (Expr)
               else Left_Opnd (Expr));
            pragma
              Assert
                (Nkind (Upd) in N_Attribute_Reference | N_Delta_Aggregate);
            Arr_Ty : constant Entity_Id := Etype (Var);

            T             : W_Expr_Id;
            Subdomain     : constant EW_Domain :=
              (if Domain = EW_Pred then EW_Term else Domain);
            Subd_No_Check : constant EW_Domain :=
              (if Domain = EW_Prog then EW_Pterm else Subdomain);
            Assocs        : constant List_Id :=
              (if Nkind (Upd) = N_Delta_Aggregate
               then Component_Associations (Upd)
               else Component_Associations (First (Expressions (Upd))));
            Prefix_N      : constant Node_Id :=
              (if Nkind (Upd) = N_Delta_Aggregate
               then Expression (Upd)
               else Prefix (Upd));
            Association   : Node_Id := Nlists.First (Assocs);
            Dim           : constant Positive :=
              Positive (Number_Dimensions (Etype (Var)));
            Indexes       : W_Identifier_Array (1 .. Dim);
            --  Indexes inside the array

            Vars : W_Expr_Array (1 .. Dim);
            --  Expressions used to index arrays at index Indexes

            Guards : W_Expr_Array (1 .. Natural (List_Length (Assocs))) :=
              (others =>
                 New_Literal
                   (Domain => Domain, Value => EW_False, Typ => EW_Bool_Type));
            --  Expressions for the evaluation of the choices

            Exprs : W_Expr_Array (1 .. Natural (List_Length (Assocs)));
            --  Expressions associated to the choices

            Index     : Node_Id := First_Index (Arr_Ty);
            Num_Assoc : Positive := 1;

         begin
            --  Store indexes inside Indexes and Vars

            for I in Indexes'Range loop
               Indexes (I) :=
                 New_Temp_Identifier
                   (Typ => Type_Of_Node (Etype (Index)), Base_Name => "index");
               Vars (I) :=
                 Insert_Simple_Conversion
                   (Domain => Subd_No_Check,
                    Expr   => +Indexes (I),
                    To     => Base_Why_Type_No_Bool (Get_Typ (Indexes (I))));
               Next_Index (Index);
            end loop;

            --  Compute choices and expressions

            while Present (Association) loop
               declare
                  Choice : Node_Id := First (Choice_List (Association));
                  Rng    : Node_Id;
                  Guard  : W_Expr_Id;
               begin
                  while Present (Choice) loop

                     --  Transform the choice into a guard

                     case Nkind (Choice) is
                        when N_Range     =>
                           pragma Assert (Dim = 1);
                           Rng := Get_Range (Choice);
                           Guard :=
                             New_Range_Expr
                               (Domain => Domain,
                                Low    =>
                                  Transform_Expr
                                    (Expr          => Low_Bound (Rng),
                                     Domain        => Subdomain,
                                     Params        => Params,
                                     Expected_Type => Get_Type (Vars (1))),
                                High   =>
                                  Transform_Expr
                                    (Expr          => High_Bound (Rng),
                                     Domain        => Subdomain,
                                     Params        => Params,
                                     Expected_Type => Get_Type (Vars (1))),
                                Expr   => Vars (1));

                        when N_Aggregate =>
                           declare
                              Expr : Node_Id :=
                                Nlists.First (Expressions (Choice));

                           begin
                              pragma
                                Assert
                                  (List_Length (Expressions (Choice))
                                   = Nat (Dim));

                              Guard :=
                                New_Literal
                                  (Domain => Domain,
                                   Value  => EW_True,
                                   Typ    => EW_Bool_Type);

                              for Tmp_Index of Indexes loop
                                 pragma Assert (Present (Expr));
                                 Guard :=
                                   New_And_Expr
                                     (Left   => Guard,
                                      Right  =>
                                        New_Ada_Equality
                                          (Typ    =>
                                             Get_Ada_Node
                                               (+Get_Typ (Tmp_Index)),
                                           Left   => +Tmp_Index,
                                           Right  =>
                                             Transform_Expr
                                               (Expr          => Expr,
                                                Domain        => Subdomain,
                                                Params        => Params,
                                                Expected_Type =>
                                                  Get_Typ (Tmp_Index)),
                                           Domain => Domain),
                                      Domain => Domain);
                                 Next (Expr);
                              end loop;
                           end;

                        when others      =>
                           pragma Assert (Dim = 1);
                           Guard :=
                             New_Ada_Equality
                               (Typ    =>
                                  Get_Ada_Node (+Get_Typ (Indexes (1))),
                                Left   => +Indexes (1),
                                Right  =>
                                  Transform_Expr
                                    (Expr          => Choice,
                                     Domain        => Subdomain,
                                     Params        => Params,
                                     Expected_Type =>
                                       Get_Typ
                                         (W_Identifier_Id'(+Indexes (1)))),
                                Domain => Domain);
                     end case;

                     --  Add the choice to Guards

                     Guards (Num_Assoc) :=
                       New_Or_Expr
                         (Left   => Guards (Num_Assoc),
                          Right  => Guard,
                          Domain => Domain);
                     Next (Choice);
                  end loop;

               end;
               Exprs (Num_Assoc) :=
                 Transform_Expr
                   (Expr          => Expression (Association),
                    Domain        => Subdomain,
                    Params        => Params,
                    Expected_Type => Type_Of_Node (Component_Type (Arr_Ty)));
               Num_Assoc := Num_Assoc + 1;
               Next (Association);
            end loop;

            --  In the predicate domain, we generate a universally quantified
            --  formula comparing the elements of the array one by one.

            if Domain = EW_Pred then

               T :=
                 Insert_Simple_Conversion
                   (Domain => Subdomain,
                    Expr   =>
                      New_Array_Access
                        (Ada_Node => Empty,
                         Ar       =>
                           Transform_Expr
                             (Expr          => Prefix_N,
                              Domain        => Subdomain,
                              Params        => Params,
                              Expected_Type => Type_Of_Node (Arr_Ty)),
                         Index    => Vars,
                         Domain   => Subd_No_Check),
                    To     => Type_Of_Node (Component_Type (Arr_Ty)));

               --  Construct the conditional by starting from the expression
               --  Upd (I) and add conditions in the reverse order.

               for J in Exprs'Range loop
                  T :=
                    New_Conditional
                      (Ada_Node  => Expr,
                       Domain    => Subdomain,
                       Condition => Guards (J),
                       Then_Part => Exprs (J),
                       Else_Part => T,
                       Typ       => Type_Of_Node (Component_Type (Arr_Ty)));
               end loop;

               --  Var (I) is equal to the conditional

               T :=
                 New_Ada_Equality
                   (Typ    => Component_Type (Arr_Ty),
                    Domain => Domain,
                    Left   =>
                      +Insert_Simple_Conversion
                         (Expr =>
                            New_Array_Access
                              (Ada_Node => Empty,
                               Ar       =>
                                 Transform_Term
                                   (Expr          => Var,
                                    Params        => Params,
                                    Expected_Type => Type_Of_Node (Arr_Ty)),
                               Index    => Vars),
                          To   => Type_Of_Node (Component_Type (Arr_Ty))),
                    Right  => T);

               --  Universally quantify the formula

               for J in Indexes'Range loop
                  T :=
                    New_Universal_Quantif
                      (Binders =>
                         (1 =>
                            New_Binder
                              (Domain   => EW_Pred,
                               Name     => Indexes (J),
                               Arg_Type => Get_Typ (Indexes (J)))),
                       Labels  => Symbol_Sets.Empty_Set,
                       Pred    =>
                         New_Conditional
                           (Condition =>
                              +New_Array_Range_Expr
                                 (Index_Expr => +Indexes (J),
                                  Array_Expr =>
                                    Transform_Term
                                      (Expr          => Var,
                                       Params        => Params,
                                       Expected_Type => Type_Of_Node (Arr_Ty)),
                                  Domain     => EW_Pred,
                                  Dim        => J),
                            Then_Part => +T,
                            Typ       => EW_Bool_Type));
               end loop;

               if Nkind (Expr) = N_Op_Ne then
                  pragma
                    Annotate
                      (Xcov, Exempt_On, "A /= B is expanded into not (A = B)");
                  T := New_Not (Domain => EW_Pred, Right => T);
                  pragma Annotate (Xcov, Exempt_Off);
               end if;

            --  In the EW_Prog domain, we concentrate on generating the checks.
            --  The expression will be created by lifting the translation in
            --  the predicate domain.

            else
               pragma Assert (Domain = EW_Prog);
               T := +Void;

               --  Instead of a conditional, we generate a sequence to avoid
               --  shadowing checks coming from the first occurrence of
               --  duplicated choices.

               for J in Exprs'Range loop
                  Append
                    (T,
                     New_Ignore (Prog => +Guards (J)),
                     New_Ignore (Prog => +Exprs (J)));
               end loop;

               --  Link indexes to any expressions using
               --  let bindings and hide the expression inside an ignore block.
               --  Afterward, assume the formula using the translation in the
               --  EW_Pred domain.
               --  ignore { let i = any in ... };
               --  any boolean { forall i. ... }

               for Tmp_Index of Indexes loop
                  T :=
                    New_Typed_Binding
                      (Name    => Tmp_Index,
                       Domain  => EW_Prog,
                       Def     => +New_Simpl_Any_Prog (Get_Typ (Tmp_Index)),
                       Context => T);
               end loop;

               T :=
                 +Sequence
                    (New_Ignore (Ada_Node => Expr, Prog => +T),
                     New_Any_Expr
                       (Ada_Node    => Expr,
                        Post        =>
                          New_Connection
                            (Op    => EW_Equivalent,
                             Left  =>
                               Pred_Of_Boolean_Term
                                 (+New_Result_Ident (EW_Bool_Type)),
                             Right =>
                               +Transform_Comparison (Expr, EW_Pred, Params)),
                        Return_Type => EW_Bool_Type,
                        Labels      => Symbol_Sets.Empty_Set));
            end if;
            return T;
         end;
      end Transform_Equal_Of_Update;

      Left      : constant Node_Id := Left_Opnd (Expr);
      Right     : constant Node_Id := Right_Opnd (Expr);
      Left_Type : constant Entity_Id := Etype (Left);
      T         : W_Expr_Id;

      --  Start of processing for Transform_Comparison

   begin
      --  Special case for equality between Booleans in predicates

      if Domain = EW_Pred
        and then Nkind (Expr) = N_Op_Eq
        and then Is_Standard_Boolean_Type (Left_Type)
      then
         declare
            Left_Expr  : constant W_Expr_Id :=
              Transform_Expr (Left, EW_Bool_Type, EW_Pred, Params);
            Right_Expr : constant W_Expr_Id :=
              Transform_Expr (Right, EW_Bool_Type, EW_Pred, Params);
         begin
            T :=
              New_Connection
                (Domain => EW_Pred,
                 Left   => Left_Expr,
                 Right  => Right_Expr,
                 Op     => EW_Equivalent);
         end;

      elsif Has_Array_Type (Left_Type) then

         --  If Expr is of the form Id = Id'Old'Update (...) and equality is
         --  not redefined on the array type, we can translate it as
         --  (for all Idx in Id'Range =>
         --     Id (Idx) = (if Idx ... then ... else Id'Old (Idx)))

         if not Is_Deep_Delta_Aggregate (Expr)
           and then Is_Equal_Of_Update (Expr)
         then
            T := Transform_Equal_Of_Update (Expr, Domain, Params);

         --  Normal translation

         else
            declare
               Left_Expr  : constant W_Expr_Id :=
                 Transform_Expr
                   (Left,
                    (if Domain = EW_Pred then EW_Term else Domain),
                    Params);
               Right_Expr : constant W_Expr_Id :=
                 Transform_Expr
                   (Right,
                    (if Domain = EW_Pred then EW_Term else Domain),
                    Params);

            begin
               if Nkind (Expr) in N_Op_Eq | N_Op_Ne then
                  T :=
                    Transform_Array_Equality
                      (Op        => Nkind (Expr),
                       Left      => Left_Expr,
                       Right     => Right_Expr,
                       Left_Type => Left_Type,
                       Domain    => Domain,
                       Ada_Node  => Expr);
               else
                  T :=
                    Transform_Array_Comparison
                      (Op       => Nkind (Expr),
                       Left     => Left_Expr,
                       Right    => Right_Expr,
                       Domain   => Domain,
                       Ada_Node => Expr);
               end if;
            end;
         end if;

      elsif Has_Access_Type (Left_Type) then

         --  For access types, there might not be a type which can act as
         --  a base type of both operands (imagine one is a named access type
         --  with a predicate and the other an anonymous type with a null
         --  exclusion). Fortunately, the root of both types should really be
         --  the same Why type, so we don't really need such a base.

         declare
            Op         : constant Node_Kind := Nkind (Expr);
            Right_Type : constant Entity_Id := Etype (Right);
            Subdomain  : constant EW_Domain :=
              (if Domain = EW_Pred then EW_Term else Domain);

            Relaxed_Init : constant Boolean :=
              Expr_Has_Relaxed_Init (Left) or Expr_Has_Relaxed_Init (Right);
            --  An access comparison does not consider the designated value. It
            --  is OK to compare partially intialized values.

            W_Left_Ty  : constant W_Type_Id :=
              EW_Abstract (Root_Retysp (Left_Type), Relaxed_Init);
            W_Right_Ty : constant W_Type_Id :=
              EW_Abstract (Root_Retysp (Right_Type), Relaxed_Init);
            Left_Expr  : constant W_Expr_Id :=
              Transform_Expr (Left, W_Left_Ty, Subdomain, Params);
            Right_Expr : constant W_Expr_Id :=
              Transform_Expr (Right, W_Right_Ty, Subdomain, Params);
         begin
            T :=
              New_Call
                (Ada_Node => Expr,
                 Domain   => Subdomain,
                 Name     =>
                   E_Symb (Root_Retysp (Left_Type), WNE_Bool_Eq, Relaxed_Init),
                 Args     => (1 => Left_Expr, 2 => Right_Expr),
                 Typ      => EW_Bool_Type);

            if Domain = EW_Pred then
               T :=
                 New_Comparison
                   (Symbol => Transform_Compare_Op (Op, EW_Bool_Type, Domain),
                    Left   => T,
                    Right  =>
                      New_Literal (Domain => Subdomain, Value => EW_True),
                    Domain => Domain);

            elsif Op = N_Op_Ne then
               T :=
                 New_Call
                   (Domain => Domain,
                    Name   => M_Boolean.Notb,
                    Args   => (1 => T),
                    Typ    => EW_Bool_Type);
            end if;
         end;

      elsif Is_Record_Type_In_Why (Left_Type) then
         T := Transform_Record_Equality (Expr, Left, Right, Domain, Params);

      else
         pragma Assert (Has_Scalar_Type (Left_Type));
         declare
            Op         : constant Node_Kind := Nkind (Expr);
            Right_Type : constant Entity_Id := Etype (Right);
            Subdomain  : constant EW_Domain :=
              (if Domain = EW_Pred then EW_Term else Domain);

            BT         : constant W_Type_Id :=
              Base_Why_Type (Left_Type, Right_Type);
            Left_Expr  : constant W_Expr_Id :=
              Transform_Expr (Left, BT, Subdomain, Params);
            Right_Expr : constant W_Expr_Id :=
              Transform_Expr (Right, BT, Subdomain, Params);
         begin
            T :=
              New_Comparison
                (Symbol => Transform_Compare_Op (Op, BT, Domain),
                 Left   => Left_Expr,
                 Right  => Right_Expr,
                 Domain => Domain);
         end;
      end if;

      return T;
   end Transform_Comparison;

   -----------------------------
   -- Transform_Concatenation --
   -----------------------------

   function Transform_Concatenation
     (Left               : W_Expr_Id;
      Right              : W_Expr_Id;
      Left_Type          : Type_Kind_Id;
      Right_Type         : Type_Kind_Id;
      Return_Type        : Type_Kind_Id;
      Is_Component_Left  : Boolean;
      Is_Component_Right : Boolean;
      Domain             : EW_Domain;
      Ada_Node           : Node_Id) return W_Expr_Id
   is
      Relaxed_Init        : constant Boolean :=
        Expr_Has_Relaxed_Init (Ada_Node, No_Eval => False);
      Left_Expr           : W_Expr_Id := Left;
      Right_Expr          : W_Expr_Id := Right;
      Args_Len            : constant Positive :=
        (if Is_Component_Left then 2 else 3)
        + (if Is_Component_Right then 1 else 3);
      Args                : W_Expr_Array (1 .. Args_Len);
      Arg_Ind             : Positive := 1;
      T                   : W_Expr_Id;
      First_Expr          : W_Expr_Id;
      Low_Type            : Entity_Id;
      Comp_Type           : constant W_Type_Id :=
        EW_Abstract
          (Component_Type (Return_Type),
           Relaxed_Init =>
             Relaxed_Init
             or else Has_Relaxed_Init (Component_Type (Return_Type)));
      Need_Reconstruction : Boolean := True;
      --  If we need to reconstruct the array after the concatenation

      function Build_Last_Expr return W_Expr_Id;
      --  build the expression that yields the value of the 'Last attribute
      --  of the concatenation. It is simply
      --    first + length of left opnd + length of right_opnd - 1
      --  Last is always computed with integer (even when dealing with modular)
      --  in order to be coherent with length which is always an integer.

      function Build_Last_No_Slide return W_Expr_Id;
      --  build the expression that yields the value of the 'Last attribute
      --  of the call to concat. It is simply
      --    last left opnd + length of right_opnd

      ---------------------
      -- Build_Last_Expr --
      ---------------------

      function Build_Last_Expr return W_Expr_Id is
         One_Term     : constant W_Expr_Id :=
           New_Discrete_Constant (Value => Uint_1, Typ => EW_Int_Type);
         Left_Length  : constant W_Expr_Id :=
           (if Is_Component_Left
            then One_Term
            else
              Build_Length_Expr
                (Domain => Domain,
                 First  => +Get_Array_Attr (+Left_Expr, Attribute_First, 1),
                 Last   => +Get_Array_Attr (+Left_Expr, Attribute_Last, 1)));
         Right_Length : constant W_Expr_Id :=
           (if Is_Component_Right
            then One_Term
            else
              Build_Length_Expr
                (Domain => Domain,
                 First  => +Get_Array_Attr (+Right_Expr, Attribute_First, 1),
                 Last   => +Get_Array_Attr (+Right_Expr, Attribute_Last, 1)));
      begin
         return
           +New_Discrete_Substract
              (Domain,
               New_Discrete_Add
                 (Domain,
                  First_Expr,
                  New_Discrete_Add (Domain, Left_Length, Right_Length),
                  EW_Int_Type),
               One_Term);
      end Build_Last_Expr;

      -------------------------
      -- Build_Last_No_Slide --
      -------------------------

      function Build_Last_No_Slide return W_Expr_Id is
         Typ          : constant W_Type_Id :=
           Nth_Index_Rep_Type_No_Bool (Return_Type, 1);
         One_Term     : constant W_Expr_Id :=
           New_Discrete_Constant (Value => Uint_1, Typ => Typ);
         Left_Last    : constant W_Expr_Id :=
           (if Is_Component_Left
            then First_Expr
            else
              New_Attribute_Expr
                (Nth_Index_Type (Return_Type, 1),
                 Domain,
                 Attribute_Last,
                 Body_Params));
         Right_Length : constant W_Expr_Id :=
           (if Is_Component_Right
            then One_Term
            else
              Build_Length_Expr
                (Domain => Domain,
                 First  => +Get_Array_Attr (+Right_Expr, Attribute_First, 1),
                 Last   => +Get_Array_Attr (+Right_Expr, Attribute_Last, 1)));
      begin
         return +New_Discrete_Add (Domain, Left_Last, Right_Length, Typ);
      end Build_Last_No_Slide;

      --  Start of processing for Transform_Concatenation

   begin
      --  Step 1: introduce temps for left and right

      Left_Expr := New_Temp_For_Expr (Left_Expr);
      Right_Expr := New_Temp_For_Expr (Right_Expr);

      --  Step 2: compute the lower bound of the concatenation
      --  See RM 4.5.3(6-7) for the rules. The test here is taken from
      --  Expand_Concatenate in exp_ch4.adb.

      Low_Type := Ultimate_Ancestor (Return_Type);

      if Is_Constrained (Low_Type) then
         First_Expr :=
           +Get_Array_Attr
              (Term_Domain (Domain), Low_Type, Attribute_First, 1);

      elsif Is_Component_Left then
         First_Expr :=
           New_Attribute_Expr
             (Nth_Index_Type (Return_Type, 1),
              Domain,
              Attribute_First,
              Body_Params);

      else
         First_Expr := +Get_Array_Attr (+Left_Expr, Attribute_First, 1);
      end if;

      --  Step 3: build the actual concatenation expression.
      --  Step 3.1: if Left is empty then concatenate returns Right. If the
      --  length of Left is known statically, return Right.

      if not Is_Component_Left
        and then Is_Static_Array_Type (Left_Type)
        and then Static_Array_Length (Left_Type, 1) = Uint_0
      then
         declare
            Right_First : constant W_Expr_Id :=
              (if Is_Component_Right
               then
                 New_Attribute_Expr
                   (Nth_Index_Type (Return_Type, 1),
                    Domain,
                    Attribute_First,
                    Body_Params)
               else +Get_Array_Attr (+Right_Expr, Attribute_First, 1));
         begin
            if Is_Component_Right then
               T :=
                 New_Singleton_Call
                   (Domain,
                    Insert_Simple_Conversion
                      (Domain => Domain, Expr => Right_Expr, To => Comp_Type),
                    Right_First,
                    Type_Of_Node (Ada_Node));
            else
               Need_Reconstruction := False;
               T := Right_Expr;
            end if;
         end;

      --  Step 3.2: Left is not statically empty, do the actual concatenation

      else
         --  We prepare the arguments to the concat call. If one of the sides
         --  is a component, need to possibly convert it to the right type
         --  (think of integer literals, need to convert to Standard__Integer).

         if Is_Component_Left then
            Args (1) :=
              Insert_Simple_Conversion
                (Ada_Node => Ada_Node,
                 Domain   => Domain,
                 Expr     => Left_Expr,
                 To       => Comp_Type);
            Args (2) := First_Expr;
            Arg_Ind := 3;
         else
            Add_Array_Arg (Domain, Args, Left_Expr, Arg_Ind);

            --  If we are expecting a partially initialized type, convert Left

            if Relaxed_Init and then not Is_Init_Wrapper_Type (Get_Type (Left))
            then
               Args (1) :=
                 New_Call
                   (Ada_Node => Ada_Node,
                    Domain   => Domain,
                    Name     => Get_Array_To_Wrapper_Name (Left_Type),
                    Args     => (1 => Args (1)),
                    Typ      => EW_Split (Left_Type, Relaxed_Init => True));
            end if;
         end if;

         if Is_Component_Right then
            Args (Arg_Ind) :=
              Insert_Simple_Conversion
                (Domain => Domain, Expr => Right_Expr, To => Comp_Type);

            Arg_Ind := Arg_Ind + 1;
         else
            Add_Array_Arg (Domain, Args, Right_Expr, Arg_Ind);

            --  If we are expecting a partially initialized type, convert Right

            if Relaxed_Init
              and then not Is_Init_Wrapper_Type (Get_Type (Right))
            then
               Args (Arg_Ind - 3) :=
                 New_Call
                   (Ada_Node => Ada_Node,
                    Domain   => Domain,
                    Name     => Get_Array_To_Wrapper_Name (Right_Type),
                    Args     => (1 => Args (Arg_Ind - 3)),
                    Typ      => EW_Split (Left_Type, Relaxed_Init => True));
            end if;
         end if;

         --  We build the call to concat

         T :=
           New_Concat_Call
             (Domain,
              Args & Build_Last_No_Slide,
              Type_Of_Node (Ada_Node),
              Is_Component_Left  => Is_Component_Left,
              Is_Component_Right => Is_Component_Right);

         --  Depending on the lower bound of the concat, the object may not be
         --  slided correctly, because the concat operator in Why assumes that
         --  the new low bound is the one of the left opnd. Correct that.

         if not Is_Component_Left and then Is_Constrained (Low_Type) then
            T :=
              New_Call
                (Domain => Domain,
                 Name   => Get_Array_Theory (Return_Type, Relaxed_Init).Slide,
                 Args   =>
                   (1 => T,
                    2 => +Get_Array_Attr (+Left_Expr, Attribute_First, 1),
                    3 => First_Expr),
                 Typ    => Type_Of_Node (Ada_Node));
         end if;
      end if;

      --  Step 4: the expression T is of the Why array type. We need to convert
      --  it to the type of the concatenation expression. This type is always
      --  unconstrained. Therefore, we need to convert to the unconstrained
      --  representation. This situation also requires a range check.

      pragma Assert (not Is_Constrained (Return_Type));

      if Need_Reconstruction then
         declare
            Target    : constant Entity_Id := Nth_Index_Type (Return_Type, 1);
            Last_Expr : W_Expr_Id := Build_Last_Expr;
         begin
            Last_Expr :=
              Insert_Simple_Conversion
                (Domain => EW_Prog,
                 Expr   =>
                   (if Domain = EW_Prog
                    then
                      +Do_Range_Check
                         (Ada_Node   => Ada_Node,
                          Ty         => Target,
                          W_Expr     => Last_Expr,
                          Check_Kind => RCK_Range)
                    else Last_Expr),
                 To     => Get_Type (First_Expr));

            T :=
              Array_Convert_From_Base
                (Domain => Domain,
                 Ty     => Return_Type,
                 Ar     => T,
                 First  => First_Expr,
                 Last   => Last_Expr);
         end;
      end if;

      --  Step 5: if the Left operand is not static, it may still be a null
      --  array. Generate a conditional for this case.

      if not Is_Component_Left and then not Is_Static_Array_Type (Left_Type)
      then
         declare
            Right_First : constant W_Expr_Id :=
              (if Is_Component_Right
               then
                 New_Attribute_Expr
                   (Nth_Index_Type (Return_Type, 1),
                    Domain,
                    Attribute_First,
                    Body_Params)
               else +Get_Array_Attr (+Right_Expr, Attribute_First, 1));
            Right_Last  : constant W_Expr_Id :=
              (if Is_Component_Right
               then Right_First
               else +Get_Array_Attr (+Right_Expr, Attribute_Last, 1));
            Right_Op    : W_Expr_Id :=
              (if Is_Component_Right
               then
                 New_Singleton_Call
                   (Domain,
                    Insert_Simple_Conversion
                      (Domain => Domain, Expr => Right_Expr, To => Comp_Type),
                    Right_First,
                    Type_Of_Node (Ada_Node))
               elsif Is_Static_Array_Type (Right_Type)
               then Right_Expr
               else
                 Array_Convert_To_Base (Domain => Domain, Ar => Right_Expr));
            Condition   : constant W_Expr_Id :=
              New_Call
                (Domain => EW_Pred,
                 Typ    => EW_Bool_Type,
                 Name   => Why_Eq,
                 Args   =>
                   (1 => +Get_Array_Attr (+Left_Expr, Attribute_Length, 1),
                    2 => New_Integer_Constant (Value => Uint_0)));

         begin
            --  If we are expecting a partially initialized type, convert Right

            if Relaxed_Init
              and then not Is_Init_Wrapper_Type (Get_Type (Right_Op))
            then
               Right_Op :=
                 New_Call
                   (Ada_Node => Ada_Node,
                    Domain   => Domain,
                    Name     => Get_Array_To_Wrapper_Name (Right_Type),
                    Args     => (1 => Right_Op),
                    Typ      => EW_Split (Right_Type, Relaxed_Init => True));
            end if;

            if not Is_Static_Array_Type (Return_Type) then
               Right_Op :=
                 Array_Convert_From_Base
                   (Domain => Domain,
                    Ty     => Return_Type,
                    Ar     => Right_Op,
                    First  => Right_First,
                    Last   => Right_Last);
            end if;

            T :=
              New_Conditional
                (Domain    => Domain,
                 Condition => Condition,
                 Then_Part => Right_Op,
                 Else_Part => T,
                 Typ       => Get_Type (T));
         end;
      end if;

      --  Step 6: bind the introduced names if any, and return

      T := Binding_For_Temp (Domain => Domain, Tmp => Left_Expr, Context => T);
      T :=
        Binding_For_Temp (Domain => Domain, Tmp => Right_Expr, Context => T);
      return T;
   end Transform_Concatenation;

   ---------------------------
   -- Transform_Declaration --
   ---------------------------

   function Transform_Declaration
     (Decl : Node_Id; Params : Transformation_Params) return W_Prog_Id
   is

      function Check_Discr_Of_Subtype (Base, Ent : Entity_Id) return W_Prog_Id;
      --  @param Ent a type entity
      --  @param Base the base type of Ent; Empty if Ent has no base type
      --  @return a program to check that the constraints on the discriminants
      --  of Ent are in fact allowed by Base. Return Void if there is nothing
      --  to check.

      function Check_Itypes_Of_Components (Ent : Entity_Id) return W_Prog_Id;
      --  @param Ent a type entity
      --  @return a program to check that the Itypes introduced for components
      --      of Ent are valid.

      function Check_Discr_Of_Subtype (Base, Ent : Entity_Id) return W_Prog_Id
      is
         R : W_Prog_Id := +Void;
      begin
         if Present (Base) and then Present (Stored_Constraint (Ent)) then
            declare
               Discr : Entity_Id :=
                 (if Has_Discriminants (Base)
                  then First_Discriminant (Base)
                  else Empty);
               Elmt  : Elmt_Id := First_Elmt (Stored_Constraint (Ent));
            begin
               while Present (Discr) loop
                  declare
                     Value   : constant Node_Id := Node (Elmt);
                     Typ     : constant W_Type_Id :=
                       Base_Why_Type_No_Bool (Node_Id'(Type_Of_Node (Value)));
                     W_Value : constant W_Expr_Id :=
                       Transform_Expr (Value, Typ, EW_Prog, Body_Params);
                  begin
                     R :=
                       New_Binding
                         (Name    => New_Identifier (Name => "_"),
                          Def     =>
                            +Do_Range_Check
                               (Ada_Node   => Value,
                                W_Expr     => W_Value,
                                Ty         => Etype (Discr),
                                Check_Kind => RCK_Range),
                          Context => +R);
                     Next_Discriminant (Discr);
                     Next_Elmt (Elmt);
                  end;
               end loop;
            end;
         end if;
         return R;
      end Check_Discr_Of_Subtype;

      --------------------------------
      -- Check_Itypes_Of_Components --
      --------------------------------

      function Check_Itypes_Of_Components (Ent : Entity_Id) return W_Prog_Id is
         N      : constant Natural :=
           (if not Is_Constrained (Ent) then Count_Discriminants (Ent) else 0);
         Vars   : W_Identifier_Array (1 .. N);
         Vals   : W_Prog_Array (1 .. N);
         Discr  : Entity_Id :=
           (if N > 0 then First_Discriminant (Ent) else Empty);
         Checks : W_Prog_Id := +Void;
         I      : Positive := 1;
         Rec_Id : constant W_Identifier_Id :=
           New_Temp_Identifier (Base_Name => "rec", Typ => EW_Abstract (Ent));
         --  Identifier for a record object to be used in predicate checks for
         --  components.
         Prop   : W_Pred_Id := True_Pred;
         --  Assume values of the discriminants of Rec_Id

      begin
         --  For:
         --     type My_Rec (D : T) is record
         --       A : Array_Type (1 .. D);
         --       R : Rec_Type (D);
         --     end record;
         --  Generate:
         --     let d = any T in
         --     let rec = any My_Rec { result.d = d }
         --       pred_A rec ->
         --          check_scalar_range (Array_Type (1 .. D), Array_Type);
         --       pred_R rec ->
         --          check_discr_of_subtype (Rec_Type (D), Rec_Type)
         --  where pred_A and pred_R denote whether components A and R are
         --  present in rec.

         Ada_Ent_To_Why.Push_Scope (Symbol_Table);

         --  For unconstrained types with discriminants, store a value for each
         --  discriminant in the symbol table as discrimiants can appear in
         --  Type constraints of components. Don't do it for constrained type.
         --  Indeed, discriminants of constrained types cannot be used for
         --  new component definitions.

         while Present (Discr) loop
            declare
               Typ : constant W_Type_Id := Type_Of_Node (Discr);
            begin
               Vars (I) :=
                 New_Temp_Identifier
                   (Base_Name => Short_Name (Discr), Typ => Typ);
               Insert_Tmp_Item_For_Entity (Discr, Vars (I));

               Vals (I) :=
                 New_Any_Statement
                   (Post        =>
                      Compute_Dynamic_Invariant
                        (Expr        => +New_Result_Ident (Typ),
                         Ty          => Etype (Discr),
                         Initialized => True_Term,
                         Params      => Params),
                    Return_Type => Typ);

               --  Assume that Rec_Id has Vars (I) for discriminant Discr

               Prop :=
                 New_And_Pred
                   (Left  => Prop,
                    Right =>
                      New_Comparison
                        (Symbol => Why_Eq,
                         Left   =>
                           Insert_Simple_Conversion
                             (Expr =>
                                New_Ada_Record_Access
                                  (Ada_Node => Empty,
                                   Name     =>
                                     +New_Result_Ident (Get_Typ (Rec_Id)),
                                   Field    => Discr,
                                   Ty       => Ent),
                              To   => Typ),
                         Right  => +Vars (I)));
            end;
            I := I + 1;
            Next_Discriminant (Discr);
         end loop;

         --  For each component declared in Ent for the first type, check the
         --  constraints on the introduced Itype if any.

         for Comp of Get_Component_Set (Ent) loop
            if Ekind (Comp) = E_Component
              and then Original_Declaration (Comp) = Ent
              and then Is_Itype (Etype (Comp))
            then
               declare
                  Typ   : constant Entity_Id := Retysp (Etype (Comp));
                  Base  : constant Entity_Id := Retysp (Etype (Typ));
                  Check : W_Prog_Id := +Void;

               begin
                  --  Check range constraint of array indexes

                  if Has_Array_Type (Typ) and then not Is_Constrained (Base)
                  then
                     declare
                        Index      : Node_Id := First_Index (Typ);
                        Index_Base : Node_Id := First_Index (Base);
                     begin

                        while Present (Index) loop
                           Check :=
                             Check_Scalar_Range
                               (Params => Params,
                                N      => Etype (Index),
                                Base   => Etype (Index_Base));

                           Next_Index (Index);
                           Next_Index (Index_Base);
                        end loop;
                     end;

                  --  And discriminants of record / private / concurrent types

                  elsif Has_Discriminants (Typ)
                    and then not Is_Constrained (Base)
                  then
                     Check := Check_Discr_Of_Subtype (Base, Typ);
                  end if;

                  --  Only perform checks on a component if the component is
                  --  present in the object.

                  if N > 0 then
                     Check :=
                       New_Conditional
                         (Condition =>
                            New_Ada_Record_Check_For_Field
                              (Name => +Rec_Id, Field => Comp, Ty => Ent),
                          Then_Part => Check);
                  end if;

                  Prepend (Check, Checks);
               end;
            end if;
         end loop;

         if Checks /= +Void and then N /= 0 then

            --  Introduce a binding for Rec_Id

            Checks :=
              New_Typed_Binding
                (Name    => Rec_Id,
                 Def     =>
                   New_Any_Statement
                     (Post => Prop, Return_Type => Get_Typ (Rec_Id)),
                 Context => Checks);

            --  Introduce bindings for the discriminants

            for I in Vars'Range loop
               Checks :=
                 New_Typed_Binding
                   (Name => Vars (I), Def => Vals (I), Context => Checks);
            end loop;
         end if;

         Ada_Ent_To_Why.Pop_Scope (Symbol_Table);

         return Checks;
      end Check_Itypes_Of_Components;

      R : W_Prog_Id := +Void;

      --  Start of processing for Transform_Declaration

   begin
      case Nkind (Decl) is
         when N_Object_Declaration                            =>
            declare
               Obj      : constant Entity_Id := Defining_Identifier (Decl);
               Obj_Type : constant Entity_Id := Etype (Obj);

               Lvalue : constant Entity_Id :=
                 (if Is_Full_View (Obj) then Partial_View (Obj) else Obj);
            begin
               --  Non-scalar object declaration should not appear before the
               --  loop invariant in a loop.

               pragma
                 Assert
                   (not Is_In_Loop_Initial_Statements
                    or else
                      (Is_Scalar_Type (Obj_Type) and then Is_Loop_Entity (Obj))
                    or else Is_Actions_Entity (Obj));

               R := Assignment_Of_Obj_Decl (Decl);

               --  Assume dynamic invariant of the object

               if not Is_Partial_View (Obj) then
                  declare
                     Obj_Expr    : constant W_Term_Id :=
                       +Transform_Identifier
                          (Expr   => Lvalue,
                           Ent    => Lvalue,
                           Domain => EW_Term,
                           Params => Params);
                     Initialized : constant Boolean :=
                       Present (Expression (Decl))
                       or else Ekind (Obj) = E_Constant
                       or else Is_Imported (Obj);
                  begin
                     Append
                       (R,
                        Assume_Dynamic_Invariant
                          (Expr        => Obj_Expr,
                           Ty          => Etype (Lvalue),
                           Valid       =>
                             Get_Valid_Id_From_Object
                               (Obj, Ref_Allowed => True),
                           Initialized => Initialized,
                           Only_Var    => False));

                     --  For mutable overlays, assume the dynamic invariant
                     --  of the overlay for all values of the root object.

                     if Present (Ultimate_Overlaid_Entity (Obj))
                       and then Is_Mutable_In_Why (Obj)
                     then
                        Assume_Dynamic_Invariant_For_Overlay (Obj, Params, R);
                     end if;

                     --  Check the type invariant of constants with no
                     --  variable inputs.

                     if Ekind (Obj) = E_Constant
                       and then not Is_Access_Variable (Etype (Obj))
                       and then not Has_Variable_Input (Obj)
                       and then Is_Library_Level_Entity (Obj)
                       and then
                         Invariant_Check_Needed
                           (Obj_Type, Scop => Current_Subp)
                     then
                        pragma Assert (not Is_Mutable_In_Why (Obj));
                        Append
                          (R,
                           New_Invariant_Check
                             (Ada_Node => Decl,
                              Ty       => Obj_Type,
                              W_Expr   => Obj_Expr));
                     end if;
                  end;
               end if;

               --  In the case of a precisely supported address specificatiom,
               --  we emit a static check that the type of the object is OK
               --  for address clauses.

               if Present (Get_Address_Expr (Decl)) then
                  declare
                     Address         : constant Node_Id :=
                       Get_Address_Expr (Decl);
                     Address_Why     : W_Prog_Id :=
                       +Transform_Expr (Address, EW_Prog, Params);
                     Aliased_Object  : constant Entity_Id :=
                       Overlaid_Entity (Obj);
                     Supported_Alias : constant Boolean :=
                       Present (Aliased_Object);

                     Valid       : Boolean;
                     Explanation : Unbounded_String;
                     Obj_Ty      : constant Type_Kind_Id :=
                       Retysp (Etype (Obj));

                  begin
                     --  The check is needed only for overlays between two
                     --  SPARK objects.

                     if Supported_Alias then

                        --  If the overlay is constant, Obj cannot be modified.
                        --  No need to check for source of UC.

                        if not Is_Constant_In_SPARK (Obj) then
                           Object_Suitable_For_UC_Source
                             (Obj, Valid, Explanation);
                           Emit_Static_Proof_Result
                             (Decl,
                              VC_UC_Source,
                              Valid,
                              Current_Subp,
                              Explanation => To_String (Explanation));
                        end if;

                        --  Don't emit validity checks if Obj is potentially
                        --  invalid.

                        Suitable_For_UC_Target_Overlay_Wrap
                          (Typ            => Obj_Ty,
                           Obj            => Obj,
                           Result         => Valid,
                           Explanation    => Explanation,
                           Check_Validity => not Is_Potentially_Invalid (Obj));

                        Emit_Static_Proof_Result
                          (Decl,
                           VC_UC_Target,
                           Valid,
                           Current_Subp,
                           Explanation => To_String (Explanation));

                        --  We now emit static checks to make sure the two
                        --  aliased objects are compatible.

                        declare
                           Valid       : Boolean;
                           Explanation : Unbounded_String;
                           Pref        : constant Node_Id := Prefix (Address);
                           Addr_Ty     : constant Type_Kind_Id :=
                             Retysp (Etype (Pref));
                        begin

                           Object_Suitable_For_UC_Source
                             (Pref, Valid, Explanation);
                           Emit_Static_Proof_Result
                             (Address,
                              VC_UC_Source,
                              Valid,
                              Current_Subp,
                              Explanation => To_String (Explanation));
                           --  If Aliased_Object is constant, it is OK if if
                           --  its type permits invalid values as the alias
                           --  cannot be used to modify it.

                           Suitable_For_UC_Target_Overlay_Wrap
                             (Typ            => Addr_Ty,
                              Obj            => Pref,
                              Result         => Valid,
                              Explanation    => Explanation,
                              Check_Validity =>
                                not Is_Constant_In_SPARK (Aliased_Object));

                           Emit_Static_Proof_Result
                             (Address,
                              VC_UC_Target,
                              Valid,
                              Current_Subp,
                              Explanation => To_String (Explanation));
                           Insert_Check_For_Size_Of_Overlays
                             (Address, Obj, Pref, R, Params);
                           Compatible_Alignments
                             (Obj, Pref, Valid, Explanation);
                           Emit_Static_Proof_Result
                             (Decl,
                              VC_UC_Align_Overlay,
                              Valid,
                              Current_Subp,
                              Explanation => To_String (Explanation));
                        end;

                     --  For imprecisely supported address clauses, we have an
                     --  explicit alignment check.

                     else
                        declare
                           Tmp   : constant W_Term_Id :=
                             New_Temp_For_Expr (W_Expr_Id'(+Address_Why));
                           Align : constant Uint :=
                             Get_Attribute_Value (Obj, Attribute_Alignment);
                           Pred  : W_Pred_Id := False_Pred;
                           W_Typ : constant W_Type_Id :=
                             Base_Why_Type_No_Bool (Get_Type (+Tmp));

                        begin
                           if Present (Align) then
                              Pred :=
                                New_Comparison
                                  (Symbol => Why_Eq,
                                   Left   =>
                                     New_Call
                                       (Name =>
                                          (if W_Typ = EW_Int_Type
                                           then M_Int_Div.Mod_Id
                                           else MF_BVs (W_Typ).Urem),
                                        Args =>
                                          (1 =>
                                             Insert_Simple_Conversion
                                               (Ada_Node => Decl,
                                                Domain   => EW_Term,
                                                Expr     => +Tmp,
                                                To       => W_Typ),
                                           2 =>
                                             New_Discrete_Constant
                                               (Value => Align, Typ => W_Typ)),
                                        Typ  => W_Typ),
                                   Right  =>
                                     New_Discrete_Constant
                                       (Value => Uint_0, Typ => W_Typ));
                           end if;
                           Address_Why :=
                             New_Located_Assert
                               (Ada_Node => Decl,
                                Pred     => Pred,
                                Reason   => VC_UC_Align_Overlay,
                                Kind     => EW_Assert);
                           Address_Why :=
                             Binding_For_Temp
                               (Tmp => Tmp, Context => Address_Why);
                        end;
                     end if;

                     --  RTE checks for the address clause.

                     R := +Sequence (New_Ignore (Prog => +Address_Why), R);
                  end;
               end if;
            end;

         --  Uses of object renamings are rewritten by expansion, but the name
         --  is still being evaluated at the location of the renaming, even
         --  if there are no uses of the renaming. Check absence of RTE when
         --  evaluating that name. Skip type conversions and qualifications in
         --  doing that, as these are not part of the evaluation of the name.

         when N_Object_Renaming_Declaration                   =>
            R :=
              New_Ignore
                (Prog => Transform_Prog (Unqual_Conv (Name (Decl)), Params));

         when N_Subtype_Declaration | N_Full_Type_Declaration =>
            declare
               Ent : constant Entity_Id :=
                 Retysp (Unique_Defining_Entity (Decl));

               Base : Entity_Id;
               --  ??? this name is rather unfortunate, because we will assign
               --  "Base" with the "Parent_Type".

            begin
               --  Check for absence of run-time errors when the type
               --  declaration is not simply a renaming of an existing type.
               --  This avoids duplicating checks for every such renaming. Do
               --  not generate checks for actual subtypes as they should be
               --  correct by construction.

               pragma Assert (Entity_In_SPARK (Ent));

               if not Is_Type_Renaming (Decl)
                 and then not Is_Actual_Subtype (Ent)
               then
                  Base := Get_Parent_Type_If_Check_Needed (Decl);

                  if Present (Base) then
                     Base := Retysp (Base);
                  end if;

                  case Ekind (Ent) is
                     when Scalar_Kind                =>

                        --  Scalar type declarations can only require checks
                        --  when either their range is non-static, or their
                        --  Base type is not static.

                        if (Present (Base)
                            and then
                              not SPARK_Atree.Is_OK_Static_Range
                                    (Get_Range (Base)))
                          or else
                            not SPARK_Atree.Is_OK_Static_Range
                                  (Get_Range (Ent))
                        then
                           R :=
                             Check_Scalar_Range
                               (Params => Params, N => Ent, Base => Base);
                        end if;

                     when Array_Kind                 =>
                        declare
                           Index      : Node_Id;
                           Index_Base : Entity_Id;
                           Typ        : constant Node_Id :=
                             Component_Subtype_Indication (Decl);
                           Check_Idx  : constant Boolean :=
                             No (Base)
                             or else
                               (not Is_Constrained (Base)
                                and then
                                  (Is_Constrained (Ent)
                                   or else
                                     Is_Fixed_Lower_Bound_Array_Subtype
                                       (Ent)));
                           --  We only need to check the index types of Ent if
                           --  either there is no Base or Base is unconstrained
                           --  and Ent has some constraints.

                        begin
                           --  If the component type of the array has a
                           --  non-static subtype_indication, we generate a
                           --  check that the range_constraint is compatible
                           --  with the subtype.

                           if Present (Typ)
                             and then No (Base)
                             and then Nkind (Typ) = N_Subtype_Indication
                             and then Comes_From_Source (Original_Node (Typ))
                           then
                              Prepend
                                (Check_Subtype_Indication
                                   (Params   => Params,
                                    N        => Typ,
                                    Sub_Type => Component_Type (Ent)),
                                 R);
                           end if;

                           --  For each discrete_subtype_definition that is a
                           --  non-static subtype_indication, we generate a
                           --  check that the range_constraint is compatible
                           --  with the subtype.

                           if Check_Idx then
                              Index := First_Index (Ent);
                              while Present (Index) loop
                                 if Nkind (Index) = N_Subtype_Indication
                                   and then
                                     Comes_From_Source (Original_Node (Index))
                                 then
                                    Prepend
                                      (Check_Subtype_Indication
                                         (Params   => Params,
                                          N        => Index,
                                          Sub_Type => Etype (Index)),
                                       R);
                                 end if;

                                 Next_Index (Index);
                              end loop;
                           end if;

                           --  For each range_constraint of an array subtype,
                           --  we generate a check that it is compatible with
                           --  the subtype of the corresponding index in the
                           --  base array type.

                           if Present (Base) and then Check_Idx then
                              Index := First_Index (Ent);
                              Index_Base := First_Index (Base);
                              while Present (Index) loop
                                 if Comes_From_Source (Original_Node (Index))
                                 then
                                    Prepend
                                      (Check_Scalar_Range
                                         (Params => Params,
                                          N      => Etype (Index),
                                          Base   => Etype (Index_Base)),
                                       R);

                                    --  If the index type has a fixed first
                                    --  bound in Base, check that Ent has the
                                    --  same first bound.

                                    if Is_Fixed_Lower_Bound_Index_Subtype
                                         (Etype (Index_Base))
                                    then
                                       Prepend
                                         (New_Located_Assert
                                            (Ada_Node => Etype (Index),
                                             Pred     =>
                                               +New_Comparison
                                                  (Symbol => Why_Eq,
                                                   Left   =>
                                                     New_Attribute_Expr
                                                       (Ty     =>
                                                          Etype (Index),
                                                        Domain => EW_Term,
                                                        Attr   =>
                                                          Attribute_First,
                                                        Params => Params),
                                                   Right  =>
                                                     New_Attribute_Expr
                                                       (Ty     =>
                                                          Etype (Index_Base),
                                                        Domain => EW_Term,
                                                        Attr   =>
                                                          Attribute_First,
                                                        Params => Params),
                                                   Domain => EW_Pred),
                                             Reason   => VC_Range_Check,
                                             Kind     => EW_Assert),
                                          R);
                                    end if;
                                 end if;
                                 Next_Index (Index);
                                 Next_Index (Index_Base);
                              end loop;
                           end if;
                        end;

                     when E_Record_Type
                        | E_Record_Subtype
                        | Concurrent_Kind
                        | Incomplete_Or_Private_Kind =>
                        --  For each component_definition that is a non-static
                        --  subtype_indication, we generate a check that the
                        --  range_constraint is compatible with the subtype. It
                        --  is not necessary to do that check on discriminants,
                        --  as the type of discriminants are directly
                        --  subtype_marks, not subtype_indications.
                        --  We only check newly declared components as
                        --  inherited components should be checked as part of
                        --  some ancestor type declaration.

                        if Ekind (Ent) in E_Record_Type | E_Record_Subtype then
                           declare
                              Typ : Node_Id;
                           begin
                              for Comp of Get_Component_Set (Ent) loop
                                 if Ekind (Comp) = E_Component
                                   and then Original_Declaration (Comp) = Ent
                                 then
                                    Typ :=
                                      Subtype_Indication
                                        (Component_Definition
                                           (Enclosing_Declaration (Comp)));

                                    if Present (Typ)
                                      and then
                                        Nkind (Typ) = N_Subtype_Indication
                                      and then
                                        Comes_From_Source (Original_Node (Typ))
                                    then
                                       Prepend
                                         (Check_Subtype_Indication
                                            (Params   => Params,
                                             N        => Typ,
                                             Sub_Type => Etype (Comp)),
                                          R);
                                    end if;
                                 end if;
                              end loop;
                           end;
                        end if;

                        --  We need to check that the new discriminants of the
                        --  subtype fit into the base type.

                        Prepend (Check_Discr_Of_Subtype (Base, Ent), R);

                        if Ekind (Ent)
                           in E_Record_Type
                            | E_Record_Subtype
                            | Concurrent_Kind
                        then
                           Prepend (Check_Itypes_Of_Components (Ent), R);
                        end if;

                     when E_Access_Type
                        | E_Access_Subtype
                        | E_Access_Subprogram_Type
                        | E_General_Access_Type      =>
                        null;

                     when others                     =>
                        Ada.Text_IO.Put_Line
                          ("[Transform_Declaration] ekind ="
                           & Entity_Kind'Image (Ekind (Ent)));
                        raise Not_Implemented;
                  end case;
               end if;

               --  If the type has an invariant, check that there can be no
               --  runtime error in the type invariant. If the type, one of its
               --  ancestors, or one of its components has an invariant, check
               --  that default values of the type and all its subtypes respect
               --  the invariant.

               if Nkind (Decl) = N_Full_Type_Declaration
                 and then Invariant_Check_Needed (Ent, Scop => Current_Subp)
               then
                  Append
                    (R,
                     Check_Type_With_Invariants (Params => Params, N => Ent));
               end if;
            end;

         when N_Protected_Type_Declaration                    =>
            declare
               Ent : constant Entity_Id :=
                 Retysp (Unique_Defining_Entity (Decl));
            begin
               if Entity_In_SPARK (Ent) then
                  Prepend (Check_Itypes_Of_Components (Ent), R);
               end if;
            end;

         when N_Pragma                                        =>
            R := Transform_Pragma (Decl, Params, Force => False);

         when N_Package_Body | N_Package_Declaration          =>

            --  Assume declaration of objects from the nested package and
            --  potentially its initial condition.

            declare
               E : constant Entity_Id := Unique_Defining_Entity (Decl);
            begin
               if not Is_Generic_Unit (E) and then Entity_In_SPARK (E) then
                  Assume_For_Nested_Package
                    (E        => E,
                     Params   => Params,
                     Assumes  => R,
                     For_Decl => Nkind (Decl) = N_Package_Declaration,
                     For_Body =>
                       Nkind (Decl) = N_Package_Body
                       or else No (Package_Body (E)));
               end if;
            end;

         when N_Itype_Reference                               =>
            declare
               Assoc : constant Node_Id :=
                 Associated_Node_For_Itype (Itype (Decl));
            begin
               if Nkind (Assoc) in N_Has_Etype then
                  return New_Ignore (Prog => Transform_Prog (Assoc, Params));
               else
                  return +Void;
               end if;
            end;

         --  Block statements can occur for inlined function calls

         when N_Block_Statement                               =>
            R := Transform_Block_Statement (Decl, Params);

         when N_Ignored_In_SPARK
            | N_Task_Type_Declaration
            | N_Subprogram_Body
            | N_Protected_Body
            | N_Task_Body
            | N_Abstract_Subprogram_Declaration
            | N_Subprogram_Declaration
            | N_Entry_Declaration
            | N_Private_Extension_Declaration
            | N_Private_Type_Declaration
            | N_Component_Declaration                         =>
            null;

         when N_Raise_xxx_Error                               =>

            pragma Assert (No (Condition (Decl)));
            return Transform_Unhandled_Raise (Decl);

         when others                                          =>
            Ada.Text_IO.Put_Line
              ("[Transform_Declaration] kind = "
               & Node_Kind'Image (Nkind (Decl)));
            raise Not_Implemented;
      end case;

      --  Aspect or representation clause Address may involve computations
      --  that could lead to a RTE. Thus we need to check absence of RTE in
      --  the corresponding expression.

      if Nkind (Decl) = N_Subprogram_Declaration then
         declare
            Expr : constant Node_Id := Get_Address_Expr (Decl);
         begin
            --  We generate the expression of the address for runtime checks

            if Present (Expr) then
               declare
                  Why_Expr : constant W_Expr_Id :=
                    Transform_Expr (Expr, EW_Prog, Params);
               begin
                  R := +Sequence (New_Ignore (Prog => +Why_Expr), R);
               end;
            end if;
         end;
      end if;

      return +Insert_Cnt_Loc_Label (Decl, +R);
   end Transform_Declaration;

   ----------------------------
   -- Transform_Declarations --
   ----------------------------

   function Transform_Declarations
     (L : List_Id; Params : Transformation_Params) return W_Prog_Id
   is
      Cur_Decl : Node_Id := First (L);
      Result   : W_Statement_Sequence_Id := Void_Sequence;

   begin
      while Present (Cur_Decl) loop
         Append (Result, Transform_Declaration (Cur_Decl, Params));
         Next (Cur_Decl);
      end loop;
      return +Result;
   end Transform_Declarations;

   ----------------------------------
   -- Transform_Declarations_Block --
   ----------------------------------

   function Transform_Declarations_Block
     (L : List_Id; Core : W_Prog_Id; Params : Transformation_Params)
      return W_Prog_Id
   is
      Result : W_Statement_Sequence_Id := +Transform_Declarations (L, Params);

   begin
      Append (Result, Core);
      return +Result;
   end Transform_Declarations_Block;

   -------------------------------
   -- Transform_Delta_Aggregate --
   -------------------------------

   function Transform_Delta_Aggregate
     (Ada_Node : Node_Id;
      Pref     : N_Subexpr_Id;
      Aggr     : N_Aggregate_Kind_Id;
      Domain   : EW_Domain;
      Params   : Transformation_Params) return W_Expr_Id
   is
      Pref_Typ : constant Entity_Id := Retysp (Etype (Pref));
      W_Pref   : W_Expr_Id;
      T        : W_Expr_Id;

   begin
      if Is_Deep_Delta_Aggregate (Ada_Node) then
         T :=
           Transform_Deep_Delta_Aggregate
             (Expr => Ada_Node, Domain => Domain, Params => Params);

      elsif Is_Record_Type (Pref_Typ) then
         W_Pref :=
           Transform_Expr
             (Domain        => Domain,
              Expr          => Pref,
              Params        => Params,
              Expected_Type =>
                EW_Abstract
                  (Pref_Typ,
                   Relaxed_Init =>
                     Expr_Has_Relaxed_Init (Ada_Node, No_Eval => False)));

         --  Introduce a temporary for the prefix to avoid recomputing it
         --  several times if Pref_Typ has discriminants.

         W_Pref := New_Temp_For_Expr (W_Pref, Has_Discriminants (Pref_Typ));

         --  As discriminants may occur as bounds in types of
         --  discriminant dependent components, store them in the
         --  symbol table.

         declare
            Num_Discrs : constant Natural := Count_Discriminants (Pref_Typ);
            Tmps       : W_Identifier_Array (1 .. Num_Discrs);
            Vals       : W_Expr_Array (1 .. Num_Discrs);
         begin
            Ada_Ent_To_Why.Push_Scope (Symbol_Table);
            if Num_Discrs > 0 then
               declare
                  D : Entity_Id := First_Discriminant (Pref_Typ);
               begin
                  for I in 1 .. Num_Discrs loop
                     Tmps (I) :=
                       New_Temp_Identifier (Typ => EW_Abstract (Etype (D)));
                     Vals (I) :=
                       New_Ada_Record_Access
                         (Ada_Node => Empty,
                          Domain   => EW_Term,
                          Name     => W_Pref,
                          Field    => D,
                          Ty       => Pref_Typ);

                     Insert_Tmp_Item_For_Entity (D, Tmps (I));

                     Next_Discriminant (D);
                  end loop;
                  pragma Assert (No (D));
               end;
            end if;

            --  Transform the associations. We don't expect any new
            --  discriminants here so the corresponding OUT parameters are
            --  empty. Missing fields are not relevant either, we keep the
            --  existing values for them.

            declare
               Dummy_Ids    : W_Identifier_Array (1 .. 0);
               Dummy_Vals   : W_Expr_Array (1 .. 0);
               Dummy_Fields : Component_Sets.Set;
            begin
               T :=
                 New_Ada_Record_Update
                   (Name    => W_Pref,
                    Domain  => Domain,
                    Updates =>
                      Transform_Record_Component_Associations
                        (Domain             => Domain,
                         Typ                => Pref_Typ,
                         Assocs             => Component_Associations (Aggr),
                         Params             => Params,
                         In_Delta_Aggregate => True,
                         Relaxed_Init       =>
                           Get_Relaxed_Init (Get_Type (W_Pref)),
                         Discr_Ids          => Dummy_Ids,
                         Discr_Vals         => Dummy_Vals,
                         Missing_Fields     => Dummy_Fields));
            end;

            --  If we are in the program domain and Pref_Typ has discriminants,
            --  check that selectors are present in the prefix.

            if Domain = EW_Prog and then Has_Discriminants (Pref_Typ) then
               declare
                  Association : Node_Id :=
                    Nlists.First (Component_Associations (Aggr));
                  Choice      : Node_Id;
                  Checks      : W_Statement_Sequence_Id := Void_Sequence;
               begin
                  while Present (Association) loop
                     Choice := First (Choice_List (Association));

                     while Present (Choice) loop
                        Append
                          (Checks,
                           (New_Ignore
                              (Prog =>
                                 New_Ada_Record_Access
                                   (Ada_Node => Choice,
                                    Name     => +W_Pref,
                                    Field    =>
                                      Search_Component_In_Type
                                        (Pref_Typ, Entity (Choice)),
                                    Ty       => Pref_Typ))));
                        Next (Choice);
                     end loop;
                     Next (Association);
                  end loop;

                  Prepend (+Checks, T);
               end;
            end if;

            --  If the target type has a direct or inherited
            --  predicate, generate a corresponding check.

            if Domain = EW_Prog and then Has_Predicates (Pref_Typ) then
               T :=
                 +Insert_Predicate_Check
                    (Ada_Node => Ada_Node, Check_Ty => Pref_Typ, W_Expr => +T);
            end if;

            --  Add bindings for discriminants

            for I in 1 .. Num_Discrs loop
               T :=
                 New_Binding
                   (Domain  => Domain,
                    Name    => Tmps (I),
                    Def     => Vals (I),
                    Context => T,
                    Typ     => Get_Type (T));
            end loop;
            Ada_Ent_To_Why.Pop_Scope (Symbol_Table);

            T :=
              Binding_For_Temp
                (Ada_Node => Ada_Node,
                 Domain   => Domain,
                 Tmp      => W_Pref,
                 Context  => T);
         end;

      else
         pragma Assert (Is_Array_Type (Pref_Typ));
         T :=
           Transform_Array_Aggregate
             (Params        => Params,
              Domain        => Domain,
              Expr          => Aggr,
              Update_Prefix => Pref,
              Relaxed_Init  =>
                Expr_Has_Relaxed_Init (Ada_Node, No_Eval => False));
      end if;

      --  Detect possible resource leaks in the assignment of component
      --  associations.

      declare
         function Has_Deep_Association (Assocs : List_Id) return Boolean;
         --  Returns whether the list of component associations Assocs
         --  has a deep component.

         --------------------------
         -- Has_Deep_Association --
         --------------------------

         function Has_Deep_Association (Assocs : List_Id) return Boolean is
            Assoc : Node_Id := Nlists.First (Assocs);
         begin
            while Present (Assoc) loop
               if not Box_Present (Assoc)
                 and then Is_Deep (Etype (Expression (Assoc)))
               then
                  return True;
               end if;
               Next (Assoc);
            end loop;

            return False;
         end Has_Deep_Association;

      begin
         --  If all associations in the delta aggregate are not deep, then
         --  there is no possibility of a resource leak when moving the prefix
         --  and assigning component associations in turn. There is also no
         --  possibility of move unless the delta aggregate appears directly
         --  or indirectly on the rhs of an assignment, due to SPARK RM 3.10(6)
         --  which prevents using the aggregate as the prefix of an enclosing
         --  expression. Otherwise, it is correct over-approximation to check
         --  that the prefix before any update does not own any memory. We
         --  could improve on that if this is too imprecise for real code.

         --  The case of delta aggregates involving array indexes with aliasing
         --  between choices has already been rejected during marking, to
         --  ensure that these cannot lead to a memory leak, even if the
         --  prefix did not own memory initially.

         if Has_Deep_Association (Component_Associations (Aggr))
           and then Aggregate_Is_In_Assignment (Aggr)
         then
            Prepend (Check_No_Memory_Leaks (Pref, Pref), T);
         end if;
      end;

      return T;
   end Transform_Delta_Aggregate;

   -------------------------------
   -- Transform_Discrete_Choice --
   -------------------------------

   function Transform_Discrete_Choice
     (Choice      : Node_Id;
      Choice_Type : Opt_Type_Kind_Id;
      Expr        : W_Expr_Id;
      Domain      : EW_Domain;
      Params      : Transformation_Params) return W_Expr_Id
   is
      Subdomain : constant EW_Domain :=
        (if Domain = EW_Pred then EW_Term else Domain);
      Is_Range  : constant Boolean := Discrete_Choice_Is_Range (Choice);

      R : W_Expr_Id;
   begin
      if Nkind (Choice) = N_Others_Choice then
         R := Bool_True (Domain);

      --  When the choice denotes a subtype with a static predicate, check the
      --  expression against the predicate values.

      elsif (Nkind (Choice) = N_Subtype_Indication
             or else
               (Is_Entity_Name (Choice) and then Is_Type (Entity (Choice))))
        and then Has_Predicates (Etype (Choice))
        and then Has_Static_Predicate (Etype (Choice))
      then
         pragma Assert (Is_Discrete_Type (Etype (Choice)));
         R :=
           Transform_Discrete_Choices
             (Static_Discrete_Predicate (Etype (Choice)),
              Choice_Type,
              Expr,
              Domain,
              Params);

      elsif Is_Range then
         R := Range_Expr (Choice, Expr, Domain, Params);

         --  In programs, we generate a check that the range_constraint of a
         --  subtype_indication is compatible with the given subtype.

         if Domain = EW_Prog then
            pragma Assert (Present (Choice_Type));
            Prepend
              (Check_Scalar_Range
                 (Params => Params, N => Choice, Base => Choice_Type),
               R);
         end if;

      else
         declare
            Base_Ty : constant W_Type_Id := Get_Type (Expr);
            --  We need to get the base Why type from Expr (not Choice) as the
            --  context (typically index choice in array aggregates) may impose
            --  EW_Int_Type for Boolean-Valued choices.

            Need_Check : constant Boolean :=
              Domain = EW_Prog
              and then
                (not Is_OK_Static_Expression (Choice)
                 or else not Has_OK_Static_Scalar_Subtype (Choice_Type));
            W_Choice   : W_Expr_Id :=
              Transform_Expr
                (Expr          => Choice,
                 Expected_Type => Base_Ty,
                 Domain        => Subdomain,
                 Params        => Params);
         begin
            if Need_Check then
               W_Choice := New_Temp_For_Expr (W_Choice);
            end if;

            R :=
              New_Comparison
                (Symbol => Transform_Compare_Op (N_Op_Eq, Base_Ty, Domain),
                 Left   => Expr,
                 Right  => W_Choice,
                 Domain => Domain);

            --  In programs, we generate a check that the non-static value of a
            --  choice belongs to the given subtype.

            if Need_Check then
               pragma Assert (Present (Choice_Type));
               Prepend
                 (New_Ignore
                    (Prog =>
                       Do_Range_Check
                         (Ada_Node   => Choice,
                          Ty         => Choice_Type,
                          W_Expr     =>
                            Insert_Simple_Conversion
                              (Domain => Domain,
                               Expr   => W_Choice,
                               To     => Base_Why_Type_No_Bool (Base_Ty)),
                          Check_Kind => RCK_Range)),
                  R);
               R :=
                 Binding_For_Temp
                   (Domain => Domain, Tmp => W_Choice, Context => R);
            end if;
         end;
      end if;

      return R;
   end Transform_Discrete_Choice;

   --------------------------------
   -- Transform_Discrete_Choices --
   --------------------------------

   function Transform_Discrete_Choices
     (Choices      : List_Id;
      Choice_Type  : Opt_Type_Kind_Id;
      Matched_Expr : W_Expr_Id;
      Cond_Domain  : EW_Domain;
      Params       : Transformation_Params) return W_Expr_Id
   is
      Cur_Choice : Node_Id := First (Choices);
      C          : W_Expr_Id :=
        New_Literal (Domain => Cond_Domain, Value => EW_False);
   begin
      while Present (Cur_Choice) loop
         C :=
           New_Or_Else_Expr
             (C,
              Transform_Discrete_Choice
                (Choice      => Cur_Choice,
                 Choice_Type => Choice_Type,
                 Expr        => Matched_Expr,
                 Domain      => Cond_Domain,
                 Params      => Params),
              Cond_Domain);
         Next (Cur_Choice);
      end loop;
      return C;
   end Transform_Discrete_Choices;

   --------------------
   -- Transform_Expr --
   --------------------

   function Transform_Expr
     (Expr              : N_Subexpr_Id;
      Expected_Type     : W_Type_Id;
      Domain            : EW_Domain;
      Params            : Transformation_Params;
      No_Init_Check     : Boolean := False;
      No_Validity_Check : Boolean := False) return W_Expr_Id
   is
      Expr_Type    : constant Entity_Id := Retysp (Etype (Expr));
      T            : W_Expr_Id;
      Pretty_Label : Symbol := No_Symbol;
      Local_Params : Transformation_Params := Params;

   begin
      --  We check whether we need to generate a pretty printing label. If we
      --  do, we set the corresponding flag to "GM_None" so that the label is
      --  not printed for subterms.
      --  Our intention is to skip printing pretty-printing labels when not
      --  needed (predicate is just a single item, without conjunction,
      --  quantification, etc). So we skip the printing at the top level of the
      --  term, and set label generation for subterms, unless we are already at
      --  a terminal node.

      if Domain = EW_Pred then
         case Local_Params.Gen_Marker is
            when GM_Label    =>
               if Is_Terminal_Node (Expr) then
                  Pretty_Label := New_Sub_VC_Marker (Expr);
                  Local_Params.Gen_Marker := GM_None;
               end if;

            when GM_Toplevel =>
               if Is_Terminal_Node (Expr) then
                  Local_Params.Gen_Marker := GM_None;
               else
                  Local_Params.Gen_Marker := GM_Label;
               end if;

            when GM_None     =>
               null;
         end case;
      end if;

      --  Special case for Standard.True and Standard.False as predicates

      if Domain = EW_Pred
        and then Nkind (Expr) in N_Identifier | N_Expanded_Name
        and then Ekind (Entity (Expr)) = E_Enumeration_Literal
        and then Entity (Expr) in Standard_True | Standard_False
      then
         if Entity (Expr) = Standard_True then
            return Bool_True (Domain);
         else
            return Bool_False (Domain);
         end if;

      --  Expressions that cannot be translated to predicates directly are
      --  translated to (boolean) terms, and compared to "True".
      --  - Boolean connectors, predicate expressions and declare expressions
      --  - Boolean operators which are not private intrinsinc
      --  - Calls to predicate functions
      --  - Calls to hardcoded operators
      --  - Calls to logical equality

      elsif Domain = EW_Pred
        and then
          not (Nkind (Expr)
               in N_And_Then
                | N_Or_Else
                | N_In
                | N_If_Expression
                | N_Quantified_Expression
                | N_Expression_With_Actions
                | N_Case_Expression)
        and then
          not (Nkind (Expr) in N_Op_Compare | N_Op_Not | N_Op_And | N_Op_Or
               and then not Is_Private_Intrinsic_Op (Expr))
        and then
          not (Nkind (Expr) = N_Function_Call
               and then Ekind (Get_Called_Entity_For_Proof (Expr)) = E_Function
               and then
                 Is_Predicate_Function (Get_Called_Entity_For_Proof (Expr)))
        and then
          not (Nkind (Expr) = N_Function_Call
               and then Ekind (Get_Called_Entity_For_Proof (Expr)) = E_Function
               and then
                 Is_Hardcoded_Comparison (Get_Called_Entity_For_Proof (Expr)))
        and then
          not (Nkind (Expr) = N_Function_Call
               and then Ekind (Get_Called_Entity_For_Proof (Expr)) = E_Function
               and then
                 Has_Logical_Eq_Annotation
                   (Get_Called_Entity_For_Proof (Expr)))
      then
         T :=
           +Pred_Of_Boolean_Term
              (Transform_Term (Expr, EW_Bool_Type, Local_Params));

      --  Optimization: if we have a discrete value that is statically known,
      --  use the static value.

      elsif Domain /= EW_Pred
        and then Is_Discrete_Type (Expr_Type)
        and then Compile_Time_Known_Value (Expr)
      then
         T :=
           New_Discrete_Constant
             (Value => Expr_Value (Expr), Typ => Base_Why_Type (Expr_Type));

      --  Intrinsic operators should be translated as function calls in SPARK
      --  if the intrinsic pragma is located in a part with SPARK_Mode Off.
      --  However, a crash will only occur if the base type on which the
      --  operator applies is private in SPARK. Thus, we only check for this
      --  case here. This may result in SPARK being a little too smart and
      --  knowing the value of operators even if their intrinsic pragma
      --  should not be visible.

      elsif Nkind (Expr) in N_Op
        and then Nkind (Expr) not in N_Op_Eq | N_Op_Ne
        and then Is_Private_Intrinsic_Op (Expr)
      then
         T := Transform_Function_Call (Expr, Domain, Local_Params);

      else
         case Nkind (Expr) is
            when N_Aggregate                            =>
               if Is_Container_Aggregate (Expr) then
                  T := Transform_Container_Aggregate (Expr, Params, Domain);

               elsif Is_Record_Type (Expr_Type) then
                  pragma Assert (Is_Empty_List (Expressions (Expr)));

                  --  If the type is an empty record in Why (no tag, no field,
                  --  no discriminant), we use the dummy node of the root type
                  --  here.

                  if Count_Why_Top_Level_Fields (Expr_Type) = 0 then
                     return +E_Symb (Root_Retysp (Expr_Type), WNE_Dummy);
                  else
                     declare
                        Relaxed_Init : constant Boolean :=
                          Expr_Has_Relaxed_Init (Expr, No_Eval => False);
                        Num_Discrs   : constant Natural :=
                          Count_Non_Inherited_Discriminants
                            (Component_Associations (Expr));

                        Discr_Ids  : W_Identifier_Array (1 .. Num_Discrs);
                        Discr_Vals : W_Expr_Array (1 .. Num_Discrs);
                        --  Arrays that will contain the bindings for
                        --  discriminants

                        Missing_Fields : Component_Sets.Set;

                        Assocs : constant W_Field_Association_Array :=
                          Transform_Record_Component_Associations
                            (Domain,
                             Expr_Type,
                             Component_Associations (Expr),
                             Local_Params,
                             Relaxed_Init   => Relaxed_Init,
                             Discr_Ids      => Discr_Ids,
                             Discr_Vals     => Discr_Vals,
                             Missing_Fields => Missing_Fields);
                     begin
                        T :=
                          New_Ada_Record_Aggregate
                            (Ada_Node       => Expr,
                             Domain         => Domain,
                             Discr_Assocs   => Assocs (1 .. Num_Discrs),
                             Field_Assocs   =>
                               Assocs (Num_Discrs + 1 .. Assocs'Last),
                             Ty             => Expr_Type,
                             Missing_Fields => Missing_Fields,
                             Relaxed_Init   => Relaxed_Init);

                        --  Add the bindings for the discriminants

                        for I in 1 .. Num_Discrs loop
                           T :=
                             New_Binding
                               (Domain  => Domain,
                                Name    => Discr_Ids (I),
                                Def     => Discr_Vals (I),
                                Context => T,
                                Typ     => Get_Type (T));
                        end loop;
                     end;
                  end if;
               else
                  pragma
                    Assert
                      (Is_Array_Type (Expr_Type)
                       or else Is_String_Type (Expr_Type));

                  T :=
                    Transform_Array_Aggregate
                      (Params       => Local_Params,
                       Domain       => Domain,
                       Expr         => Expr,
                       Relaxed_Init =>
                         Expr_Has_Relaxed_Init (Expr, No_Eval => False));
               end if;

            when N_Extension_Aggregate                  =>
               declare
                  Relaxed_Init : constant Boolean :=
                    Expr_Has_Relaxed_Init (Expr, No_Eval => False);

                  Dummy_Ids      : W_Identifier_Array (1 .. 0);
                  Dummy_Vals     : W_Expr_Array (1 .. 0);
                  --  We don't expect any new discriminants here so the
                  --  corresponding OUT parameters are empty.
                  Missing_Fields : Component_Sets.Set;

                  Assocs : constant W_Field_Association_Array :=
                    Transform_Record_Component_Associations
                      (Domain,
                       Expr_Type,
                       Component_Associations (Expr),
                       Local_Params,
                       In_Extension   => True,
                       Relaxed_Init   => Relaxed_Init,
                       Discr_Ids      => Dummy_Ids,
                       Discr_Vals     => Dummy_Vals,
                       Missing_Fields => Missing_Fields);

                  --  Use the base type of the ancestor part as intermediate
                  --  type to which the ancestor is converted if needed before
                  --  copying its fields to the extension aggregate. This takes
                  --  care of generating a dummy value for unused components in
                  --  a discriminant record, if needed.

                  Prefix_Ty : constant Entity_Id :=
                    Retysp (Etype (Ancestor_Part (Expr)));
                  Anc_Ty    : constant Entity_Id :=
                    (if Ekind (Prefix_Ty)
                        in E_Record_Subtype | E_Record_Subtype_With_Private
                     then Retysp (Etype (Prefix_Ty))
                     else Prefix_Ty);

                  Anc_Expr       : constant W_Expr_Id :=
                    Transform_Expr
                      (Ancestor_Part (Expr),
                       Type_Of_Node (Anc_Ty),
                       Domain,
                       Params);
                  Tmp            : constant W_Expr_Id :=
                    New_Temp_For_Expr (Anc_Expr);
                  Anc_Num_Fields : constant Natural :=
                    Count_Why_Regular_Fields (Anc_Ty) - 1;

                  --  The number of fields in the ancestor type minus the tag

                  Anc_Discr_Expr   : W_Expr_Id;
                  Anc_Field_Assocs :
                    W_Field_Association_Array (1 .. Anc_Num_Fields);

               begin
                  Generate_Associations_From_Ancestor
                    (Ada_Node       => Expr,
                     Domain         => Domain,
                     Expr           => Tmp,
                     Anc_Ty         => Anc_Ty,
                     Ty             => Expr_Type,
                     Discr_Expr     => Anc_Discr_Expr,
                     Field_Assocs   => Anc_Field_Assocs,
                     Missing_Fields => Missing_Fields);
                  T :=
                    New_Ada_Record_Aggregate
                      (Ada_Node       => Expr,
                       Domain         => Domain,
                       Discr_Expr     => Anc_Discr_Expr,
                       Field_Assocs   => Anc_Field_Assocs & Assocs,
                       Ty             => Expr_Type,
                       Missing_Fields => Missing_Fields,
                       Relaxed_Init   => Relaxed_Init);
                  T :=
                    Binding_For_Temp
                      (Domain => Domain, Tmp => Tmp, Context => T);
               end;

            when N_Slice                                =>

               --  If Expr is potentially_Invalid, emit a validity check on the
               --  access so it is as precise as possible.

               if Domain = EW_Prog
                 and then not No_Validity_Check
                 and then Is_Potentially_Invalid_Expr (Expr)
               then
                  declare
                     Valid_Flag : W_Expr_Id;
                     Context    : Ref_Context;
                     W_Expr     : W_Expr_Id :=
                       Transform_Potentially_Invalid_Expr
                         (Expr          => Expr,
                          Expected_Type => Expected_Type,
                          Domain        => Domain,
                          Params        => Local_Params,
                          Context       => Context,
                          Valid_Flag    => Valid_Flag,
                          No_Checks     => False);

                  begin
                     W_Expr := New_Temp_For_Expr (W_Expr);

                     T :=
                       +Sequence
                          (New_Located_Assert
                             (Ada_Node => Expr,
                              Pred     =>
                                +New_Is_Valid_Call_For_Expr
                                   (Tree   => Valid_Flag,
                                    Ty     => Etype (Expr),
                                    Expr   => W_Expr,
                                    Domain => EW_Pred),
                              Reason   => VC_Validity_Check,
                              Kind     => EW_Assert),
                           +W_Expr);
                     T :=
                       Binding_For_Temp
                         (Domain => Domain, Tmp => W_Expr, Context => T);
                     T := Bindings_For_Ref_Context (T, Context, Domain);
                  end;
               else
                  T :=
                    Transform_Slice
                      (Expr,
                       Transform_Expr
                         (Prefix (Expr),
                          Domain,
                          Local_Params,
                          No_Validity_Check => True),
                       Local_Params,
                       Domain);
               end if;

            when N_Real_Literal                         =>

               --  Literals of fixed-point type are directly translated into
               --  the integer that represents them in the corresponding
               --  fixed-point type.

               if Is_Fixed_Point_Type (Expr_Type) then
                  T :=
                    New_Fixed_Constant
                      (Ada_Node => Expr,
                       Value    => Corresponding_Integer_Value (Expr),
                       Typ      => Base_Why_Type (Expr_Type));

               --  It can happen that the literal is a universal real which is
               --  converted into a fixed point type, we then simply return a
               --  real constant.

               elsif Is_Universal_Numeric_Type (Expr_Type) then
                  T :=
                    New_Real_Constant
                      (Ada_Node => Expr, Value => Realval (Expr));

               else
                  T :=
                    New_Float_Constant
                      (Ada_Node => Expr,
                       Value    => Realval (Expr),
                       Typ      =>
                         (if Has_Single_Precision_Floating_Point_Type
                               (Expr_Type)
                          then EW_Float_32_Type
                          elsif Has_Double_Precision_Floating_Point_Type
                                  (Expr_Type)
                          then EW_Float_64_Type
                          elsif Has_Extended_Precision_Floating_Point_Type
                                  (Expr_Type)
                          then EW_Float_80_Type
                          else raise Program_Error));
               end if;

            when N_Character_Literal                    =>
               T :=
                 New_Integer_Constant
                   (Ada_Node => Expr, Value => Char_Literal_Value (Expr));

            --  Deal with identifiers:
            --  * Enumeration literals: deal with special cases True and
            --    False, otherwise such literals are just constants
            --  * local variables are always references
            --  * global constants are logics in Why
            --  * global mutable variables are references
            --  * loop parameters are always mutable, and of type int

            when N_String_Literal                       =>
               T := Transform_String_Literal (Expr, Domain, Params);

            when N_Identifier | N_Expanded_Name         =>
               T :=
                 Transform_Identifier
                   (Local_Params,
                    Expr,
                    Entity (Expr),
                    Domain,
                    No_Init_Check     => No_Init_Check,
                    No_Validity_Check => No_Validity_Check);

            when N_Op_Compare                           =>

               T :=
                 Transform_Comparison
                   (Expr => Expr, Domain => Domain, Params => Local_Params);

            when N_Op_Minus                             =>
               --  unary minus
               declare
                  Right : constant N_Subexpr_Id := Right_Opnd (Expr);
                  Typ   : constant W_Type_Id := Base_Why_Type (Right);

                  Minus_Ident : constant W_Identifier_Id :=
                    (if Typ = EW_Int_Type
                     then Int_Unary_Minus
                     elsif Why_Type_Is_BitVector (Typ)
                     then MF_BVs (Typ).Neg
                     elsif Why_Type_Is_Fixed (Typ)
                     then Fixed_Unary_Minus
                     else MF_Floats (Typ).Unary_Minus);

                  Right_Rep : constant W_Expr_Id :=
                    Transform_Expr (Right, Typ, Domain, Local_Params);

                  Check_No_Wrap_Around : constant Boolean :=
                    Domain = EW_Prog
                    and then Has_No_Wrap_Around_Annotation (Expr_Type);

               begin
                  if Has_Modular_Integer_Type (Expr_Type)
                    and then Non_Binary_Modulus (Expr_Type)
                    and then
                      not Has_No_Bitwise_Operations_Annotation (Expr_Type)
                  then
                     T :=
                       Transform_Non_Binary_Modular_Operation
                         (Ada_Node   => Expr,
                          Ada_Type   => Expr_Type,
                          Domain     => Domain,
                          Op         => N_Op_Minus,
                          Right_Opnd => Right_Rep,
                          Rep_Type   => Typ,
                          Modulus    => Modulus (Expr_Type));
                  else
                     T :=
                       New_Call
                         (Domain   => Domain,
                          Ada_Node => Expr,
                          Name     => Minus_Ident,
                          Args     => (1 => Right_Rep),
                          Typ      => Typ);

                     if not Check_No_Wrap_Around then
                        T := Apply_Modulus (N_Op_Minus, Expr_Type, T, Domain);
                     end if;
                  end if;

                  --  If the type is subject to No_Wrap_Around annotation and
                  --  we need to insert a check, there are two cases:
                  --
                  --  . The type is also subject to No_Bitwise_Operations
                  --    annotation, hence its base type in Why is "int" and we
                  --    can check the absence of wrap around on the result of
                  --    the operation, provided we did not apply modulo on the
                  --    result.
                  --
                  --  . Otherwise, we need to check the absence of wrap around
                  --    before evaluating the operation in bitvectors.

                  if Check_No_Wrap_Around then
                     if Has_No_Bitwise_Operations_Annotation (Expr_Type) then
                        T :=
                          +Do_Range_Check
                             (Ada_Node   => Expr,
                              Ty         => Expr_Type,
                              W_Expr     => T,
                              Check_Kind => RCK_Overflow);
                     else
                        declare
                           Check : constant W_Prog_Id :=
                             Check_No_Wrap_Around_Modular_Operation
                               (Ada_Node   => Expr,
                                Ada_Type   => Expr_Type,
                                Op         => N_Op_Minus,
                                Right_Opnd => Right_Rep,
                                Rep_Type   => Typ,
                                Modulus    => Modulus (Expr_Type));
                        begin
                           Prepend (Check, T);
                        end;
                     end if;
                  end if;
               end;

            when N_Op_Plus                              =>
               --  unary plus
               declare
                  Right : constant N_Subexpr_Id := Right_Opnd (Expr);
               begin
                  T :=
                    Transform_Expr
                      (Right, Base_Why_Type (Right), Domain, Local_Params);
               end;

            when N_Op_Abs                               =>
               declare
                  Right : constant N_Subexpr_Id := Right_Opnd (Expr);
                  Typ   : constant W_Type_Id := Base_Why_Type (Right);

                  Right_Rep : constant W_Expr_Id :=
                    Transform_Expr (Right, Typ, Domain, Local_Params);
               begin
                  T :=
                    New_Call
                      (Ada_Node => Expr,
                       Domain   => Domain,
                       Name     => New_Abs (Typ),
                       Args     => (1 => Right_Rep),
                       Typ      => Typ);
               end;

            when N_Op_Add | N_Op_Subtract               =>
               declare
                  Left       : constant N_Subexpr_Id := Left_Opnd (Expr);
                  Right      : constant N_Subexpr_Id := Right_Opnd (Expr);
                  Base       : constant W_Type_Id :=
                    Base_Why_Type (Left, Right);
                  Left_Expr  : constant W_Expr_Id :=
                    Transform_Expr (Left, Base, Domain, Local_Params);
                  Right_Expr : constant W_Expr_Id :=
                    Transform_Expr (Right, Base, Domain, Local_Params);
               begin
                  T :=
                    New_Binary_Op_Expr
                      (Op          => Nkind (Expr),
                       Left        => Left_Expr,
                       Right       => Right_Expr,
                       Left_Type   => Etype (Left),
                       Right_Type  => Etype (Right),
                       Return_Type => Expr_Type,
                       Domain      => Domain,
                       Ada_Node    => Expr);
               end;

            when N_Op_Multiply | N_Op_Divide            =>
               declare
                  Left           : constant N_Subexpr_Id := Left_Opnd (Expr);
                  Right          : constant N_Subexpr_Id := Right_Opnd (Expr);
                  L_Type, R_Type : W_Type_Id;
                  L_Why, R_Why   : W_Expr_Id;
               begin
                  if Has_Fixed_Point_Type (Etype (Left))
                    and then Has_Fixed_Point_Type (Etype (Right))
                  then
                     --  Multiplication/division between fixed-point types
                     --  requires the creation of a specific module.

                     Create_Fixed_Point_Mult_Div_Theory_If_Needed
                       (Typ_Left   => Etype (Left),
                        Typ_Right  => Etype (Right),
                        Typ_Result => Expr_Type,
                        Expr       => Expr);

                     L_Type := Base_Why_Type (Etype (Left));
                     R_Type := Base_Why_Type (Etype (Right));

                  elsif Has_Fixed_Point_Type (Etype (Left)) then
                     L_Type := Base_Why_Type (Etype (Left));
                     R_Type := EW_Int_Type;

                  elsif Nkind (Expr) = N_Op_Multiply
                    and then Has_Fixed_Point_Type (Etype (Right))
                  then
                     L_Type := EW_Int_Type;
                     R_Type := Base_Why_Type (Etype (Right));

                  else
                     L_Type := Base_Why_Type (Left, Right);
                     R_Type := Base_Why_Type (Left, Right);
                  end if;

                  L_Why := Transform_Expr (Left, L_Type, Domain, Local_Params);
                  R_Why :=
                    Transform_Expr (Right, R_Type, Domain, Local_Params);

                  T :=
                    New_Binary_Op_Expr
                      (Op          => Nkind (Expr),
                       Left        => L_Why,
                       Right       => R_Why,
                       Left_Type   => Etype (Left),
                       Right_Type  => Etype (Right),
                       Return_Type => Expr_Type,
                       Domain      => Domain,
                       Ada_Node    => Expr);
               end;

            when N_Op_Rem | N_Op_Mod                    =>
               declare
                  Left  : constant N_Subexpr_Id := Left_Opnd (Expr);
                  Right : constant N_Subexpr_Id := Right_Opnd (Expr);
                  Base  : constant W_Type_Id := Base_Why_Type (Left, Right);
                  Lty   : constant Type_Kind_Id := Etype (Left);
                  Rty   : constant Type_Kind_Id := Etype (Right);
                  LT    : constant W_Expr_Id :=
                    Transform_Expr (Left, Base, Domain, Local_Params);
                  RT    : constant W_Expr_Id :=
                    Transform_Expr (Right, Base, Domain, Local_Params);
               begin
                  if Is_Hardcoded_Operation (Nkind (Expr), Lty, Rty) then
                     T :=
                       Transform_Hardcoded_Operation
                         (Nkind (Expr),
                          Lty,
                          Rty,
                          Expr_Type,
                          LT,
                          RT,
                          Domain,
                          Expr);
                  else
                     T :=
                       New_Binary_Op_Expr
                         (Op          => Nkind (Expr),
                          Left        => LT,
                          Right       => RT,
                          Left_Type   => Lty,
                          Right_Type  => Rty,
                          Return_Type => Expr_Type,
                          Domain      => Domain,
                          Ada_Node    => Expr);
                  end if;
               end;

            when N_Op_Expon                             =>

               --  Optimization: try to inline the exponentiation when
               --  possible. This optimization is primarly intended for
               --  floating-points, hence we only inline the exponentiation for
               --  power between -3 and 3. Indeed, the Ada RM does not
               --  guarantee that beyond those values the exponentiation is
               --  equal to a specific factorisation (float multiplication is
               --  commutative but not associative). Since the code is mostly
               --  generic and the inlining seems to help the provers, the
               --  optimization is not limited to floating-points
               --  exponentiation.

               N_Op_Expon_Case : declare
                  Left      : constant N_Subexpr_Id := Left_Opnd (Expr);
                  Right     : constant N_Subexpr_Id := Right_Opnd (Expr);
                  W_Right   : constant W_Expr_Id :=
                    Transform_Expr
                      (Right,
                       Type_Of_Node (Standard_Natural),
                       Domain,
                       Local_Params);
                  Base_Type : constant W_Type_Id := Base_Why_Type (Left);
                  W_Left    : constant W_Expr_Id :=
                    Transform_Expr (Left, Base_Type, Domain, Local_Params);
                  Left_Type : constant Type_Kind_Id := Etype (Left);

                  One : constant W_Expr_Id :=
                    (if Has_Modular_Integer_Type (Left_Type)
                     then
                       (if Has_No_Bitwise_Operations_Annotation (Left_Type)
                        then
                          New_Integer_Constant
                            (Ada_Node => Expr, Value => Uint_1)
                        else
                          New_Modular_Constant
                            (Ada_Node => Expr,
                             Value    => Uint_1,
                             Typ      => Base_Type))
                     elsif Has_Signed_Integer_Type (Left_Type)
                     then
                       New_Integer_Constant (Ada_Node => Expr, Value => Uint_1)
                     elsif Has_Floating_Point_Type (Left_Type)
                     then +MF_Floats (Base_Type).One
                     else raise Program_Error);

                  function Square
                    (X : W_Expr_Id; T : Type_Kind_Id) return W_Expr_Id
                  is (New_Binary_Op_Expr
                        (Op          => N_Op_Multiply,
                         Left        => X,
                         Right       => X,
                         Left_Type   => T,
                         Right_Type  => T,
                         Return_Type => Expr_Type,
                         Domain      => Domain,
                         Ada_Node    => Expr));

                  function Cube
                    (X : W_Expr_Id; T : Type_Kind_Id) return W_Expr_Id
                  is (New_Binary_Op_Expr
                        (Op          => N_Op_Multiply,
                         Left        => X,
                         Right       => Square (X, T),
                         Left_Type   => T,
                         Right_Type  => T,
                         Return_Type => Expr_Type,
                         Domain      => Domain,
                         Ada_Node    => Expr));

                  function Inv
                    (X : W_Expr_Id; T : Type_Kind_Id) return W_Expr_Id;
                  --  Return 1 / X
                  --  Insert a division check depending on the domain

                  function Inv
                    (X : W_Expr_Id; T : Type_Kind_Id) return W_Expr_Id
                  is
                     Tmp : constant W_Expr_Id :=
                       New_Temp_For_Expr (X, Need_Temp => Domain = EW_Prog);
                     E   : W_Expr_Id :=
                       New_Binary_Op_Expr
                         (Op          => N_Op_Divide,
                          Left        => One,
                          Right       => Tmp,
                          Left_Type   => T,
                          Right_Type  => T,
                          Return_Type => Expr_Type,
                          Domain      => Domain);

                  begin
                     if Domain = EW_Prog then
                        declare
                           Check : constant W_Prog_Id :=
                             New_Located_Assert
                               (Ada_Node   => Expr,
                                Pred       =>
                                  New_Comparison
                                    (Why_Neq,
                                     +Tmp,
                                     +MF_Floats (Base_Type).Plus_Zero),
                                Reason     => VC_Division_Check,
                                Check_Info => New_Check_Info (Divisor => Left),
                                Kind       => EW_Assert);
                        begin
                           Prepend (Check, E);
                        end;
                     end if;

                     return
                       Binding_For_Temp
                         (Ada_Node => Expr,
                          Domain   => Domain,
                          Tmp      => Tmp,
                          Context  => E);
                  end Inv;

                  Check_No_Wrap_Around : constant Boolean :=
                    Domain = EW_Prog
                    and then Has_No_Wrap_Around_Annotation (Expr_Type);

                  --  Start of processing for N_Op_Expon_Case

               begin
                  --  Translate powers of 2 on modular types as shifts. If the
                  --  modulus is not a power of two, this cannot be done as the
                  --  power computation must not wrap-around on the rep
                  --  bitvector type.

                  if Has_Modular_Integer_Type (Left_Type)
                    and then
                      not Has_No_Bitwise_Operations_Annotation (Left_Type)
                    and then not Non_Binary_Modulus (Left_Type)
                    and then Compile_Time_Known_Value (Left)
                    and then Expr_Value (Left) = Uint_2
                  then
                     declare
                        Expo : constant W_Expr_Id :=
                          New_Temp_For_Expr (W_Right);
                     begin
                        T :=
                          New_Call
                            (Ada_Node => Expr,
                             Domain   => Domain,
                             Name     => MF_BVs (Base_Type).Lsl,
                             Args     =>
                               (1 =>
                                  New_Modular_Constant
                                    (Value => Uint_1, Typ => Base_Type),
                                2 =>
                                  Insert_Simple_Conversion
                                    (Domain => Domain,
                                     Expr   => Expo,
                                     To     => Base_Type)),
                             Typ      => Base_Type);

                        --  If the exponent does not fit in the modular type,
                        --  return 0.

                        T :=
                          New_Conditional
                            (Domain    => Domain,
                             Condition =>
                               New_Comparison
                                 (Symbol => Int_Infix_Lt,
                                  Left   =>
                                    Insert_Simple_Conversion
                                      (Domain => EW_Term,
                                       Expr   => Expo,
                                       To     => EW_Int_Type),
                                  Right  => +MF_BVs (Base_Type).Two_Power_Size,
                                  Domain => EW_Pred),
                             Then_Part => T,
                             Else_Part =>
                               New_Modular_Constant
                                 (Value => Uint_0, Typ => Base_Type),
                             Typ       => Base_Type);

                        --  Apply the modulus if it is smaller than the modulus
                        --  of the rep bitvector type.

                        T :=
                          Apply_Modulus (Nkind (Expr), Left_Type, T, Domain);
                        T :=
                          Binding_For_Temp
                            (Domain => Domain, Tmp => Expo, Context => T);

                        --  Deal separately with no wrap-around on exponential
                        --  in this case, as New_Binary_Op_Expr is not called,
                        --  yet there could be an overflow.

                        if Check_No_Wrap_Around then
                           declare
                              Check : constant W_Prog_Id :=
                                Check_No_Wrap_Around_Modular_Operation
                                  (Ada_Node   => Expr,
                                   Ada_Type   => Expr_Type,
                                   Op         => N_Op_Expon,
                                   Left_Opnd  => W_Left,
                                   Right_Opnd => W_Right,
                                   Rep_Type   => Base_Type,
                                   Modulus    => Modulus (Expr_Type));
                           begin
                              Prepend (Check, T);
                           end;
                        end if;
                     end;

                  --  Static exponentiation up to 3 are expanded into
                  --  equivalent multiplications.

                  elsif Nkind (Right) = N_Integer_Literal then
                     declare
                        Exp : constant Uint := Intval (Right);
                     begin
                        if UI_Eq (Exp, Uint_0) then
                           if Domain = EW_Prog then
                              T :=
                                +Sequence (New_Ignore (Prog => +W_Left), +One);
                           else
                              T := One;
                           end if;
                        elsif UI_Eq (Exp, Uint_1) then
                           T := W_Left;
                        elsif UI_Eq (Exp, Uint_2) then
                           T := Square (W_Left, Left_Type);
                        elsif UI_Eq (Exp, Uint_3) then
                           T := Cube (W_Left, Left_Type);
                        elsif UI_Eq (Exp, UI_Negate (Uint_1)) then
                           T := Inv (W_Left, Left_Type);
                        elsif UI_Eq (Exp, UI_Negate (Uint_2)) then
                           T := Inv (Square (W_Left, Left_Type), Left_Type);
                        elsif UI_Eq (Exp, UI_Negate (Uint_3)) then
                           T := Inv (Cube (W_Left, Left_Type), Left_Type);
                        else
                           T :=
                             New_Binary_Op_Expr
                               (Op          => N_Op_Expon,
                                Left        => W_Left,
                                Right       => W_Right,
                                Left_Type   => Left_Type,
                                Right_Type  => Etype (Right),
                                Return_Type => Expr_Type,
                                Domain      => Domain,
                                Ada_Node    => Expr);
                        end if;
                     end;
                  else
                     T :=
                       New_Binary_Op_Expr
                         (Op          => N_Op_Expon,
                          Left        => W_Left,
                          Right       => W_Right,
                          Left_Type   => Etype (Left),
                          Right_Type  => Etype (Right),
                          Return_Type => Expr_Type,
                          Domain      => Domain,
                          Ada_Node    => Expr);
                  end if;
               end N_Op_Expon_Case;

            when N_Op_Not                               =>
               if Has_Array_Type (Etype (Right_Opnd (Expr))) then
                  declare
                     Subdomain : constant EW_Domain :=
                       (if Domain = EW_Pred then EW_Term else Domain);
                  begin
                     T :=
                       Transform_Array_Negation
                         (Right      =>
                            Transform_Expr
                              (Right_Opnd (Expr), Subdomain, Params),
                          Right_Type => Etype (Right_Opnd (Expr)),
                          Domain     => Domain,
                          Ada_Node   => Expr,
                          Do_Check   => Domain = EW_Prog);
                  end;

               elsif Is_Modular_Integer_Type (Expr_Type) then
                  declare
                     Base : constant W_Type_Id := Base_Why_Type (Expr_Type);
                  begin
                     T :=
                       New_Call
                         (Ada_Node => Expr,
                          Domain   => Domain,
                          Name     => MF_BVs (Base).BW_Not,
                          Args     =>
                            (1 =>
                               Transform_Expr
                                 (Right_Opnd (Expr),
                                  Base,
                                  Domain,
                                  Local_Params)),
                          Typ      => Base);

                     --  The negation can overflow, so we need to apply a
                     --  modulus operation.

                     T :=
                       Apply_Modulus
                         (Op     => N_Op_Not,
                          E      => Expr_Type,
                          T      => T,
                          Domain => Domain);
                  end;

               else
                  declare
                     Right : constant W_Expr_Id :=
                       Transform_Expr
                         (Right_Opnd (Expr),
                          EW_Bool_Type,
                          Domain,
                          Local_Params);
                  begin
                     if Domain = EW_Term then
                        T :=
                          New_Call
                            (Ada_Node => Expr,
                             Domain   => Domain,
                             Name     => M_Boolean.Notb,
                             Args     => (1 => Right),
                             Typ      => EW_Bool_Type);
                     else
                        T := New_Not (Right => Right, Domain => Domain);
                     end if;
                  end;
               end if;

            when N_Op_And | N_Op_Or | N_Op_Xor          =>
               if Has_Array_Type (Etype (Left_Opnd (Expr))) then
                  declare
                     Subdomain : constant EW_Domain :=
                       (if Domain = EW_Pred then EW_Term else Domain);
                  begin

                     T :=
                       Transform_Array_Logical_Op
                         (Op        => Nkind (Expr),
                          Left      =>
                            Transform_Expr
                              (Left_Opnd (Expr), Subdomain, Params),
                          Right     =>
                            Transform_Expr
                              (Right_Opnd (Expr), Subdomain, Params),
                          Left_Type => Etype (Left_Opnd (Expr)),
                          Domain    => Domain,
                          Ada_Node  => Expr,
                          Do_Check  => Domain = EW_Prog);
                  end;
               else
                  declare
                     Op    : constant Node_Kind := Nkind (Expr);
                     Base  : constant W_Type_Id :=
                       (if Is_Boolean_Type (Expr_Type)
                        then EW_Bool_Type
                        else Base_Why_Type (Expr_Type));
                     Left  : constant W_Expr_Id :=
                       Transform_Expr
                         (Left_Opnd (Expr), Base, Domain, Local_Params);
                     Right : constant W_Expr_Id :=
                       Transform_Expr
                         (Right_Opnd (Expr), Base, Domain, Local_Params);
                  begin
                     if Op = N_Op_And then
                        T := New_And_Expr (Left, Right, Domain, Base);
                     else
                        if Op = N_Op_Or then
                           T := New_Or_Expr (Left, Right, Domain, Base);
                        else
                           T := New_Xor_Expr (Left, Right, Domain, Base);
                        end if;

                        --  If we're dealing with modulars of non binary
                        --  modulus or and xor might overflow : we need to take
                        --  the modulo of the result.

                        if Has_Modular_Integer_Type (Expr_Type)
                          and then Non_Binary_Modulus (Expr_Type)
                        then
                           T :=
                             Apply_Modulus
                               (Op     => Op,
                                E      => Expr_Type,
                                T      => T,
                                Domain => Domain);
                        end if;
                     end if;
                  end;
               end if;

            when N_Short_Circuit                        =>
               Short_Circuit : declare

                  function New_Short_Circuit_Expr
                    (Left, Right : W_Expr_Id; Domain : EW_Domain)
                     return W_Expr_Id;
                  --  Dispatch over functions to create a short-circuit Why
                  --  expr

                  ----------------------------
                  -- New_Short_Circuit_Expr --
                  ----------------------------

                  function New_Short_Circuit_Expr
                    (Left, Right : W_Expr_Id; Domain : EW_Domain)
                     return W_Expr_Id is
                  begin
                     if Nkind (Expr) = N_And_Then then
                        return New_And_Then_Expr (Left, Right, Domain);
                     else
                        return New_Or_Else_Expr (Left, Right, Domain);
                     end if;
                  end New_Short_Circuit_Expr;

                  Left_N : constant Node_Id := Left_Opnd (Expr);
                  Left   : constant W_Expr_Id :=
                    Transform_Expr
                      (Left_N, EW_Bool_Type, Domain, Local_Params);
                  Right  : W_Expr_Id;

                  Warn_On_Right : constant Boolean :=
                    Local_Params.Warn_On_Dead
                    and then
                      (if Nkind (Expr) = N_And_Then
                       then
                         not Exp_Util.Is_Statically_Disabled
                               (Left_N, False, Include_Valid => True)
                       else
                         not Exp_Util.Is_Statically_Disabled
                               (Left_N, True, Include_Valid => True));
                  Right_Params  : constant Transformation_Params :=
                    (Local_Params with delta Warn_On_Dead => Warn_On_Right);
                  --  Do not emit dead branch warnings in Right if Left is
                  --  statically disabled.

                  --  Start of processing for Short_Circuit

               begin
                  Ada_Ent_To_Why.Push_Scope (Symbol_Table);

                  if Present (Actions (Expr)) then
                     Transform_Actions_Preparation (Actions (Expr));
                  end if;

                  Right :=
                    Transform_Expr
                      (Right_Opnd (Expr), EW_Bool_Type, Domain, Right_Params);

                  --  Possibly warn on an unreachable right branch

                  if Domain = EW_Prog then
                     Right :=
                       +Warn_On_Dead_Branch
                          (Right_Opnd (Expr),
                           +Right,
                           Local_Params.Phase,
                           Warn_On_Right);
                  end if;

                  if Present (Actions (Expr)) then
                     Right :=
                       Transform_Actions
                         (Actions (Expr), Right, Domain, Local_Params);
                  end if;

                  T :=
                    New_Short_Circuit_Expr
                      (Left => Left, Right => Right, Domain => Domain);

                  Ada_Ent_To_Why.Pop_Scope (Symbol_Table);
               end Short_Circuit;

            when N_Op_Concat                            =>
               T :=
                 Transform_Concatenation
                   (Left               =>
                      Transform_Expr (Left_Opnd (Expr), Domain, Params),
                    Right              =>
                      Transform_Expr (Right_Opnd (Expr), Domain, Params),
                    Left_Type          => Etype (Left_Opnd (Expr)),
                    Right_Type         => Etype (Right_Opnd (Expr)),
                    Return_Type        => Etype (Expr),
                    Is_Component_Left  => Is_Component_Left_Opnd (Expr),
                    Is_Component_Right => Is_Component_Right_Opnd (Expr),
                    Domain             => Domain,
                    Ada_Node           => Expr);

            when N_Membership_Test                      =>
               T :=
                 Transform_Membership_Expression (Local_Params, Domain, Expr);

            when N_Quantified_Expression                =>
               T :=
                 Transform_Quantified_Expression (Expr, Domain, Local_Params);

            when N_If_Expression                        =>
               declare
                  Cond        : constant N_Subexpr_Id :=
                    First (Expressions (Expr));
                  Then_Part   : constant N_Subexpr_Id := Next (Cond);
                  Else_Part   : constant Opt_N_Subexpr_Id := Next (Then_Part);
                  Cond_Domain : constant EW_Domain :=
                    (if Domain = EW_Term then EW_Pred else Domain);
                  Phase       : constant Transformation_Phase :=
                    Local_Params.Phase;
                  Warn_Then   : constant Boolean :=
                    Local_Params.Warn_On_Dead
                    and then
                      not Exp_Util.Is_Statically_Disabled
                            (Cond, False, Include_Valid => True);
                  Warn_Else   : constant Boolean :=
                    Local_Params.Warn_On_Dead
                    and then
                      not Exp_Util.Is_Statically_Disabled
                            (Cond, True, Include_Valid => True);
                  Then_Expr   : W_Expr_Id;
                  Else_Expr   : W_Expr_Id;
                  Condition   : W_Expr_Id;

               begin
                  Then_Expr :=
                    Transform_Expr_With_Actions
                      (Then_Part,
                       Then_Actions (Expr),
                       Expected_Type,
                       Domain,
                       (Local_Params with delta Warn_On_Dead => Warn_Then));

                  --  Possibly warn on an unreachable then-branch

                  if Domain = EW_Prog then
                     Then_Expr :=
                       +Warn_On_Dead_Branch
                          (Then_Part, +Then_Expr, Phase, Warn_Then);
                  end if;

                  Else_Expr :=
                    Transform_Expr_With_Actions
                      (Else_Part,
                       Else_Actions (Expr),
                       Expected_Type,
                       Domain,
                       (Local_Params with delta Warn_On_Dead => Warn_Else));

                  --  Do not warn on an unreachable branch "else True" whether
                  --  it comes from source or it was generated by the
                  --  frontend.

                  if Nkind (Else_Part) in N_Expanded_Name | N_Identifier
                    and then Entity (Else_Part) = Standard_True
                  then
                     null;

                  --  Otherwise possibly warn on an unreachable else-branch

                  elsif Domain = EW_Prog then
                     Else_Expr :=
                       +Warn_On_Dead_Branch
                          (Else_Part, +Else_Expr, Phase, Warn_Else);
                  end if;

                  Local_Params.Gen_Marker := GM_None;
                  Condition :=
                    +Transform_Expr
                       (Cond, EW_Bool_Type, Cond_Domain, Local_Params);

                  T :=
                    New_Conditional
                      (Ada_Node  => Expr,
                       Domain    => Domain,
                       Condition => Condition,
                       Then_Part => Then_Expr,
                       Else_Part => Else_Expr,
                       Typ       => Get_Type (Then_Expr));
               end;

            when N_Type_Conversion                      =>
               --  For array conversions, if target and source types have
               --  different component type, we may need to generate an
               --  appropriate conversion theory.
               --  Also generate the theory for the reverse conversion as it
               --  may be needed if Expr is a left value.

               if Has_Array_Type (Etype (Expr)) then
                  declare
                     Target_Typ      : constant Entity_Id :=
                       Retysp (Etype (Expr));
                     Target_Comp_Typ : constant Entity_Id :=
                       Retysp (Component_Type (Target_Typ));
                     Source_Typ      : constant Entity_Id :=
                       Retysp (Etype (Expression (Expr)));
                     Source_Comp_Typ : constant Entity_Id :=
                       Retysp (Component_Type (Source_Typ));
                  begin
                     if Target_Comp_Typ /= Source_Comp_Typ then
                        Create_Array_Conversion_Theory_If_Needed
                          (From => Source_Typ, To => Target_Typ);
                        Create_Array_Conversion_Theory_If_Needed
                          (From => Target_Typ, To => Source_Typ);
                     end if;
                  end;

               elsif Has_Fixed_Point_Type (Expr_Type)
                 and then Has_Fixed_Point_Type (Etype (Expression (Expr)))
               then
                  declare
                     From_Small : constant Ureal :=
                       Small_Value (Retysp (Etype (Expression (Expr))));
                     To_Small   : constant Ureal := Small_Value (Expr_Type);
                  begin
                     if From_Small /= To_Small then
                        Create_Fixed_Point_Mult_Div_Theory_If_Needed
                          (Typ_Left   => Etype (Expression (Expr)),
                           Typ_Right  => Standard_Integer,
                           Typ_Result => Expr_Type,
                           Expr       => Expr);
                     end if;
                  end;
               end if;

               T :=
                 Transform_Expr
                   (Expression (Expr),
                    Type_Of_Node (Expr),
                    Domain,
                    Local_Params,
                    No_Init_Check);

               --  Invariant checks are introduced explicitly as they need only
               --  be performed on actual type conversions (and not view
               --  conversions).

               if Domain = EW_Prog
                 and then
                   Invariant_Check_Needed (Expr_Type, Scop => Current_Subp)
               then
                  T := +Insert_Invariant_Check (Expr, Expr_Type, +T);
               end if;

            when N_Qualified_Expression                 =>

               --  Tansform the expression with the subtype mark as the
               --  expected type so that checks are introduced if necessary.
               --  As the Etype of Expr might not be compatible with the
               --  subtype mark (with respect to predicates, bounds constraints
               --  etc), this might cause checks to be redone while converting
               --  back to the expected type. Thus, we add this conversion here
               --  with checks disabled.

               declare
                  Check_Type   : constant Entity_Id :=
                    Entity (Subtype_Mark (Expr));
                  Relaxed_Init : constant Boolean :=
                    Expr_Has_Relaxed_Init
                      (Expression (Expr), No_Eval => False);
                  Typ          : constant W_Type_Id :=
                    (if Relaxed_Init
                     then EW_Abstract (Check_Type, Relaxed_Init => True)
                     else Type_Of_Node (Check_Type));

               begin
                  --  For qualification over arrays, we need to check that the
                  --  bounds are correct, and not slide the array to match the
                  --  bound. Add the conversion manually so that the proper
                  --  parameter can be used to get the proper checks.

                  if Has_Array_Type (Expr_Type)
                    and then Domain = EW_Prog
                    and then
                      (Is_Constrained (Check_Type)
                       or else Is_Fixed_Lower_Bound_Array_Subtype (Check_Type))
                  then
                     T :=
                       Transform_Expr
                         (Expression (Expr),
                          Type_Of_Node (Expression (Expr)),
                          Domain,
                          Local_Params);

                     --  Insert the conversion with In_Qualif set to True so
                     --  that we do not slide the array but insert index
                     --  checks.

                     T :=
                       Insert_Array_Conversion
                         (Domain     => EW_Prog,
                          Ada_Node   => Expr,
                          Expr       => T,
                          To         => Typ,
                          Need_Check =>
                            Check_Needed_On_Conversion
                              (From => Etype (Expression (Expr)),
                               To   => Check_Type),
                          Is_Qualif  => True);

                  else
                     T :=
                       Transform_Expr
                         (Expression (Expr), Typ, Domain, Local_Params);
                  end if;

                  T :=
                    Insert_Simple_Conversion
                      (Ada_Node => Expr,
                       Domain   => Domain,
                       Expr     => T,
                       To       => Type_Of_Node (Expr));
               end;

            when N_Unchecked_Type_Conversion            =>
               pragma Assert (not Comes_From_Source (Expr));

               --  For string literals with a dynamic low bound, the frontend
               --  uses an arbitrary low bound of 1 and introduces a shift
               --  afterward through an unchecked conversion. It might produce
               --  incorrect string literal subtypes with bounds which are
               --  outside of the index type's base type. We avoid looking at
               --  such subtypes by using the target type of the unchecked
               --  conversion instead.

               if Nkind (Original_Node (Expr)) = N_String_Literal then
                  T := Transform_String_Literal (Expr, Domain, Params);

               --  Other compiler-generated unchecked type conversions are
               --  transparent for Why with our translation.

               else
                  T :=
                    Transform_Expr
                      (Expression (Expr),
                       Expected_Type,
                       Domain,
                       Local_Params,
                       No_Init_Check);
               end if;

            when N_Function_Call                        =>
               declare
                  Subp : constant Entity_Id :=
                    Get_Called_Entity_For_Proof (Expr);
                  Oper : constant N_Op_Shift_Option :=
                    Is_Simple_Shift_Or_Rotate (Subp);
               begin
                  if Oper in N_Op_Shift then
                     T :=
                       Transform_Shift_Or_Rotate_Call
                         (Expr, Oper, Domain, Local_Params);

                  --  Calls to predicate functions are ignored. Inherited
                  --  predicates are handled by other means. This is
                  --  needed to be able to handle inherited predicates
                  --  which are not visible in SPARK.

                  elsif Ekind (Subp) = E_Function
                    and then Is_Predicate_Function (Subp)
                  then
                     return Bool_True (Domain);

                  elsif Has_At_End_Borrow_Annotation (Subp) then
                     T :=
                       Transform_At_End_Borrow_Call
                         (Expr, Domain, Local_Params);

                  elsif Is_Tagged_Predefined_Eq (Subp) then
                     declare
                        Left  : constant Node_Id := First_Actual (Expr);
                        Right : constant Node_Id := Next_Actual (Left);

                     begin
                        pragma Assert (No (Next_Actual (Right)));
                        T :=
                          Transform_Record_Equality
                            (Expr, Left, Right, Domain, Local_Params);
                     end;

                  elsif Has_Logical_Eq_Annotation (Subp)
                    and then Domain in EW_Term | EW_Pred
                  then
                     declare
                        Left  : constant Node_Id := First_Actual (Expr);
                        Right : constant Node_Id := Next_Actual (Left);
                        BT    : constant W_Type_Id :=
                          Base_Why_Type (Etype (First_Formal (Subp)));

                        Left_Expr  : constant W_Expr_Id :=
                          Transform_Expr (Left, BT, EW_Term, Params);
                        Right_Expr : constant W_Expr_Id :=
                          Transform_Expr (Right, BT, EW_Term, Params);
                     begin
                        if Has_Array_Type (Etype (Left)) then
                           T :=
                             New_Logic_Eq_Call
                               (+Left_Expr, +Right_Expr, Domain);
                        else
                           T :=
                             New_Comparison
                               (Symbol => Why_Eq,
                                Left   => Left_Expr,
                                Right  => Right_Expr,
                                Domain => Domain);
                        end if;
                     end;

                  elsif Is_Function_With_Side_Effects (Subp) then
                     pragma Assert (Domain = EW_Prog);
                     T :=
                       +Transform_Call_With_Side_Effects (Local_Params, Expr);

                  else
                     T :=
                       Transform_Function_Call
                         (Expr,
                          Domain,
                          Local_Params,
                          Validity_Check =>
                            (if No_Validity_Check
                             then No_Check
                             else Do_Check));
                  end if;
               end;

            when N_Indexed_Component
               | N_Selected_Component
               | N_Explicit_Dereference                 =>

               --  If Expr is potentially_Invalid, emit a validity check on the
               --  access so it is as precise as possible.

               if Domain = EW_Prog
                 and then not No_Validity_Check
                 and then Is_Potentially_Invalid_Expr (Expr)
               then
                  declare
                     Valid_Flag : W_Expr_Id;
                     Context    : Ref_Context;
                     W_Expr     : W_Expr_Id :=
                       Transform_Potentially_Invalid_Expr
                         (Expr          => Expr,
                          Expected_Type => Expected_Type,
                          Domain        => Domain,
                          Params        => Local_Params,
                          Context       => Context,
                          Valid_Flag    => Valid_Flag,
                          No_Checks     => False);

                  begin
                     W_Expr := New_Temp_For_Expr (W_Expr);

                     T :=
                       +Sequence
                          (New_Located_Assert
                             (Ada_Node => Expr,
                              Pred     =>
                                +New_Is_Valid_Call_For_Expr
                                   (Tree   => Valid_Flag,
                                    Ty     => Etype (Expr),
                                    Expr   => W_Expr,
                                    Domain => EW_Pred),
                              Reason   => VC_Validity_Check,
                              Kind     => EW_Assert),
                           +W_Expr);
                     T :=
                       Binding_For_Temp
                         (Domain => Domain, Tmp => W_Expr, Context => T);
                     T := Bindings_For_Ref_Context (T, Context, Domain);
                  end;
               else
                  T :=
                    One_Level_Access
                      (Expr,
                       Transform_Expr
                         (Prefix (Expr),
                          Domain,
                          Local_Params,
                          No_Init_Check     => No_Init_Check,
                          No_Validity_Check => True),
                       Domain,
                       Local_Params,
                       No_Init_Check => No_Init_Check);
               end if;

            --  Nothing is done on the rhs (expr) when assigning null to
            --  the lhs object. However, the lhs should be updated and the
            --  field is_null_pointer in the why representation is set to True

            when N_Null                                 =>
               T := +E_Symb (Etype (Expr), WNE_Null_Pointer);

            when N_Attribute_Reference                  =>
               T :=
                 Transform_Attr
                   (Expr,
                    Domain,
                    Local_Params,
                    Expected_Type,
                    No_Validity_Check => No_Validity_Check);

            when N_Case_Expression                      =>
               declare
                  function Transform_Branch
                    (N      : Node_Id;
                     Domain : EW_Domain;
                     Params : Transformation_Params) return W_Expr_Id;
                  --  Transform the actions and the expression of a branch

                  ----------------------
                  -- Transform_Branch --
                  ----------------------

                  function Transform_Branch
                    (N      : Node_Id;
                     Domain : EW_Domain;
                     Params : Transformation_Params) return W_Expr_Id
                  is
                     T : W_Expr_Id;
                  begin
                     T :=
                       Transform_Expr_With_Actions
                         (Expression (N),
                          Actions (N),
                          Expected_Type,
                          Domain,
                          Params);

                     --  Possibly warn on an unreachable case branch

                     if Domain = EW_Prog then
                        T :=
                          +Warn_On_Dead_Branch
                             (Expression (N),
                              +T,
                              Params.Phase,
                              Params.Warn_On_Dead);
                     end if;

                     return T;
                  end Transform_Branch;

                  function Transform_Case_Expr is new
                    Generate_Case_Expression (Transform_Branch);

               begin
                  T := Transform_Case_Expr (Expr, Domain, Local_Params);
               end;

            --  N_Expression_With_Actions is only generated for declare
            --  expressions in GNATprove mode.

            when N_Expression_With_Actions              =>
               T :=
                 Transform_Expr_With_Actions
                   (Expr          => Expression (Expr),
                    Actions       => Actions (Expr),
                    Domain        => Domain,
                    Params        => Params,
                    Expected_Type => Expected_Type);

            when N_Allocator                            =>

               --  For the evaluation of an initialized allocator, the
               --  evaluation of the qualified_expression is performed first.

               --  For the evaluation of an uninitialized allocator, the
               --  elaboration of the subtype_indication is performed first.

               --  see ARM 4.8 $6/3

               declare
                  Call     : W_Expr_Id;
                  New_Expr : constant Node_Id := Expression (Expr);
                  To_Const : constant Boolean :=
                    Is_Access_Constant (Expr_Type);
                  To_Gen   : constant Boolean :=
                    Is_General_Access_Type (Expr_Type);
                  Des_Ty   : constant Entity_Id :=
                    Directly_Designated_Type (Expr_Type);

               begin
                  if Domain = EW_Prog
                    and then
                      (if To_Gen or else To_Const
                       then not Value_Is_Never_Leaked (Expr)
                       else
                         In_Statically_Leaking_Context
                           (Expr, Ignore_Non_Exec => True))
                    and then
                      not (Is_Ghost_Entity (Current_Subp)
                           and then
                             Is_Non_Exec_Assertion_Level
                               (Ghost_Assertion_Level (Current_Subp)))
                  then
                     Emit_Static_Proof_Result
                       (Expr,
                        VC_Resource_Leak,
                        False,
                        Current_Subp,
                        Explanation =>
                          "allocator "
                          & (if To_Const
                             then "for an access-to-constant type"
                             elsif To_Gen
                             then "for a general access-to-variable type"
                             else "inside an assertion")
                          & " leaks memory");
                  end if;

                  --  Uninitialized allocator

                  --  Subtype indication are rewritten by the frontend into the
                  --  corresponding Itype, so we only expect subtype names
                  --  here. Attribute references like Type'Base are also
                  --  rewritten, but it feels safer to not rely on this
                  --  rewriting.

                  if Is_Entity_Name (New_Expr)
                    and then Is_Type (Entity (New_Expr))
                  then
                     --  Construct the value for the uninitialized data. We
                     --  generate:
                     --  to_des_ty (<default_value_for_constr_ty>)

                     --  For now, uninitialized allocators are only allowed if
                     --  the designated type defines full default
                     --  initialization. Therefore, the allocated object cannot
                     --  have relaxed initialization.

                     pragma Assert (not Expr_Has_Relaxed_Init (Expr));

                     declare
                        Constr_Ty : constant Entity_Id :=
                          Retysp (Entity (New_Expr));
                        pragma
                          Assert
                            (Default_Initialization (Constr_Ty)
                             in Full_Default_Initialization
                              | No_Possible_Initialization);

                        Need_Bound_Check : constant Boolean :=
                          Domain = EW_Prog
                          and then Is_Array_Type (Des_Ty)
                          and then Is_Constrained (Des_Ty)
                          and then Des_Ty /= Retysp (Entity (New_Expr));
                        Value_Id         : constant W_Identifier_Id :=
                          New_Temp_Identifier
                            (Base_Name => "value",
                             Typ       =>
                               EW_Abstract
                                 (Des_Ty,
                                  Relaxed_Init => Has_Relaxed_Init (Des_Ty)));
                        Tmp_Value        : constant W_Expr_Id :=
                          New_Temp_For_Expr
                            (E         =>
                               Compute_Default_Value
                                 (Ada_Node     => Expr,
                                  E            => Constr_Ty,
                                  Relaxed_Init => Has_Relaxed_Init (Constr_Ty),
                                  Domain       => Domain),
                             Need_Temp => Need_Bound_Check);
                        Value_Expr       : W_Expr_Id :=
                          Insert_Checked_Conversion
                            (Ada_Node => Expr,
                             Domain   => Domain,
                             Expr     => Tmp_Value,
                             To       => Get_Typ (Value_Id));

                     begin
                        pragma
                          Assert
                            (if Is_Composite_Type (Constr_Ty)
                             then
                               Is_Constrained (Constr_Ty)
                               or else
                                 Has_Defaulted_Discriminants (Constr_Ty));

                        --  Allocators do not slide the allocated value. If the
                        --  designated type is constrained, introduce a check
                        --  to ensure that the bounds of the allocated value
                        --  match those of the designated type.

                        if Need_Bound_Check then
                           Prepend
                             (New_Located_Assert
                                (Ada_Node => Expr,
                                 Pred     =>
                                   New_Bounds_Equality (+Tmp_Value, Des_Ty),
                                 Reason   => VC_Range_Check,
                                 Kind     => EW_Assert),
                              Value_Expr);

                           Value_Expr :=
                             Binding_For_Temp
                               (Ada_Node => Expr,
                                Domain   => Domain,
                                Tmp      => Tmp_Value,
                                Context  => Value_Expr);
                        end if;

                        Call :=
                          +Pointer_From_Split_Form
                             (A  => (+Value_Id, +False_Term),
                              Ty => Etype (Expr));
                        Call :=
                          New_Binding
                            (Name    => Value_Id,
                             Domain  => Domain,
                             Def     => Value_Expr,
                             Context => Call);
                     end;

                  --  Initialized allocator

                  --  ??? 6/3 If the designated type of the type of the
                  --  allocator

                  else
                     pragma Assert (Nkind (New_Expr) = N_Qualified_Expression);

                     declare
                        Need_Bound_Check : constant Boolean :=
                          Domain = EW_Prog
                          and then Is_Array_Type (Des_Ty)
                          and then Is_Constrained (Des_Ty)
                          and then Des_Ty /= Etype (New_Expr);
                        Tmp_Value        : constant W_Expr_Id :=
                          New_Temp_For_Expr
                            (E         =>
                               Transform_Expr
                                 (Expr   => New_Expr,
                                  Domain => Domain,
                                  Params => Local_Params),
                             Need_Temp => Need_Bound_Check);
                        Relaxed_Init     : constant Boolean :=
                          Expr_Has_Relaxed_Init (Expr, No_Eval => False);
                        Des_Relaxed_Init : constant Boolean :=
                          Has_Relaxed_Init (Des_Ty)
                          or else
                            (Has_Init_Wrapper (Des_Ty) and then Relaxed_Init);
                        Value_Expr       : W_Expr_Id :=
                          Insert_Checked_Conversion
                            (Ada_Node => New_Expr,
                             Domain   => Domain,
                             Expr     => Tmp_Value,
                             To       =>
                               EW_Abstract (Des_Ty, Des_Relaxed_Init));

                     begin
                        --  Allocators do not slide the allocated value. If the
                        --  designated type is constrained, introduce a check
                        --  to ensure that the bounds of the allocated value
                        --  match those of the designated type.

                        if Need_Bound_Check then
                           Prepend
                             (New_Located_Assert
                                (Ada_Node => New_Expr,
                                 Pred     =>
                                   New_Bounds_Equality (+Tmp_Value, Des_Ty),
                                 Reason   => VC_Range_Check,
                                 Kind     => EW_Assert),
                              Value_Expr);
                        end if;

                        --  Update the tag attribute if Des_Ty is a specific
                        --  type

                        if Is_Tagged_Type (Des_Ty) then
                           Value_Expr :=
                             New_Tag_And_Ext_Update
                               (Domain => EW_Term,
                                Name   => Value_Expr,
                                Ty     => Des_Ty);
                        end if;

                        Value_Expr :=
                          Binding_For_Temp
                            (Ada_Node => New_Expr,
                             Domain   => Domain,
                             Tmp      => Tmp_Value,
                             Context  => Value_Expr);
                        Call :=
                          +Pointer_From_Split_Form
                             (A            =>
                                (Value_Expr, +False_Term)
                                & (if Relaxed_Init
                                   then (1 => +True_Term)
                                   else (1 .. 0 => <>)),
                              Ty           => Etype (Expr),
                              Relaxed_Init => Relaxed_Init);
                     end;

                  end if;

                  --  If the allocator type has a direct or inherited
                  --  predicate, generate a corresponding check.

                  if Domain = EW_Prog and then Has_Predicates (Expr_Type) then
                     Call :=
                       +Insert_Predicate_Check
                          (Ada_Node => Expr,
                           Check_Ty => Expr_Type,
                           W_Expr   => +Call);
                  end if;

                  T := Call;
               end;

            when N_Raise_Expression | N_Raise_xxx_Error =>
               --  No condition should be present in SPARK code. Such code
               --  should be rejected after marking and not reach here.

               pragma
                 Assert
                   (if Nkind (Expr) in N_Raise_xxx_Error
                    then No (Condition (Expr)));

               --  Using raise expressions inside preconditions to change the
               --  reported error is a common pattern used in the standard
               --  library. To support it, we translate raise expressions
               --  occurring in preconditions as False.
               --  NB. Cases where such a translation would be incorrect are
               --  detected in marking.

               if Nkind (Expr) = N_Raise_Expression
                 and then Raise_Occurs_In_Pre (Expr)
               then
                  T := Bool_False (Domain);

               else
                  T := Why_Default_Value (Domain, Etype (Expr));
                  if Domain = EW_Prog then
                     Prepend (Transform_Unhandled_Raise (Expr), T);
                  end if;
               end if;

            when N_Delta_Aggregate                      =>
               T :=
                 Transform_Delta_Aggregate
                   (Ada_Node => Expr,
                    Pref     => Expression (Expr),
                    Aggr     => Expr,
                    Domain   => Domain,
                    Params   => Params);

            when N_Target_Name                          =>
               pragma Assert (Target_Name /= Why_Empty);
               T := +Target_Name;

            when others                                 =>
               Ada.Text_IO.Put_Line
                 ("[Transform_Expr] kind =" & Node_Kind'Image (Nkind (Expr)));
               raise Not_Implemented;
         end case;
      end if;

      --  We now have the translation of the Ada expression in [T], pending
      --  checks and conversion. We now do the wrapping up to insert all those
      --  if needed.

      --  This label will be used for pretty printing the expression

      if Pretty_Label /= No_Symbol then
         T :=
           New_Label
             (Labels => Symbol_Sets.To_Set (Pretty_Label),
              Def    => T,
              Domain => Domain,
              Typ    => Get_Type (T));
      end if;

      --  Insert an overflow check if flag Do_Overflow_Check is set. No
      --  conversion should be needed, as overflow checks are only set on
      --  intermediate expressions, whose transformation into Why should
      --  always have type "int" or "real". We start by checking that Expr has
      --  a kind on which we can call Do_Overflow_Check, otherwise there is
      --  nothing to do.

      --  Note that N_Type_Conversions *may* have a Do_Overflow_Check flag, but
      --  they are actually for range checks and are checked elsewhere. See the
      --  documentation of sinfo.ads.

      if Domain = EW_Prog
        and then
          Nkind (Expr)
          in N_Attribute_Reference | N_Case_Expression | N_If_Expression | N_Op
        and then Do_Overflow_Check (Expr)
      then
         --  Depending on the current mode for integer overflow checks, the
         --  operation is either done in the base type (Strict mode), or in
         --  Long_Long_Integer (Minimized mode) if needed, or in arbitrary
         --  precision if needed (Eliminated mode). A check may only be
         --  generated in the Strict and Minimized modes, and the type
         --  used for the bounds is the base type in the first case, and
         --  Long_Long_Integer in the second case (which is its own base type).

         --  Use Sem.Scope_Suppress which takes into account the default from
         --  switches and configuration pragma files as defined in
         --  Opt.Suppress_Options, as well as possible configuration pragmas
         --  in the main unit, as done in SPARK_Definition.Mark_Pragma.

         if Is_Signed_Integer_Type (Expr_Type) then
            declare
               Mode : Overflow_Mode_Type;
            begin
               case Params.Phase is
                  when Generate_VCs_For_Body      =>
                     Mode := Sem.Scope_Suppress.Overflow_Mode_General;

                  when Generate_VCs_For_Assertion =>
                     Mode := Sem.Scope_Suppress.Overflow_Mode_Assertions;

                  when others                     =>
                     raise Program_Error;
               end case;

               case Mode is
                  when Strict     =>
                     T :=
                       +Insert_Overflow_Check
                          (Expr, T, Expr_Type, Is_Float => False);

                  when Minimized  =>
                     T :=
                       +Insert_Overflow_Check
                          (Expr, T, Standard_Integer_64, Is_Float => False);

                  when Eliminated =>
                     null;

                  when Not_Set    =>
                     raise Program_Error;
               end case;
            end;

         elsif Is_Floating_Point_Type (Expr_Type) then
            declare
               Tlo                 : constant Node_Id :=
                 Type_Low_Bound (Expr_Type);
               Thi                 : constant Node_Id :=
                 Type_High_Bound (Expr_Type);
               Lov                 : Ureal;
               Hiv                 : Ureal;
               Lo                  : Ureal;
               Hi                  : Ureal;
               OK                  : Boolean;
               True_Check_Inserted : Boolean := False;

            begin
               --  We can only remove the check if we can compute the expected
               --  bounds of the Range_Type now.

               if Compile_Time_Known_Value (Tlo)
                 and then Compile_Time_Known_Value (Thi)
               then
                  Lov := Expr_Value_R (Tlo);
                  Hiv := Expr_Value_R (Thi);

                  Determine_Range_R (Expr, OK, Lo, Hi, Assume_Valid => True);

                  if OK then

                     --  If definitely in range, generate a check always true
                     --  for the overflow check. When gnat2why directly handles
                     --  check messages, a message could be generated instead
                     --  here.

                     --  Note in the test below that we assume that the range
                     --  is not OK if a bound of the range is equal to that
                     --  of the type. That's not the most precise check, but
                     --  we do it for the same reasons as those presented in
                     --  Checks.Enable_Overflow_Check in the same case.

                     if Lo > Lov and then Hi < Hiv then
                        True_Check_Inserted := True;
                        Emit_Always_True_Range_Check (Expr, RCK_FP_Overflow);
                     end if;
                  end if;
               end if;

               if not True_Check_Inserted then
                  T :=
                    +Insert_Overflow_Check
                       (Expr, T, Expr_Type, Is_Float => True);
               end if;
            end;

         --  Not a signed integer type or a floating-point type. Always perform
         --  the overflow check.

         else
            T :=
              +Insert_Overflow_Check (Expr, T, Expr_Type, Is_Float => False);
         end if;
      end if;

      --  Convert the expression to the expected type, if needed. This is
      --  intertwined with inserting range checks, and Insert_Conversion does
      --  both. This is because range checks need to be done on the Why "int"
      --  type, so they may trigger a conversion, or if a conversion is already
      --  needed, must be done on the "right side" of the conversion.
      --  Note that Insert_Conversion is smart enough to not insert any
      --  conversion when it's not needed.

      --  A range check is needed only in programs (Domain EW_Prog), and on
      --  nodes that have the range check flag. For type conversions, the
      --  Do_Overflow_Check actually means that a range check is needed,
      --  instead of an overflow check (see sinfo.ads and the discussion of
      --  range checks and overflow checks there). Because range checks are
      --  determined by looking at the parent node, in that special case we go
      --  one step down for the Range_Check_Node.

      --  In predicate domain, only the Boolean type is used, no conversion is
      --  needed.

      if Domain in EW_Pred then
         null;
      else
         T :=
           Insert_Checked_Conversion
             (Ada_Node => Expr,
              Domain   => Domain,
              Expr     => T,
              To       => Expected_Type);
      end if;

      return T;
   end Transform_Expr;

   function Transform_Expr
     (Expr              : N_Subexpr_Id;
      Domain            : EW_Domain;
      Params            : Transformation_Params;
      No_Init_Check     : Boolean := False;
      No_Validity_Check : Boolean := False) return W_Expr_Id
   is
      Expected_Type : W_Type_Id := Why_Empty;

   begin
      --  For record fields, use the type of the field access (that is, the
      --  type of the field in the Retyps of the record type) to avoid
      --  conversions.
      --  Note that this type may depend on discriminants, so it is in general
      --  a bad idea to try to convert to such a type. Converting from it
      --  should be OK though as it is never in split form.

      if Nkind (Expr) = N_Selected_Component then
         declare
            Field : constant Entity_Id := Entity (Selector_Name (Expr));
            Ty    : constant Entity_Id := Retysp (Etype (Prefix (Expr)));
         begin
            Expected_Type :=
              (if Is_Part_Of_Protected_Object (Field)
               then
                 EW_Abstract
                   (Etype (Field),
                    Relaxed_Init => Expr_Has_Relaxed_Init (Expr))
               else
                 EW_Abstract
                   (Etype (Search_Component_In_Type (Ty, Field)),
                    Relaxed_Init => Expr_Has_Relaxed_Init (Expr)));
            --  If the component may have relaxed initialization, use the
            --  associated wrapper type.
         end;

      else
         Expected_Type := Type_Of_Node (Expr);
      end if;

      --  Set error node so that bugbox information will be correct

      Current_Error_Node := Expr;

      return
        Transform_Expr
          (Expr,
           Expected_Type,
           Domain,
           Params,
           No_Init_Check,
           No_Validity_Check);
   end Transform_Expr;

   ---------------------------------
   -- Transform_Expr_With_Actions --
   ---------------------------------

   function Transform_Expr_With_Actions
     (Expr          : N_Subexpr_Id;
      Actions       : List_Id;
      Expected_Type : W_Type_Id;
      Domain        : EW_Domain;
      Params        : Transformation_Params) return W_Expr_Id
   is
      function Transform_Expr_Internal
        (Expr   : N_Subexpr_Id;
         Domain : EW_Domain;
         Params : Transformation_Params) return W_Expr_Id
      is (Transform_Expr (Expr, Expected_Type, Domain, Params));

      function Transform_Expr_With_Actions is new
        Generate_Expr_With_Actions (Transform_Expr_Internal);

   begin
      return Transform_Expr_With_Actions (Expr, Actions, Domain, Params);
   end Transform_Expr_With_Actions;

   -----------------------------------
   -- Transform_Expr_With_Cutpoints --
   -----------------------------------

   procedure Transform_Expr_With_Cutpoints
     (Assertion : N_Subexpr_Id;
      Params    : Transformation_Params;
      Runtime   : out W_Prog_Id;
      Premise   : out W_Pred_Id;
      Result    : out W_Pred_Id)
   is
      package COpN renames Cut_Operations_Names;
      Split_Params : constant Transformation_Params :=
        (Params with delta Gen_Marker => GM_Label);

      function Compute_Premise
        (Expr : N_Subexpr_Id; Local_Params : Transformation_Params)
         return W_Pred_Id;
      --  Compute the premise of Expr as a predicate

      function Compute_Result (Expr : N_Subexpr_Id) return W_Pred_Id;
      --  Compute the result of Expr as a predicate

      function Compute_Runtime_Checks (Expr : N_Subexpr_Id) return W_Prog_Id;
      --  Compute a program which performs all the checks necessary for Expr.
      --  This includes the side-conditions of cut operations.

      ---------------------
      -- Compute_Premise --
      ---------------------

      function Compute_Premise
        (Expr : N_Subexpr_Id; Local_Params : Transformation_Params)
         return W_Pred_Id
      is
         function Compute_Premise
           (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
            return W_Expr_Id;
         --  Wrapper on Compute_Premise used for instances of generic treatment

         function Compute_Premise_For_Expr_With_Actions
           (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
            return W_Expr_Id;

         ---------------------
         -- Compute_Premise --
         ---------------------

         function Compute_Premise
           (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
            return W_Expr_Id
         is
            pragma Unreferenced (Domain);
         begin
            return +Compute_Premise (Expr, Params);
         end Compute_Premise;

         function Compute_Premise_For_Expr_With_Actions is new
           Generate_Expr_With_Actions (Compute_Premise);

         -------------------------------------------
         -- Compute_Premise_For_Expr_With_Actions --
         -------------------------------------------

         function Compute_Premise_For_Expr_With_Actions
           (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
            return W_Expr_Id is
         begin
            return
              Compute_Premise_For_Expr_With_Actions
                (Expression (Expr), Actions (Expr), Domain, Params);
         end Compute_Premise_For_Expr_With_Actions;

      begin
         if not Contains_Cut_Operations (Expr) then
            return Transform_Pred (Expr, Local_Params);
         end if;

         case Nkind (Expr) is
            when N_Op_And | N_And_Then     =>
               return
                 New_And_Pred
                   (Compute_Premise (Left_Opnd (Expr), Local_Params),
                    Compute_Premise (Right_Opnd (Expr), Local_Params));

            when N_Op_Or | N_Or_Else       =>

               --  We have traversed a disjunction, the predicate cannot be
               --  splitted any further. Change the tranformation parameters
               --  accordingly and introduce a label if necessary.

               declare
                  Pred : W_Pred_Id :=
                    New_Or_Pred
                      (Compute_Premise (Left_Opnd (Expr), Params),
                       Compute_Premise (Right_Opnd (Expr), Params));
               begin
                  if Expr /= Assertion
                    and then Local_Params.Gen_Marker = GM_Label
                  then
                     Pred :=
                       New_Label
                         (Labels =>
                            Symbol_Sets.To_Set (New_Sub_VC_Marker (Expr)),
                          Def    => +Pred,
                          Typ    => EW_Bool_Type);
                  end if;
                  return Pred;
               end;

            when N_Quantified_Expression   =>
               declare
                  function Compute_Premise_For_Quantified_Expr is new
                    Generate_Quantified_Expression (Compute_Premise);

               begin
                  return
                    +Compute_Premise_For_Quantified_Expr
                       (Expr, EW_Pred, Local_Params);
               end;

            when N_Expression_With_Actions =>
               return
                 +Compute_Premise_For_Expr_With_Actions
                    (Expr, EW_Pred, Local_Params);

            when N_If_Expression           =>
               declare
                  Cond      : constant N_Subexpr_Id :=
                    First (Expressions (Expr));
                  Then_Part : constant N_Subexpr_Id := Next (Cond);
                  Else_Part : constant Opt_N_Subexpr_Id := Next (Then_Part);

               begin
                  return
                    New_Conditional
                      (Ada_Node  => Expr,
                       Condition => Transform_Pred (Cond, Params),
                       Then_Part =>
                         +Compute_Premise_For_Expr_With_Actions
                            (Then_Part,
                             Then_Actions (Expr),
                             EW_Pred,
                             Local_Params),
                       Else_Part =>
                         +Compute_Premise_For_Expr_With_Actions
                            (Else_Part,
                             Else_Actions (Expr),
                             EW_Pred,
                             Local_Params));
               end;

            when N_Case_Expression         =>
               declare
                  function Compute_Premise_For_Case_Expr is new
                    Generate_Case_Expression
                      (Compute_Premise_For_Expr_With_Actions);

               begin
                  return
                    +Compute_Premise_For_Case_Expr
                       (Expr, EW_Pred, Local_Params);
               end;

            when N_Function_Call           =>
               declare
                  Subp        : constant Entity_Id :=
                    Get_Called_Entity_For_Proof (Expr);
                  Name_String : constant String :=
                    Get_Name_String (Chars (Subp));
                  Fst_Param   : constant Node_Id := First_Actual (Expr);
                  Snd_Param   : constant Node_Id := Next_Actual (Fst_Param);

               begin
                  pragma
                    Assert (Is_From_Hardcoded_Unit (Subp, Cut_Operations));

                  --  For By, the premise is the second parameter

                  if Name_String = COpN.By then
                     return Compute_Premise (Snd_Param, Local_Params);

                  --  For So, it is the first

                  else
                     pragma Assert (Name_String = COpN.So);
                     return Compute_Premise (Fst_Param, Local_Params);
                  end if;
               end;

            when others                    =>
               raise Program_Error;
         end case;
      end Compute_Premise;

      --------------------
      -- Compute_Result --
      --------------------

      function Compute_Result (Expr : N_Subexpr_Id) return W_Pred_Id is

         function Compute_Result
           (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
            return W_Expr_Id;
         --  Wrapper on Compute_Result used for instances of generic treatment

         function Compute_Result_For_Expr_With_Actions
           (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
            return W_Expr_Id;

         --------------------
         -- Compute_Result --
         --------------------

         function Compute_Result
           (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
            return W_Expr_Id
         is
            pragma Unreferenced (Domain, Params);
         begin
            return +Compute_Result (Expr);
         end Compute_Result;

         function Compute_Result_For_Expr_With_Actions is new
           Generate_Expr_With_Actions (Compute_Result);

         ------------------------------------------
         -- Compute_Result_For_Expr_With_Actions --
         ------------------------------------------

         function Compute_Result_For_Expr_With_Actions
           (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
            return W_Expr_Id is
         begin
            return
              Compute_Result_For_Expr_With_Actions
                (Expression (Expr), Actions (Expr), Domain, Params);
         end Compute_Result_For_Expr_With_Actions;

      begin
         if not Contains_Cut_Operations (Expr) then
            return Transform_Pred (Expr, Params);
         end if;

         case Nkind (Expr) is
            when N_Op_And | N_And_Then     =>
               return
                 New_And_Pred
                   (Compute_Result (Left_Opnd (Expr)),
                    Compute_Result (Right_Opnd (Expr)));

            when N_Op_Or | N_Or_Else       =>
               return
                 New_Or_Pred
                   (Compute_Result (Left_Opnd (Expr)),
                    Compute_Result (Right_Opnd (Expr)));

            when N_Quantified_Expression   =>
               declare
                  function Compute_Result_For_Quantified_Expr is new
                    Generate_Quantified_Expression (Compute_Result);

               begin
                  return
                    +Compute_Result_For_Quantified_Expr
                       (Expr, EW_Pred, Params);
               end;

            when N_Expression_With_Actions =>
               return
                 +Compute_Result_For_Expr_With_Actions (Expr, EW_Pred, Params);

            when N_If_Expression           =>
               declare
                  Cond      : constant N_Subexpr_Id :=
                    First (Expressions (Expr));
                  Then_Part : constant N_Subexpr_Id := Next (Cond);
                  Else_Part : constant Opt_N_Subexpr_Id := Next (Then_Part);

               begin
                  return
                    New_Conditional
                      (Ada_Node  => Expr,
                       Condition => Transform_Pred (Cond, Params),
                       Then_Part =>
                         +Compute_Result_For_Expr_With_Actions
                            (Then_Part, Then_Actions (Expr), EW_Pred, Params),
                       Else_Part =>
                         +Compute_Result_For_Expr_With_Actions
                            (Else_Part, Else_Actions (Expr), EW_Pred, Params));
               end;

            when N_Case_Expression         =>
               declare
                  function Compute_Result_For_Case_Expr is new
                    Generate_Case_Expression
                      (Compute_Result_For_Expr_With_Actions);

               begin
                  return +Compute_Result_For_Case_Expr (Expr, EW_Pred, Params);
               end;

            when N_Function_Call           =>
               declare
                  Subp        : constant Entity_Id :=
                    Get_Called_Entity_For_Proof (Expr);
                  Name_String : constant String :=
                    Get_Name_String (Chars (Subp));
                  Fst_Param   : constant Node_Id := First_Actual (Expr);
                  Snd_Param   : constant Node_Id := Next_Actual (Fst_Param);

               begin
                  pragma
                    Assert (Is_From_Hardcoded_Unit (Subp, Cut_Operations));

                  --  For By, the consequence is the first parameter

                  if Name_String = COpN.By then
                     return Compute_Result (Fst_Param);

                  --  For So, keep both operands

                  else
                     pragma Assert (Name_String = COpN.So);
                     return
                       New_And_Pred
                         (Compute_Result (Fst_Param),
                          Compute_Result (Snd_Param));
                  end if;
               end;

            when others                    =>
               raise Program_Error;
         end case;
      end Compute_Result;

      ----------------------------
      -- Compute_Runtime_Checks --
      ----------------------------

      function Compute_Runtime_Checks (Expr : N_Subexpr_Id) return W_Prog_Id is

         function Compute_Runtime_Checks
           (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
            return W_Expr_Id;
         --  Wrapper on Compute_Runtime_Checks used for instances of generic
         --  treatment.

         Warn_On_Dead_Branches : Boolean := True;
         --  Flag that should be set to True if we want to warn on dead
         --  branches inside Compute_Runtime_Checks.

         function Compute_Runtime_Checks_For_Expr_With_Actions
           (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
            return W_Expr_Id;

         ----------------------------
         -- Compute_Runtime_Checks --
         ----------------------------

         function Compute_Runtime_Checks
           (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
            return W_Expr_Id
         is
            pragma Unreferenced (Domain);
            Result : constant W_Expr_Id := +Compute_Runtime_Checks (Expr);

         begin
            --  Possibly warn on an unreachable branches

            if Warn_On_Dead_Branches then
               return
                 +Warn_On_Dead_Branch
                    (Expr, +Result, Params.Phase, Params.Warn_On_Dead);
            else
               return Result;
            end if;
         end Compute_Runtime_Checks;

         function Compute_Runtime_Checks_For_Expr_With_Actions is new
           Generate_Expr_With_Actions (Compute_Runtime_Checks);

         --------------------------------------------------
         -- Compute_Runtime_Checks_For_Expr_With_Actions --
         --------------------------------------------------

         function Compute_Runtime_Checks_For_Expr_With_Actions
           (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
            return W_Expr_Id is
         begin
            return
              Compute_Runtime_Checks_For_Expr_With_Actions
                (Expression (Expr), Actions (Expr), Domain, Params);
         end Compute_Runtime_Checks_For_Expr_With_Actions;

      begin
         if not Contains_Cut_Operations (Expr) then
            return New_Ignore (Prog => Transform_Prog (Expr, Params));
         end if;

         case Nkind (Expr) is
            when N_Op_And | N_Op_Or        =>
               return
                 Sequence
                   (Compute_Runtime_Checks (Left_Opnd (Expr)),
                    Compute_Runtime_Checks (Right_Opnd (Expr)));

            when N_And_Then | N_Or_Else    =>

               --  For short-circuit operators, check the right operand in the
               --  context of the left.

               declare
                  Left_Res : constant W_Pred_Id :=
                    Compute_Result (Left_Opnd (Expr));
               begin
                  return
                    Sequence
                      ((1 => Compute_Runtime_Checks (Left_Opnd (Expr)),
                        2 =>
                          New_Assume_Statement
                            (Pred =>
                               (if Nkind (Expr) = N_And_Then
                                then Left_Res
                                else New_Not (Right => Left_Res))),
                        3 => Compute_Runtime_Checks (Right_Opnd (Expr))));
               end;

            when N_Quantified_Expression   =>

               --  Warn on dead branches inside a quantified expression

               Warn_On_Dead_Branches := True;

               declare
                  function Compute_Runtime_Checks_For_Quantified_Expr is new
                    Generate_Quantified_Expression (Compute_Runtime_Checks);

               begin
                  return
                    +Compute_Runtime_Checks_For_Quantified_Expr
                       (Expr, EW_Prog, Params);
               end;

            when N_Expression_With_Actions =>

               --  No need to warn on dead branches inside an expression with
               --  actions.

               Warn_On_Dead_Branches := False;

               return
                 +Compute_Runtime_Checks_For_Expr_With_Actions
                    (Expr, EW_Prog, Params);

            when N_If_Expression           =>

               declare
                  Cond        : constant N_Subexpr_Id :=
                    First (Expressions (Expr));
                  Then_Part   : constant N_Subexpr_Id := Next (Cond);
                  Else_Part   : constant Opt_N_Subexpr_Id := Next (Then_Part);
                  Then_Checks : W_Prog_Id;
                  Else_Checks : W_Prog_Id;
                  Warn_Then   : constant Boolean :=
                    Params.Warn_On_Dead
                    and then
                      not Exp_Util.Is_Statically_Disabled
                            (Cond, False, Include_Valid => True);
                  Warn_Else   : constant Boolean :=
                    Params.Warn_On_Dead
                    and then
                      not Exp_Util.Is_Statically_Disabled
                            (Cond, True, Include_Valid => True);

               begin
                  --  Warn on dead branches inside the then branch

                  Warn_On_Dead_Branches := True;

                  Then_Checks :=
                    +Compute_Runtime_Checks_For_Expr_With_Actions
                       (Then_Part,
                        Then_Actions (Expr),
                        EW_Pred,
                        Params =>
                          (Params with delta Warn_On_Dead => Warn_Then));

                  --  Do not warn on an unreachable branch "else True" whether
                  --  it comes from source or it was generated by the frontend.

                  Warn_On_Dead_Branches :=
                    Nkind (Else_Part) not in N_Expanded_Name | N_Identifier
                    or else Entity (Else_Part) /= Standard_True;

                  Else_Checks :=
                    +Compute_Runtime_Checks_For_Expr_With_Actions
                       (Else_Part,
                        Else_Actions (Expr),
                        EW_Pred,
                        Params =>
                          (Params with delta Warn_On_Dead => Warn_Else));

                  return
                    New_Conditional
                      (Ada_Node  => Expr,
                       Condition => Transform_Prog (Cond, Params),
                       Then_Part => Then_Checks,
                       Else_Part => Else_Checks);
               end;

            when N_Case_Expression         =>

               --  Warn on dead branches inside a case expression

               Warn_On_Dead_Branches := True;

               declare
                  function Compute_Runtime_Checks_For_Case_Expr is new
                    Generate_Case_Expression
                      (Compute_Runtime_Checks_For_Expr_With_Actions);

               begin
                  return
                    +Compute_Runtime_Checks_For_Case_Expr
                       (Expr, EW_Prog, Params);
               end;

            when N_Function_Call           =>
               declare
                  Subp        : constant Entity_Id :=
                    Get_Called_Entity_For_Proof (Expr);
                  Name_String : constant String :=
                    Get_Name_String (Chars (Subp));
                  Fst_Param   : constant Node_Id := First_Actual (Expr);
                  Snd_Param   : constant Node_Id := Next_Actual (Fst_Param);
                  Premise     : Node_Id;
                  Consequence : Node_Id;
                  Result      : W_Statement_Sequence_Id := Void_Sequence;

               begin
                  pragma
                    Assert (Is_From_Hardcoded_Unit (Subp, Cut_Operations));

                  --  For both BY and SO, we generate:
                  --    Ignore
                  --      (<Compute_Runtime_Checks (Premise)>;
                  --       assume {<Compute_Result (Premise)>};
                  --       <Compute_Runtime_Checks (Consequence)>;
                  --       assert {<Compute_Premise (Consequence)>})

                  if Name_String = COpN.By then
                     Premise := Snd_Param;
                     Consequence := Fst_Param;
                  else
                     pragma Assert (Name_String = COpN.So);
                     Premise := Fst_Param;
                     Consequence := Snd_Param;
                  end if;

                  if Contains_Cut_Operations (Premise) then
                     Append (Result, Compute_Runtime_Checks (Premise));
                     Append
                       (Result,
                        New_Assume_Statement
                          (Pred => Compute_Result (Premise)));

                  --  If the premise does not contain any cut operation, avoid
                  --  the duplication by generating:
                  --    let temp_premise = <Premise> in
                  --    assume { temp_premise }
                  --  We do not do the same for the consequence as we would
                  --  lose the splitting.

                  else
                     declare
                        Tmp : constant W_Identifier_Id :=
                          New_Temp_Identifier
                            (Base_Name => "premise", Typ => EW_Bool_Type);
                     begin
                        Append
                          (Result,
                           New_Typed_Binding
                             (Name    => Tmp,
                              Def     => Transform_Prog (Premise, Params),
                              Context => New_Assume_Statement (Pred => +Tmp)));
                     end;
                  end if;

                  Append (Result, Compute_Runtime_Checks (Consequence));
                  Append
                    (Result,
                     New_Located_Assert
                       (Ada_Node => Consequence,
                        Reason   => VC_Assert_Step,
                        Kind     => EW_Assert,
                        Pred     =>
                          Compute_Premise (Consequence, Split_Params)));
                  return New_Ignore (Prog => +Result);
               end;

            when others                    =>
               raise Program_Error;
         end case;
      end Compute_Runtime_Checks;

      --  Start of processing for Transform_Expr_With_Cutpoints

   begin
      Premise := Compute_Premise (Assertion, Split_Params);
      Result := Compute_Result (Assertion);
      Runtime := Compute_Runtime_Checks (Assertion);
   end Transform_Expr_With_Cutpoints;

   -----------------------------
   -- Transform_Function_Call --
   -----------------------------

   function Transform_Function_Call
     (Expr           : Node_Id;
      Domain         : EW_Domain;
      Params         : Transformation_Params;
      Validity_Check : Validity_Check_Kind := Do_Check) return W_Expr_Id
   is
      Context   : Ref_Context;
      Store     : W_Statement_Sequence_Id := Void_Sequence;
      Exc_Store : W_Statement_Sequence_Id := Void_Sequence;
      T         : W_Expr_Id;
      Subp      : constant Entity_Id := Get_Called_Entity_For_Proof (Expr);

      Selector :
        constant Selection_Kind
                 --  When the call is dispatching, use the Dispatch variant of
                 --  the program function, which has the appropriate contract.

      :=
          (if Nkind (Expr) = N_Function_Call
             and then Present (Controlling_Argument (Expr))
           then Dispatch

           --  In the program domain, if the call has visibility over the
           --  refined postcondition or the expression function completion of
           --  the subprogram, use the Refine variant of the program function,
           --  which has the appropriate refined contract.

           elsif Domain = EW_Prog
             and then Entity_Body_In_SPARK (Subp)
             and then Has_Refinement (Subp)
             and then Has_Visibility_On_Refined_Expr (Expr, Subp)
           then Refine

           --  Otherwise use the Standard variant of the program function
           --  (defined outside any namespace, directly in the module for
           --  the program function).

           else Why.Inter.Standard);

      Tag_Expr : constant W_Expr_Id :=
        (if Selector = Dispatch
         then
           Transform_Expr
             (Expr   => Controlling_Argument (Expr),
              Domain => Term_Domain (Domain),
              Params => Params)
         else Why_Empty);
      Tag_Arg  : constant W_Expr_Array :=
        (if Selector = Dispatch
         then
           (1 =>
              New_Tag_Access
                (Domain => Term_Domain (Domain),
                 Name   => Tag_Expr,
                 Ty     => Get_Ada_Node (+Get_Type (Tag_Expr))))
         else (1 .. 0 => <>));
      --  Calls to dispatching function need the dispatching tag as an
      --  additional argument.

      Use_Tmps : constant Boolean :=
        Domain = EW_Prog
        and then
          (Subp_Needs_Invariant_Checks (Subp, Current_Subp)
           or else Call_Needs_Variant_Check (Expr, Current_Subp));
      --  If we need to introduce an invariant or variant check on call,
      --  arguments of the call will be used twice (once for the actual code
      --  and once for the call to the checking procedure). In this case, we
      --  want to introduce let bindings for parameters so that we do not
      --  duplicate checks.

      Subdomain : constant EW_Domain :=
        (if Domain = EW_Pred then EW_Term else Domain);
      Args      : constant W_Expr_Array :=
        Tag_Arg
        & Compute_Call_Args
            (Call      => Expr,
             Domain    => Subdomain,
             Context   => Context,
             Store     => Store,
             Exc_Store => Exc_Store,
             Params    => Params,
             Use_Tmps  => Use_Tmps);

      Why_Name              : W_Identifier_Id;
      Specialization_Module : Symbol := No_Symbol;
      --  Name of the specialization module if Expr is a specialized call to
      --  a function with higher order specialization.

   begin
      --  Hardcoded function calls are transformed in a specific function

      if Is_Hardcoded_Entity (Subp) then

         --  If we are translating a call function used to encode literals,
         --  try to get a precise value for the result of the call if possible.

         if Is_Literal_Function (Subp) then
            T := Transform_Hardcoded_Literal (Expr, Domain);

            --  If the precise transformation was succesful, return it

            if T /= Why_Empty then
               return T;
            end if;
         end if;

         T := Transform_Hardcoded_Function_Call (Subp, Args, Domain, Expr);

         --  Raise a warning on imprecise translation

         if Is_Imprecisely_Hardcoded (Subp) then
            Warning_Msg_N (Warn_Imprecise_Call, Expr, Names => [Subp]);
         end if;

         return T;
      end if;

      --  For functions with higher order specialization, generate a
      --  specialized version if needed and call it instead.

      if Is_Specialized_Call (Expr, Specialized_Call_Params) then
         Create_Theory_For_HO_Specialization_If_Needed (Expr);
         Specialization_Module := Get_Specialization_Theory_Name (Expr);

         declare
            HO_Specialization : constant M_HO_Specialization_Type :=
              M_HO_Specializations (Subp) (Specialization_Module);
         begin
            if Domain = EW_Prog then
               Why_Name := HO_Specialization.Prog_Id;
            else
               Why_Name := HO_Specialization.Fun_Id;
            end if;
         end;
      else
         Why_Name :=
           W_Identifier_Id
             (Transform_Identifier
                (Params   => Params,
                 Expr     => Expr,
                 Ent      => Subp,
                 Domain   => Domain,
                 Selector => Selector));
      end if;

      T :=
        New_Function_Call
          (Ada_Node              => Expr,
           Domain                => Domain,
           Subp                  => Subp,
           Selector              => Selector,
           Name                  => Why_Name,
           Args                  => Args,
           Check                 =>
             Domain = EW_Prog
             and then Why_Subp_Has_Precondition (Subp, Selector),
           Typ                   => Get_Typ (Why_Name),
           Specialization_Module => Specialization_Module);

      --  For functions with potentially invalid result, handle the validity
      --  flag.

      if Is_Potentially_Invalid (Subp) and then Validity_Check /= Keep_Wrapper
      then
         T :=
           New_Function_Valid_Value_Access
             (Ada_Node => Expr,
              Ty       => Etype (Subp),
              Name     => T,
              Do_Check => Validity_Check = Do_Check and then Domain = EW_Prog);
      end if;

      --  There are no tag checks on dispatching equality. Instead, the
      --  operator returns False. Take care of this special case by
      --  constructing the expression:
      --  if x.tag = y.tag then f x y else false

      if Selector = Dispatch and then Is_Rewritten_Op_Eq (Expr) then
         declare
            Tags   : W_Expr_Array (1 .. 2);
            Tag_Id : Positive := 1;

            procedure One_Param (Formal : Entity_Id; Actual : Node_Id);
            --  Compute the tag expression for each parameter and store it
            --  inside Tags.

            ---------------
            -- One_Param --
            ---------------

            procedure One_Param (Formal : Entity_Id; Actual : Node_Id) is
               pragma Unreferenced (Formal);
               pragma Assert (Is_Controlling_Actual (Actual));
               Tmp : constant W_Expr_Id :=
                 Transform_Expr (Actual, Term_Domain (Domain), Params);
            begin
               Tags (Tag_Id) :=
                 New_Tag_Access
                   (Ada_Node => Actual,
                    Domain   => Term_Domain (Domain),
                    Name     => Tmp,
                    Ty       => Get_Ada_Node (+Get_Type (Tmp)));
               Tag_Id := Tag_Id + 1;
            end One_Param;

            procedure Iterate_Call is new Iterate_Call_Parameters (One_Param);

         begin
            Iterate_Call (Expr);

            T :=
              New_Conditional
                (Ada_Node  => Expr,
                 Domain    => Domain,
                 Condition =>
                   New_Comparison
                     (Symbol => Why_Eq,
                      Left   => Tags (1),
                      Right  => Tags (2),
                      Domain => Domain),
                 Then_Part => T,
                 Else_Part => Bool_False (Domain),
                 Typ       => EW_Bool_Type);
         end;
      end if;

      if Domain = EW_Prog then

         --  Insert static resource leak on calls to allocating functions
         --  occuring inside assertions, but only if they contain parts of a
         --  pool specific access type.

         if Is_Allocating_Function (Subp)
           and then Contains_Allocated_Parts (Etype (Subp))
           and then
             In_Statically_Leaking_Context (Expr, Ignore_Non_Exec => True)
           and then
             not (Is_Ghost_Entity (Current_Subp)
                  and then
                    Is_Non_Exec_Assertion_Level
                      (Ghost_Assertion_Level (Current_Subp)))
         then
            Emit_Static_Proof_Result
              (Expr,
               VC_Resource_Leak,
               False,
               Current_Subp,
               Explanation =>
                 "call to allocating function inside "
                 & "an assertion leaks some resource or memory");
         end if;

         --  Insert invariant check if needed

         if Subp_Needs_Invariant_Checks (Subp, Current_Subp) then
            Prepend (Check_Type_Invariants_For_Call (Expr, Params), T);
         end if;

         --  Insert tag check if needed

         if Selector = Dispatch and then not Is_Rewritten_Op_Eq (Expr) then
            Prepend (Compute_Tag_Check (Expr, Params), T);
         end if;

         --  Insert variant check

         if Call_Needs_Variant_Check (Expr, Current_Subp) then
            Prepend
              (Check_Subprogram_Variants
                 (Call                  => Expr,
                  Args                  => Args,
                  Params                => Params,
                  Specialization_Module => Specialization_Module),
               T);
         end if;

         --  Insert termination check if the enclosing subprogram has a dynamic
         --  termination condition.
         --  As in general functions always terminate, this is only needed
         --  for calls which cannot terminate (because they might hide
         --  recursivity).
         --  If the callee is ghost and not the caller, the check was done in
         --  flow analysis. Do not duplicate it here.

         if Ekind (Current_Subp) in E_Procedure | E_Entry
           and then Get_Termination_Condition (Current_Subp).Kind = Dynamic
           and then Call_Never_Terminates (Expr, Current_Subp)
           and then
             not (Is_Ghost_Entity (Subp)
                  and then not Is_Ghost_Entity (Current_Subp))
         then
            pragma Assert (Termination_Condition_Name /= Why_Empty);

            Prepend
              (New_Ignore
                 (Prog =>
                    New_Located_Assert
                      (Ada_Node => Expr,
                       Pred     =>
                         New_Not (Right => +Termination_Condition_Name),
                       Reason   => VC_Termination_Check,
                       Kind     => EW_Assert)),
               T);
         end if;
      end if;

      --  We may need a context if we have introduced constants for expressions
      --  which mandate checks in parameters and possibly also a store for
      --  volatile functions and havocs for parameters of functions with
      --  side-effects. This can only occur in the program domain.

      if Domain = EW_Prog then
         T := +Insert_Ref_Context (Expr, +T, Context, Store);
      end if;

      --  If Subp has a controlling result, its result will have the correct
      --  tag even if it was inherited, as the frontend introduces an
      --  expression function wrapper with a conversion.

      pragma
        Assert
          (if Ekind (Subp) = E_Function and then Has_Controlling_Result (Subp)
           then Base_Retysp (Etype (Subp)) = Base_Retysp (Etype (Expr)));
      return T;
   end Transform_Function_Call;

   ----------------------------------
   -- Transform_Handled_Statements --
   ----------------------------------

   function Transform_Handled_Statements
     (N : Node_Id; Params : Transformation_Params) return W_Prog_Id
   is

      function Transform_Handler (Handler : Node_Id) return W_Prog_Id
      is (+Warn_On_Dead_Code
             (First (Statements (Handler)),
              +Transform_Statements_And_Declarations
                 (Statements (Handler), Params),
              Params.Phase,
              Params.Warn_On_Dead));
      --  Transform the statements and warn on dead code if necessary

      function List_Length_Non_Pragma (L : List_Id) return Nat;
      --  Similar to List_Length, but excluding pragma items
      --  ??? this routine could be moved to the frontend

      ----------------------------
      -- List_Length_Non_Pragma --
      ----------------------------

      function List_Length_Non_Pragma (L : List_Id) return Nat is
         Length : Nat := 0;
         Item   : Node_Id := First_Non_Pragma (L);
      begin
         while Present (Item) loop
            Length := Length + 1;
            Next_Non_Pragma (Item);
         end loop;
         return Length;
      end List_Length_Non_Pragma;

      Handlers : constant List_Id := Exception_Handlers (N);
      Core     : W_Prog_Id :=
        Transform_Statements_And_Declarations (Statements (N), Params);

      --  Start of processing for Transform_Handled_Statements

   begin
      if Present (Handlers) then
         declare
            Save_Exception_Name : constant W_Identifier_Id :=
              Handled_Exception_Name;
            Exc_Id              : constant W_Identifier_Id :=
              New_Temp_Identifier (Base_Name => "exc", Typ => EW_Int_Type);
            Others_Present      : constant Boolean :=
              Nkind (First (Exception_Choices (Last_Non_Pragma (Handlers))))
              = N_Others_Choice;
            Nb_Cases            : constant Positive :=
              Natural (List_Length_Non_Pragma (Handlers));
            Elsif_Parts         :
              W_Prog_Array (2 .. Nb_Cases - (if Others_Present then 1 else 0));
            Else_Part           : W_Prog_Id;
            Handler             : Node_Id := First_Non_Pragma (Handlers);
            W_Handler           : W_Prog_Id;
            Handled_Exc         : constant Exception_Sets.Set :=
              Get_Exceptions_From_Handlers (N);
            Handled_Above       : constant Exception_Sets.Set :=
              Get_Handled_Exceptions (N);

         begin
            --  Store the name of the current exception, to be used in reraise
            --  statements inside handlers.

            Handled_Exception_Name := Exc_Id;

            if Nb_Cases = 1 and then Others_Present then
               W_Handler := Transform_Handler (Handler);
            else
               --  Fill the Elsif_Parts if any

               Next_Non_Pragma (Handler);
               if Elsif_Parts'Length > 0 then
                  for Num in Elsif_Parts'Range loop
                     Elsif_Parts (Num) :=
                       New_Elsif
                         (Condition =>
                            +Compute_Guard_For_Exceptions
                               (Exception_Choices (Handler), Exc_Id, EW_Prog),
                          Then_Part => Transform_Handler (Handler));
                     Next_Non_Pragma (Handler);
                  end loop;
               end if;

               --  Fill the Else_Part if any

               if Others_Present then
                  Else_Part := Transform_Handler (Handler);

               --  If there are some expected exceptions above N, reraise the
               --  exception in the others case as it was not actually caught.

               elsif not Handled_Above.Is_Subset (Handled_Exc) then
                  Else_Part :=
                    Sequence
                      (Left  => Finalization_Actions_On_Raise (N, Params),
                       Right =>
                         New_Raise (Name => M_Main.Ada_Exc, Arg => +Exc_Id));

               --  All exceptions will be handled at this point as we only
               --  raise expected exceptions.

               else
                  Else_Part := +Void;
               end if;

               --  Reconstruct the conditional

               Handler := First_Non_Pragma (Handlers);

               W_Handler :=
                 New_Conditional
                   (Ada_Node    => N,
                    Condition   =>
                      +Compute_Guard_For_Exceptions
                         (Exception_Choices (Handler), Exc_Id, EW_Prog),
                    Then_Part   => Transform_Handler (Handler),
                    Elsif_Parts => Elsif_Parts,
                    Else_Part   => Else_Part);
            end if;

            --  Reset the exception name

            Handled_Exception_Name := Save_Exception_Name;

            Core :=
              New_Try_Block
                (Ada_Node => N,
                 Prog     => Core,
                 Handler  =>
                   (1 =>
                      New_Handler
                        (Name   => M_Main.Ada_Exc,
                         Arg_Id => Exc_Id,
                         Def    => W_Handler)));
         end;
      end if;

      if Present (Finally_Statements (N)) then
         Append
           (Core,
            Transform_Statements_And_Declarations
              (Finally_Statements (N), Params));
      end if;

      return Core;
   end Transform_Handled_Statements;

   --------------------------
   -- Transform_Identifier --
   --------------------------

   function Transform_Identifier
     (Params            : Transformation_Params;
      Expr              : Node_Id;
      Ent               : Entity_Id;
      Domain            : EW_Domain;
      Selector          : Selection_Kind := Why.Inter.Standard;
      No_Init_Check     : Boolean := False;
      No_Validity_Check : Boolean := False) return W_Expr_Id
   is
      C : constant Ada_Ent_To_Why.Cursor :=
        Ada_Ent_To_Why.Find (Symbol_Table, Ent);
      T : W_Expr_Id;

   begin
      --  Emit warning on constants declared before the loop invariant if their
      --  value might not be known precisely at the current program point.

      if Imprecise_Constant_Value_In_Loop (Ent) then
         pragma Assert (Is_Loop_Entity (Ent));
         Warning_Msg_N (Warn_Loop_Entity, Expr, Names => [Ent]);
      end if;

      --  The special cases of this function are:
      --  * parameters, whose names are stored in Params.Name_Map (these can
      --    also be refs)
      --    ??? Params has no Name_Map component
      --  * quantified variables (use local name instead of global name)
      --  * fields of protected objects

      if Ada_Ent_To_Why.Has_Element (C) then
         declare
            E : constant Item_Type := Ada_Ent_To_Why.Element (C);

         begin
            pragma
              Assert (if Selector /= Why.Inter.Standard then E.Kind = Subp);

            --  If E is a subprogram, use tha appropriate symbol depending on
            --  the domain and the selector.

            if E.Kind = Subp then
               case Selector is
                  when Why.Inter.Standard =>
                     if Domain = EW_Prog then
                        T := +E.For_Prog;
                     else
                        T := +E.For_Logic.Id;
                     end if;

                  when Why.Inter.Dispatch =>
                     if Domain = EW_Prog then
                        T := +E.Dispatch_Prog.Id;
                     else
                        T := +E.Dispatch_Logic.Id;
                     end if;

                  when Why.Inter.Refine   =>
                     if Domain = EW_Prog then
                        T := +E.Refine_Prog.Id;
                     else
                        T := +E.For_Logic.Id;
                     end if;
               end case;
            else
               declare
                  Alias : constant Opt_Object_Kind_Id :=
                    Ultimate_Overlaid_Entity (Ent);
                  Var   : constant W_Expr_Id :=
                    Reconstruct_Item
                      (E,
                       Domain,
                       Params.Ref_Allowed,
                       Alias =>
                         (if Present (Alias) and then Is_Mutable_In_Why (Ent)
                          then
                            Transform_Identifier (Params, Expr, Alias, Domain)
                          else Why_Empty));
               begin
                  T := Var;

                  --  Introduce initialization check if the object has an
                  --  Init component or is ultimately a scalar. Check the
                  --  predicates on initialization wrappers if any.

                  if Is_Object (Ent)
                    and then Domain = EW_Prog
                    and then not No_Init_Check
                  then
                     if E.Init.Present then
                        declare
                           Init_Flag : constant W_Expr_Id :=
                             (if Params.Ref_Allowed
                              then
                                New_Deref
                                  (Right => E.Init.Id, Typ => EW_Bool_Type)
                              else +E.Init.Id);
                        begin
                           Prepend
                             (New_Assert
                                (Pred        =>
                                   New_VC_Pred
                                     (Expr,
                                      Pred_Of_Boolean_Term (+Init_Flag),
                                      VC_Initialization_Check),
                                 Assert_Kind => EW_Assert),
                              T);
                        end;

                     elsif Is_Init_Wrapper_Type (Get_Type (T)) then

                        --  Skip the top level predicate for parameters of
                        --  predicate functions.

                        declare
                           Top_Predicate : constant Boolean :=
                             Ekind (Ent) /= E_In_Parameter
                             or else
                               not Is_Predicate_Function
                                     (Enclosing_Unit (Ent));
                           Typ           : constant Entity_Id :=
                             Get_Ada_Type_From_Item (E);
                        begin
                           if Has_Scalar_Full_View (Typ) then

                              --  Inputs of scalar types do not use the init
                              --  wrapper.

                              pragma Assert (Top_Predicate);

                              T :=
                                Insert_Initialization_Check
                                  (Expr,
                                   Typ,
                                   T,
                                   Domain,
                                   Exclude_Components => Relaxed);
                           else
                              T :=
                                +Insert_Predicate_Check
                                   (Expr, Typ, +T, Top_Predicate);
                           end if;

                           --  The parameter of a "for of" quantification over
                           --  arrays is basically an indexed component.
                           --  Check initialization of access address or
                           --  mutable discriminants.

                           if Is_Quantified_Param_Over_Array (Ent) then
                              T :=
                                Insert_Top_Level_Init_Check
                                  (Expr, Typ, T, Domain);
                           end if;
                        end;
                     end if;
                  end if;

                  --  Introduce a validity check if the object has a Valid flag

                  if Object_Has_Valid_Id (Ent)
                    and then Domain = EW_Prog
                    and then not No_Validity_Check
                  then
                     declare
                        Tmp : constant W_Expr_Id := New_Temp_For_Expr (T);
                     begin
                        T :=
                          +Sequence
                             (New_Assert
                                (Pred        =>
                                   New_VC_Pred
                                     (Expr,
                                      +New_Is_Valid_Call_For_Expr
                                         (Tree   =>
                                            +Get_Valid_Id_From_Object
                                               (Ent, Params.Ref_Allowed),
                                          Expr   => Tmp,
                                          Ty     => Etype (Ent),
                                          Domain => EW_Pred),
                                      VC_Validity_Check),
                                 Assert_Kind => EW_Assert),
                              +Tmp);
                        T :=
                          Binding_For_Temp
                            (Tmp => Tmp, Context => T, Domain => Domain);
                     end;
                  end if;

                  --  If we have an object with Async_Writers, we must havoc it
                  --  before dereferencing it. Given a ref term t, this
                  --  produces the sequence:
                  --     (__havoc(t); !t)
                  --  It is sound (and necessary) to only do that in the
                  --  program domain. We can be sure that the relevant Ada code
                  --  will pass this point at least once in program domain.
                  --  No need to havoc anything for overlays, the alias is
                  --  havocked when it is translated as volatile parameter for
                  --  the function call.

                  if Is_Object (Ent)
                    and then Has_Volatile (Ent)
                    and then Has_Volatile_Property (Ent, Pragma_Async_Writers)
                    and then Domain in EW_Prog | EW_Pterm
                    and then Params.Ref_Allowed
                    and then No (Alias)
                  then
                     pragma Assert (Is_Mutable_In_Why (Ent));

                     --  Assume dynamic invariant of the object after havoc

                     declare
                        Typ      : constant Entity_Id := Type_Of_Node (Ent);
                        Dyn_Prop : constant W_Pred_Id :=
                          Compute_Dynamic_Invariant
                            (Expr   => +Var,
                             Ty     => Typ,
                             Params => Params,
                             Valid  =>
                               Get_Valid_Id_From_Object
                                 (Ent, Params.Ref_Allowed));
                        Eff      : constant W_Effects_Id := New_Effects;
                        procedure Effects_Append_Binder_To_Writes is new
                          Effects_Append_Binder (Effects_Append_To_Writes);
                        Havoc    : W_Prog_Id := +Void;

                     begin
                        Effects_Append_Binder_To_Writes (Eff, E);
                        Havoc := New_Havoc_Statement (Effects => Eff);

                        if Dyn_Prop /= True_Pred then
                           Prepend
                             (New_Assume_Statement (Pred => Dyn_Prop), T);
                        end if;

                        Prepend (Havoc, T);
                     end;
                  end if;
               end;
            end if;
         end;

      --  Discriminals are not translated in Why3. Use their discriminal link
      --  instead.

      elsif Is_Discriminal (Ent) then
         T :=
           Transform_Identifier
             (Params            => Params,
              Expr              => Expr,
              Ent               => Discriminal_Link (Ent),
              Domain            => Domain,
              Selector          => Selector,
              No_Init_Check     => No_Init_Check,
              No_Validity_Check => No_Validity_Check);

      elsif Is_Protected_Component_Or_Discr_Or_Part_Of (Ent) then
         declare
            Prot : constant Entity_Id := Enclosing_Concurrent_Type (Ent);

            pragma Assert (Ekind (Prot) = E_Protected_Type);

            --  The Ada_Node is important here, because that's how we detect
            --  occurrences of "self" in a term later.

            Id : constant W_Identifier_Id :=
              New_Identifier
                (Name     => "self__",
                 Ada_Node => Prot,
                 Typ      => Type_Of_Node (Prot));
         begin
            T :=
              New_Ada_Record_Access
                (Ada_Node => Expr,
                 Domain   => Domain,
                 Name     =>
                   (if Self_Is_Mutable
                    then New_Deref (Right => Id, Typ => Type_Of_Node (Prot))
                    else +Id),
                 Field    => Ent,
                 Ty       => Prot);
         end;
      else
         Ada.Text_IO.Put_Line
           ("[Transform_Identifier] unregistered entity " & Full_Name (Ent));
         raise Program_Error;
      end if;

      return T;
   end Transform_Identifier;

   -------------------------------------
   -- Transform_Membership_Expression --
   -------------------------------------

   function Transform_Membership_Expression
     (Params : Transformation_Params;
      Domain : EW_Domain;
      Expr   : N_Membership_Test_Id) return W_Expr_Id
   is

      function Initialization_Check_For_Eq return Boolean;
      --  Return True if we need to initialize the lefthand side so it is safe
      --  to compute the equality on it.
      --  The function returns True even if the membership test uses a
      --  primitive equality with relaxed inputs. Indeed, the translation uses
      --  _user_eq which never expects wrappers for now.

      function Initialization_Check_For_Preds return Boolean;
      --  Return True if we need to initialize the lefthand side so it is safe
      --  to check its predicates.

      function Transform_Alternative
        (Var             : W_Expr_Id;
         Alt             : Node_Id;
         Base_Type       : W_Type_Id;
         Use_Dispatch_Eq : Boolean := False) return W_Expr_Id;
      --  If the alternative Alt is a subtype mark, transform it as a simple
      --  membership test "Var in Alt". Otherwise transform it as an equality
      --  test "Var = Alt".
      --  If Use_Dispatch_Eq is set to true, calls to equality will be turned
      --  into calls to dispatching equality instead.

      function Transform_Simple_Membership_Expression
        (Var : W_Expr_Id; In_Expr : Node_Id; Base_Type : W_Type_Id)
         return W_Expr_Id;

      ---------------------------------
      -- Initialization_Check_For_Eq --
      ---------------------------------

      function Initialization_Check_For_Eq return Boolean is
      begin
         if Present (Alternatives (Expr)) then
            declare
               Alt : Node_Id := First (Alternatives (Expr));
            begin
               Alt := First (Alternatives (Expr));
               while Present (Alt) loop
                  if Alternative_Uses_Eq (Alt) then
                     return True;
                  end if;
                  Next (Alt);
               end loop;
            end;
         elsif Alternative_Uses_Eq (Right_Opnd (Expr)) then
            return True;
         end if;
         return False;
      end Initialization_Check_For_Eq;

      ------------------------------------
      -- Initialization_Check_For_Preds --
      ------------------------------------

      function Initialization_Check_For_Preds return Boolean is

         function Contains_Preds (Alt : Node_Id) return Boolean
         is (Is_Entity_Name (Alt)
             and then Is_Type (Entity (Alt))
             and then Has_Predicates (Entity (Alt))
             and then Predicate_Requires_Initialization (Entity (Alt)));
         --  Return True if the evaluation of a membership test with Alt
         --  involves the evaluation of a predicate which requires
         --  initialization.

      begin
         if Present (Alternatives (Expr)) then
            declare
               Alt : Node_Id := First (Alternatives (Expr));
            begin
               Alt := First (Alternatives (Expr));
               while Present (Alt) loop
                  if Contains_Preds (Alt) then
                     return True;
                  end if;
                  Next (Alt);
               end loop;
            end;
         elsif Contains_Preds (Right_Opnd (Expr)) then
            return True;
         end if;
         return False;
      end Initialization_Check_For_Preds;

      ---------------------------
      -- Transform_Alternative --
      ---------------------------

      function Transform_Alternative
        (Var             : W_Expr_Id;
         Alt             : Node_Id;
         Base_Type       : W_Type_Id;
         Use_Dispatch_Eq : Boolean := False) return W_Expr_Id
      is
         Result    : W_Expr_Id;
         Subdomain : constant EW_Domain :=
           (if Domain = EW_Pred then EW_Term else Domain);
         --  We check equality on initialized objects

      begin
         if (Is_Entity_Name (Alt) and then Is_Type (Entity (Alt)))
           or else Nkind (Alt) = N_Range
         then
            Result :=
              Transform_Simple_Membership_Expression (Var, Alt, Base_Type);
         elsif Use_Dispatch_Eq then
            Result :=
              New_Ada_Dispatching_Equality
                (Typ    => Etype (Left_Opnd (Expr)),
                 Left   => Var,
                 Right  =>
                   Transform_Expr
                     (Expr          => Alt,
                      Expected_Type => Base_Type,
                      Domain        => Subdomain,
                      Params        => Params),
                 Domain => Domain);
         else
            declare
               Right_Expr : W_Expr_Id :=
                 Transform_Expr
                   (Expr          => Alt,
                    Expected_Type => Base_Type,
                    Domain        => Subdomain,
                    Params        => Params);
            begin
               Right_Expr :=
                 Insert_Invariant_Check_For_Eq
                   (Ada_Node         => Alt,
                    Typ              => Etype (Alt),
                    W_Expr           => Right_Expr,
                    Domain           => Subdomain,
                    Force_Predefined => False);
               Result :=
                 New_Ada_Equality
                   (Typ    => Etype (Left_Opnd (Expr)),
                    Left   => Var,
                    Right  => Right_Expr,
                    Domain => Domain);
            end;
         end if;

         return Result;
      end Transform_Alternative;

      --------------------------------------------
      -- Transform_Simple_Membership_Expression --
      --------------------------------------------

      function Transform_Simple_Membership_Expression
        (Var : W_Expr_Id; In_Expr : Node_Id; Base_Type : W_Type_Id)
         return W_Expr_Id
      is
         True_Expr : constant W_Expr_Id :=
           (if Domain = EW_Pred then +True_Pred else +True_Term);
         Result    : W_Expr_Id;
         Var_Tmp   : constant W_Term_Id := New_Temp_For_Expr (Var);

      begin
         --  First handle the simpler case of s subtype mark Classwide types
         --  appear as a N_Attribute_Reference.

         if (Nkind (In_Expr) in N_Identifier | N_Expanded_Name
             and then Is_Type (Entity (In_Expr)))
           or else
             (Nkind (In_Expr) = N_Attribute_Reference
              and then
                Get_Attribute_Id (Attribute_Name (In_Expr)) = Attribute_Class)
         then
            declare
               Ty : constant Entity_Id := Unique_Entity (Entity (In_Expr));

            begin
               --  Record subtypes are special

               if Is_Record_Type_In_Why (Ty) then

                  --  We must check for two cases. Ty may be constrained, in
                  --  which case we need to check its dicriminant, or it may
                  --  be tagged, in which case we need to check its tag.

                  declare
                     Discr_Cond : W_Expr_Id := True_Expr;
                     Tag_Cond   : W_Expr_Id := True_Expr;
                     Spec_Ty    : constant Entity_Id :=
                       (if Is_Class_Wide_Type (Ty)
                        then Retysp (Get_Specific_Type_From_Classwide (Ty))
                        else Retysp (Ty));
                     Conc_Var   : constant W_Term_Id :=
                       Insert_Simple_Conversion
                         (Expr => Var_Tmp, To => EW_Abstract (Ty));
                     --  If Var is partially initialized, we need to go to the
                     --  concrete type to introduce the checks. Do not check
                     --  for initialization here.
                  begin

                     --  If Ty is constrained, we need to check its
                     --  discriminant.
                     --  It is also the case if Ty's specific type is
                     --  constrained, see RM 3.9 (14).

                     if Root_Retysp (Spec_Ty) /= Spec_Ty
                       and then Has_Discriminants (Spec_Ty)
                       and then Is_Constrained (Spec_Ty)
                     then
                        Discr_Cond :=
                          New_Call
                            (Domain => Domain,
                             Name   =>
                               E_Symb (Root_Retysp (Spec_Ty), WNE_Range_Pred),
                             Args   =>
                               Prepare_Args_For_Subtype_Check
                                 (Spec_Ty,
                                  +Conc_Var,
                                  Term_Domain (Domain),
                                  Params),
                             Typ    => EW_Bool_Type);
                     end if;

                     --  If Ty is tagged, we need to check its tag

                     if Is_Tagged_Type (Ty) and then Is_Class_Wide_Type (Ty)
                     then

                        --  If we are checking against a classwide type, it is
                        --  enough to check wether Var can be converted to Ty.

                        declare
                           Var_Type : constant Entity_Id :=
                             Get_Ada_Node (+Get_Type (+Var_Tmp));
                        begin
                           pragma Assert (Present (Var_Type));

                           if not SPARK_Util.Types.Is_Ancestor (Ty, Var_Type)
                           then
                              Tag_Cond :=
                                New_Call
                                  (Domain => Domain,
                                   Name   =>
                                     Get_Compatible_Tags_Predicate (Ty),
                                   Args   =>
                                     (1 =>
                                        New_Tag_Access
                                          (Domain => EW_Term,
                                           Name   => +Var_Tmp,
                                           Ty     => Var_Type),
                                      2 => +E_Symb (E => Ty, S => WNE_Tag)),
                                   Typ    => EW_Bool_Type);
                           end if;
                        end;
                     elsif Is_Tagged_Type (Retysp (Ty)) then

                        --  If we are checking against a specific type, then
                        --  the tags of Var and Ty must match.

                        Tag_Cond :=
                          New_Call
                            (Domain => Domain,
                             Name   => Why_Eq,
                             Args   =>
                               (1 =>
                                  New_Tag_Access
                                    (Domain => EW_Term,
                                     Name   => +Var_Tmp,
                                     Ty     =>
                                       Get_Ada_Node (+Get_Type (+Var_Tmp))),
                                2 => +E_Symb (E => Ty, S => WNE_Tag)),
                             Typ    => EW_Bool_Type);
                     end if;

                     --  Go back to the appropriate domain

                     declare
                        Condition : constant W_Expr_Id :=
                          New_And_Expr (Discr_Cond, Tag_Cond, Domain);
                     begin
                        if Domain = EW_Pred then
                           Result := Condition;
                        else
                           Result :=
                             New_Conditional
                               (Domain    => Domain,
                                Condition => Condition,
                                Then_Part => True_Expr,
                                Else_Part => +False_Term,
                                Typ       => EW_Bool_Type);
                        end if;
                     end;
                  end;

               elsif Is_Array_Type (Ty) then

                  --  There are no constraints to check if the type is
                  --  unconstrained.

                  if Is_Constrained (Ty) then
                     declare
                        Var_Type   : constant Entity_Id :=
                          Get_Ada_Node (+Get_Type (+Var_Tmp));
                        False_Expr : constant W_Expr_Id :=
                          (if Domain = EW_Pred
                           then +False_Pred
                           else +False_Term);

                     begin
                        --  For static arrays, we do the check statically

                        if Is_Static_Array_Type (Ty)
                          and then Is_Static_Array_Type (Var_Type)
                        then
                           declare
                              Ty_Index  : Node_Id := First_Index (Ty);
                              Var_Index : Node_Id := First_Index (Var_Type);
                           begin
                              if Ekind (Var_Type) = E_String_Literal_Subtype
                              then
                                 if Expr_Value
                                      (String_Literal_Low_Bound (Var_Type))
                                   /= Expr_Value
                                        (Low_Bound (Get_Range (Ty_Index)))
                                   or else
                                     Static_Array_Length (Var_Type, 1)
                                     /= Static_Array_Length (Ty, 1)
                                 then
                                    Result := False_Expr;
                                 else
                                    Result := True_Expr;
                                 end if;
                              else
                                 Result := True_Expr;

                                 while Present (Ty_Index) loop
                                    if Expr_Value
                                         (High_Bound (Get_Range (Ty_Index)))
                                      /= Expr_Value
                                           (High_Bound (Get_Range (Var_Index)))
                                      or else
                                        Expr_Value
                                          (Low_Bound (Get_Range (Ty_Index)))
                                        /= Expr_Value
                                             (Low_Bound
                                                (Get_Range (Var_Index)))
                                    then
                                       Result := False_Expr;
                                       exit;
                                    end if;
                                    Next_Index (Ty_Index);
                                    Next_Index (Var_Index);
                                 end loop;
                              end if;
                           end;

                        --  Otherwise, we translate the check as the
                        --  conjunction of the equality between each pair of
                        --  bounds.

                        else
                           declare
                              Equal : constant W_Pred_Id :=
                                New_Bounds_Equality (+Var_Tmp, Ty);
                           begin
                              Result := Boolean_Expr_Of_Pred (Equal, Domain);
                           end;
                        end if;
                     end;
                  else
                     Result := True_Expr;
                  end if;

               --  For access-to-subprogram types, we only check null exclusion

               elsif Is_Access_Subprogram_Type (Ty) then
                  if Can_Never_Be_Null (Ty) then
                     Result :=
                       New_Not
                         (Right  =>
                            New_Record_Access
                              (Name  => +Var_Tmp,
                               Field => M_Subprogram_Access.Rec_Is_Null,
                               Typ   => EW_Bool_Type),
                          Domain => Domain);
                  else
                     Result := True_Expr;
                  end if;

               --  For a constrained access type whose root is not constrained,
               --  use the range predicate.

               elsif Is_Access_Type (Ty) then
                  if not Is_Constrained (Root_Retysp (Ty))
                    and then Is_Constrained (Ty)
                  then
                     Result :=
                       New_Call
                         (Domain => Domain,
                          Name   =>
                            E_Symb
                              (Ty,
                               WNE_Range_Pred,
                               Relaxed_Init =>
                                 Get_Relaxed_Init (Get_Type (+Var_Tmp))),
                          Args   =>
                            Prepare_Args_For_Access_Subtype_Check
                              (Ty, +Var_Tmp, Term_Domain (Domain), Params),
                          Typ    => EW_Bool_Type);
                  else
                     Result := True_Expr;
                  end if;

                  --  For non null access types, check null exclusion

                  if Can_Never_Be_Null (Ty) then
                     Result :=
                       New_And_Then_Expr
                         (Left   => Result,
                          Right  =>
                            New_Not
                              (Right  =>
                                 New_Pointer_Is_Null_Access
                                   (E => Ty, Name => +Var_Tmp),
                               Domain => Domain),
                          Domain => Domain);
                  end if;

               else
                  pragma Assert (Is_Scalar_Type (Ty));

                  --  It can happen that Var and Ty doe not have the same base
                  --  type, in particular if Var has the universal integer
                  --  type. In this case, generate the range expression in a
                  --  type which fits both Ty and the base type of Var.

                  if Base_Why_Type_No_Bool (Ty) /= Base_Type then
                     Result :=
                       Range_Expr (Ty, +Var_Tmp, Domain, Params, Base_Type);

                  elsif Type_Is_Modeled_As_Base (Ty) then
                     Result :=
                       New_Dynamic_Property
                         (Domain => Domain, Ty => Ty, Expr => Var_Tmp);
                  else
                     declare
                        Name : constant W_Identifier_Id :=
                          (if Is_Standard_Boolean_Type (Ty)
                           then M_Boolean.Range_Pred
                           else E_Symb (Ty, WNE_Range_Pred));
                     begin
                        Result :=
                          New_Call
                            (Domain => Domain,
                             Name   => Name,
                             Args   => (1 => +Var_Tmp),
                             Typ    => EW_Bool_Type);
                     end;
                  end if;
               end if;

               --  Possibly include a predicate in the type membership test

               if Has_Predicates (Ty) then
                  Result :=
                    New_And_Expr
                      (Result,
                       Boolean_Expr_Of_Pred
                         (Compute_Dynamic_Predicate (+Var_Tmp, Ty, Params),
                          Domain),
                       Domain);
               end if;
            end;
         else
            Result :=
              Range_Expr (In_Expr, +Var_Tmp, Domain, Params, Base_Type);
         end if;

         Result :=
           Binding_For_Temp
             (Domain => Domain, Tmp => +Var_Tmp, Context => Result);

         return
           Binding_For_Temp
             (Domain => Domain, Tmp => +Var_Tmp, Context => Result);
      end Transform_Simple_Membership_Expression;

      Var          : constant Node_Id := Left_Opnd (Expr);
      Result       : W_Expr_Id;
      Relaxed_Init : constant Boolean :=
        not Initialization_Check_For_Preds
        and then not Initialization_Check_For_Eq
        and then Expr_Has_Relaxed_Init (Var, No_Eval => False);
      --  It might be necessary to introduce initialization checks for two
      --  reasons:
      --  * because the membership checking involves an equality, or
      --  * because the membership checking evaluates a subtype predicate.

      Base_Type : constant W_Type_Id :=
        (if Is_Record_Type_In_Why (Etype (Var))
         then
           EW_Abstract
             (Root_Retysp (Etype (Var)), Relaxed_Init => Relaxed_Init)
         --  For records, checks are done on the root type

         elsif Relaxed_Init
         then Type_Of_Node (Var)
         --  Do not check initialization on composite types if Relaxed_Init is
         --  True.

         else Base_Why_Type_No_Bool (Var));

      Subdomain : constant EW_Domain :=
        (if Domain = EW_Pred then EW_Term else Domain);
      Var_Expr  : W_Expr_Id;

      --  Start of processing for Transform_Membership_Expression

   begin
      --  Check the specific rules for membership tests on unchecked union
      --  types.

      if Is_Record_Type_In_Why (Etype (Var)) and then Domain = EW_Prog then
         Check_UU_Restrictions (Expr);
      end if;

      Var_Expr := Transform_Expr (Var, Base_Type, Subdomain, Params);

      --  Initialization checks for predicates are introduced by the conversion
      --  to the normal version of the type. Predefined equality might require
      --  initialization of additional subcomponents whose type has relaxed
      --  initialization.

      if Use_Predefined_Equality_For_Type (Etype (Var))
        and then Initialization_Check_For_Eq
      then
         Var_Expr :=
           Insert_Initialization_Check
             (Ada_Node           => Var,
              E                  => Etype (Var),
              Name               => Var_Expr,
              Domain             => Subdomain,
              Exclude_Components => For_Eq);
      end if;

      --  Also perform invariant checks if needed.

      Var_Expr :=
        Insert_Invariant_Check_For_Eq
          (Ada_Node         => Var,
           Typ              => Etype (Var),
           W_Expr           => Var_Expr,
           Domain           => Domain,
           Force_Predefined => False);

      if Present (Alternatives (Expr)) then
         declare
            Alt : Node_Id;
         begin
            Var_Expr := New_Temp_For_Expr (Var_Expr, True);
            Alt := Last (Alternatives (Expr));
            Result :=
              Transform_Alternative
                (Var_Expr,
                 Alt,
                 Base_Type,
                 Use_Dispatch_Eq => Call_Simulates_Contract_Dispatch (Expr));

            Prev (Alt);
            while Present (Alt) loop
               Result :=
                 New_Or_Else_Expr
                   (Left   =>
                      Transform_Alternative
                        (Var_Expr,
                         Alt,
                         Base_Type,
                         Use_Dispatch_Eq =>
                           Call_Simulates_Contract_Dispatch (Expr)),
                    Right  => Result,
                    Domain => Domain);
               Prev (Alt);
            end loop;
            Result :=
              Binding_For_Temp
                (Domain => Domain, Tmp => Var_Expr, Context => Result);
         end;
      else
         Result :=
           Transform_Simple_Membership_Expression
             (Var_Expr, Right_Opnd (Expr), Base_Type);
      end if;

      --  Inverse the result if the operator is NOT IN

      if Nkind (Expr) = N_Not_In then
         if Domain = EW_Term then
            Result :=
              New_Call
                (Ada_Node => Expr,
                 Domain   => Domain,
                 Name     => M_Boolean.Notb,
                 Args     => (1 => Result),
                 Typ      => EW_Bool_Type);

         else
            Result := New_Not (Right => Result, Domain => Domain);
         end if;
      end if;

      return Result;
   end Transform_Membership_Expression;

   ----------------------------------------
   -- Transform_Potentially_Invalid_Expr --
   ----------------------------------------

   procedure Transform_Potentially_Invalid_Expr
     (Expr       : N_Subexpr_Id;
      Domain     : EW_Domain;
      Params     : Transformation_Params;
      Context    : in out Ref_Context;
      W_Expr     : out W_Expr_Id;
      Valid_Flag : out W_Expr_Id;
      As_Old     : Boolean := False) is
   begin
      --  If As_Old is True and Params.Old_Policy = Use_Map, search for the
      --  relevant identifiers in the Old map.

      if (Nkind (Expr) /= N_Attribute_Reference
          or else Attribute_Name (Expr) /= Name_Old)
        and then As_Old
        and then Params.Old_Policy = Use_Map
      then
         W_Expr := +Name_For_Old (Expr);
         Valid_Flag := +Get_Valid_Flag_For_Id (+W_Expr, Etype (Expr));
         return;
      end if;

      case Nkind (Expr) is
         when N_Identifier | N_Expanded_Name                       =>
            declare
               Obj : constant Entity_Id := Entity (Expr);
            begin
               W_Expr :=
                 (if As_Old
                  then
                    Transform_Attribute_Old
                      (Expr              => Expr,
                       Domain            => Domain,
                       Params            => Params,
                       No_Validity_Check => True)
                  else
                    Transform_Identifier
                      (Params            => Params,
                       Expr              => Expr,
                       Ent               => Obj,
                       Domain            => Domain,
                       No_Validity_Check => True));
               Valid_Flag :=
                 (if not As_Old or else Params.Old_Policy = Ignore
                  then +Get_Valid_Id_From_Object (Obj, Params.Ref_Allowed)
                  else
                    New_Old
                      (Expr   =>
                         +Get_Valid_Id_From_Object (Obj, Params.Ref_Allowed),
                       Domain => Term_Domain (Domain)));

               --  If Obj has asynchronous writers, W_Expr will havoc the
               --  validity flag of Obj. Put it in the let binding to ensure it
               --  is done before the validity flag is evaluated.

               if Has_Volatile (Obj)
                 and then Has_Volatile_Property (Obj, Pragma_Async_Writers)
               then
                  declare
                     Tmp : constant W_Identifier_Id :=
                       New_Temp_Identifier (Typ => Get_Type (W_Expr));
                  begin
                     Context.Append
                       (Ref_Type'
                          (Mutable => False, Name => Tmp, Value => W_Expr));
                     W_Expr := +Tmp;
                  end;
               end if;
            end;

         when N_Function_Call                                      =>

            --  For function calls, we introduce a temporary identifier holding
            --  the result of the call.

            declare
               Fun : constant Entity_Id := Get_Called_Entity_For_Proof (Expr);
               Tmp : constant W_Identifier_Id :=
                 New_Temp_Identifier
                   (Base_Name => "valid",
                    Typ       => Validity_Wrapper_Type (Etype (Fun)));
               Def : W_Expr_Id :=
                 Transform_Function_Call
                   (Expr           => Expr,
                    Domain         => Domain,
                    Params         => Params,
                    Validity_Check => Keep_Wrapper);
            begin

               if As_Old and then Params.Old_Policy /= Ignore then
                  pragma Assert (Params.Old_Policy = Gnat2Why.Util.As_Old);
                  Def := New_Old (Expr => Def, Domain => Domain);
               end if;

               W_Expr :=
                 New_Function_Valid_Value_Access
                   (Ty => Etype (Fun), Name => +Tmp);

               Valid_Flag :=
                 +New_Function_Valid_Flag_Access
                    (Ty => Etype (Fun), Name => +Tmp);

               Context.Append
                 (Ref_Type'(Mutable => False, Name => Tmp, Value => Def));
            end;

         when N_Attribute_Reference                                =>
            declare
               Name : constant Name_Id := Attribute_Name (Expr);
            begin
               if Name = Name_Old then
                  Transform_Potentially_Invalid_Expr
                    (Expr       => Prefix (Expr),
                     Domain     => Domain,
                     Params     => Params,
                     Context    => Context,
                     Valid_Flag => Valid_Flag,
                     W_Expr     => W_Expr,
                     As_Old     => True);

               elsif Name = Name_Loop_Entry then
                  pragma Assert (not As_Old);
                  W_Expr := +Name_For_Loop_Entry (Expr);
                  Valid_Flag := +Get_Valid_Flag_For_Id (+W_Expr, Etype (Expr));

               else
                  pragma Assert (Name = Name_Result and not As_Old);

                  W_Expr :=
                    Transform_Expr
                      (Expr, Domain, Params, No_Validity_Check => True);

                  Valid_Flag :=
                    +Get_Valid_Id_For_Result (Entity (Prefix (Expr)));
               end if;
            end;

         when N_Indexed_Component | N_Selected_Component | N_Slice =>
            Transform_Potentially_Invalid_Expr
              (Expr       => Prefix (Expr),
               Domain     => Domain,
               Params     => Params,
               Context    => Context,
               Valid_Flag => Valid_Flag,
               W_Expr     => W_Expr,
               As_Old     => As_Old);

            case Nkind (Expr) is
               when N_Selected_Component =>
                  W_Expr :=
                    One_Level_Access
                      (Expr, W_Expr, Domain, Params, No_Init_Check => False);

                  declare
                     Field : constant Entity_Id :=
                       Entity (Selector_Name (Expr));
                  begin
                     Valid_Flag :=
                       New_Validity_Tree_Record_Access
                         (Name  => Valid_Flag,
                          Field => Field,
                          Ty    => Etype (Prefix (Expr)));
                  end;

               when N_Indexed_Component  =>
                  W_Expr :=
                    One_Level_Access
                      (Expr, W_Expr, Domain, Params, No_Init_Check => False);

                  declare
                     Pref    : constant Node_Id := Prefix (Expr);
                     Pref_Ty : constant Entity_Id := Retysp (Etype (Pref));
                     Dim     : constant Pos := Number_Dimensions (Pref_Ty);
                     Indices : W_Expr_Array (1 .. Positive (Dim));
                     Cursor  : Node_Id := First (Expressions (Expr));
                     Count   : Positive := 1;
                  begin
                     while Present (Cursor) loop
                        Indices (Count) :=
                          Transform_Expr
                            (Cursor,
                             Base_Why_Type_No_Bool
                               (Entity_Id'(Type_Of_Node (Cursor))),
                             Term_Domain (Domain),
                             Params);

                        Count := Count + 1;
                        Next (Cursor);
                     end loop;

                     Valid_Flag :=
                       New_Validity_Tree_Array_Access
                         (Name   => Valid_Flag,
                          Index  => Indices,
                          Ty     => Pref_Ty,
                          Domain => Domain);
                  end;

               when N_Slice              =>
                  W_Expr := Transform_Slice (Expr, W_Expr, Params, Domain);

               when others               =>
                  raise Program_Error;
            end case;

            if As_Old and then Params.Old_Policy /= Ignore then
               W_Expr := +New_Old (Expr => W_Expr, Domain => Domain);
               Valid_Flag := +New_Old (Expr => Valid_Flag, Domain => Domain);
            end if;

         when others                                               =>
            raise Program_Error;
      end case;
   end Transform_Potentially_Invalid_Expr;

   function Transform_Potentially_Invalid_Expr
     (Expr          : Node_Id;
      Expected_Type : W_Type_Id;
      Domain        : EW_Domain;
      Params        : Transformation_Params;
      Context       : in out Ref_Context;
      Valid_Flag    : out W_Expr_Id;
      No_Checks     : Boolean := False) return W_Expr_Id
   is
      Get_Flag_From_Expr : constant Boolean :=
        Is_Potentially_Invalid_Expr (Expr);
      W_Expr             : W_Expr_Id;

   begin
      --  If necessary, get the validity flag from expr

      if Get_Flag_From_Expr then
         Transform_Potentially_Invalid_Expr
           (Expr       => Expr,
            Domain     => Domain,
            Params     => Params,
            Context    => Context,
            Valid_Flag => Valid_Flag,
            W_Expr     => W_Expr);

         --  For array types, it might be necessary to slide the validity
         --  tree.

         if Has_Array_Type (Etype (Expr))
           and then
             Needs_Slide
               (Get_Ada_Node (+Get_Type (W_Expr)),
                Get_Ada_Node (+Expected_Type))
         then

            --  W_Expr is necessary to get the bounds for the sliding.
            --  Introduce a temporary.

            declare
               Tmp : constant W_Identifier_Id :=
                 New_Temp_Identifier (Typ => Get_Type (W_Expr));
            begin
               Context.Append
                 (Ref_Type'(Mutable => False, Name => Tmp, Value => W_Expr));

               W_Expr := +Tmp;
            end;

            Valid_Flag :=
              New_Validity_Tree_Slide
                (Valid_Flag, W_Expr, Expected_Type, Domain, Params);
         end if;

         W_Expr :=
           Insert_Checked_Conversion
             (Ada_Node => Expr,
              Domain   =>
                (if No_Checks and then Domain = EW_Prog
                 then EW_Pterm
                 else Domain),
              Expr     => W_Expr,
              To       => Expected_Type);

      --  Otherwise, transform the expression normally

      else
         W_Expr := Transform_Expr (Expr, Expected_Type, Domain, Params);
         Valid_Flag := +New_Valid_Value_For_Type (Etype (Expr));
      end if;

      return W_Expr;
   end Transform_Potentially_Invalid_Expr;

   ----------------------
   -- Transform_Pragma --
   ----------------------

   function Transform_Pragma
     (Prag : N_Pragma_Id; Params : Transformation_Params; Force : Boolean)
      return W_Prog_Id
   is
      Prag_Id : constant Pragma_Id := Get_Pragma_Id (Prag);

      procedure tip;
      --  A dummy procedure called when pragma Inspection_Point is processed.
      --  This is just to help debugging Why generation. If a pragma
      --  Inspection_Point is added to a source program, then breaking on
      --  tip will get you to that point in the program.

      ---------
      -- tip --
      ---------

      procedure tip is
      begin
         null;
      end tip;

      --  Start of processing for Transform_Pragma

   begin
      case Prag_Id is

         --  Ignore pragma Check for preconditions and postconditions

         when Pragma_Check                                =>
            return Transform_Pragma_Check (Prag, Params, Force);

         --  Pragma Overflow_Mode should have an effect on proof, but is
         --  currently ignored (and a corresponding warning is issued
         --  during marking).

         when Pragma_Overflow_Mode                        =>
            return +Void;

         --  Unless Force is True to force the translation of pragmas
         --  Precondition and Postcondition (for those pragmas declared in
         --  a subprogram body), these pragmas are translated elsewhere.

         when Pragma_Precondition | Pragma_Postcondition  =>
            if Force then
               declare
                  Expr          : constant Node_Id :=
                    Expression (First (Pragma_Argument_Associations (Prag)));
                  Assert_Params : Transformation_Params :=
                    (Params with delta Phase => Generate_VCs_For_Assert);
                  Result        : W_Prog_Id;

               begin
                  Result :=
                    New_Ignore (Prog => Transform_Prog (Expr, Assert_Params));
                  Assert_Params.Gen_Marker := GM_Label;
                  Append
                    (Result,
                     New_Located_Assert
                       (Ada_Node => Expr,
                        Pred     => Transform_Pred (Expr, Assert_Params),
                        Reason   => VC_Assert,
                        Kind     => EW_Assert));
                  return Result;
               end;
            else
               return +Void;
            end if;

         when Pragma_Interrupt_Priority | Pragma_Priority =>
            return Transform_Priority_Pragmas (Prag, Params);

         --  Pragma Inspection_Point is ignored, but we insert a call to a
         --  dummy procedure, to allow to break on it during debugging.

         when Pragma_Inspection_Point                     =>
            tip;
            return +Void;

         --  Do not issue a warning on invariant pragmas, as one is already
         --  issued on the corresponding type in SPARK.Definition.

         when Pragma_Invariant
            | Pragma_Type_Invariant
            | Pragma_Type_Invariant_Class                 =>
            return +Void;

         --  Remaining pragmas fall into two major groups:
         --
         --  Group 1 - ignored
         --
         --  Pragmas that do not need any proof processing, either because:
         --  . they are defined by SPARK 2014, or
         --  . they are already taken into account elsewhere (contracts)
         --  . they have no effect on verification

         --  Group 1a - RM Table 16.1, Ada language-defined pragmas marked
         --  "Yes".

         when  --  Pragma_Assert is transformed into pragma Check handled above
            Pragma_Assertion_Policy
            | Pragma_Atomic
            | Pragma_Atomic_Components
            | Pragma_Attach_Handler
            | Pragma_Convention
            | Pragma_CPU
            | Pragma_Detect_Blocking
            | Pragma_Elaborate
            | Pragma_Elaborate_All
            | Pragma_Elaborate_Body
            | Pragma_Export
            | Pragma_Import
            | Pragma_Independent
            | Pragma_Independent_Components
            | Pragma_Inline
            --  Pragma_Inspection_Point is handled specially above
            | Pragma_Interrupt_Handler
            --  Pragma_Interrupt_Priority is handled specially above
            | Pragma_Linker_Options
            | Pragma_List
            | Pragma_Locking_Policy
            | Pragma_No_Return
            | Pragma_Normalize_Scalars
            | Pragma_Optimize
            | Pragma_Pack
            | Pragma_Page
            | Pragma_Partition_Elaboration_Policy
            | Pragma_Preelaborable_Initialization
            | Pragma_Preelaborate
            --  Pragma_Priority is handled specially above
            | Pragma_Profile
            | Pragma_Pure
            | Pragma_Queuing_Policy
            | Pragma_Relative_Deadline
            | Pragma_Restrictions
            | Pragma_Reviewable
            | Pragma_Suppress
            | Pragma_Unchecked_Union
            | Pragma_Unsuppress
            | Pragma_Volatile
            | Pragma_Volatile_Components

            --  Group 1b - RM Table 16.2, SPARK language-defined pragmas marked
            --  "Yes", whose effect on proof is taken care of somewhere else.

            | Pragma_Abstract_State
            --  Pragma_Assert_And_Cut and Pragma_Assume are transformed into
            --  pragma Check handled above.
            | Pragma_Async_Readers
            | Pragma_Async_Writers
            | Pragma_Constant_After_Elaboration
            | Pragma_Contract_Cases
            | Pragma_Default_Initial_Condition
            | Pragma_Depends
            | Pragma_Effective_Reads
            | Pragma_Effective_Writes
            | Pragma_Extensions_Visible
            | Pragma_Ghost
            | Pragma_Global
            | Pragma_Initial_Condition
            | Pragma_Initializes
            --  Pragma_Loop_Invariant is transformed into pragma Check handled
            --  above.
            | Pragma_Loop_Variant
            | Pragma_No_Caching
            | Pragma_Part_Of
            | Pragma_Refined_Depends
            | Pragma_Refined_Global
            | Pragma_Refined_Post
            | Pragma_Refined_State
            | Pragma_SPARK_Mode
            | Pragma_Unevaluated_Use_Of_Old
            | Pragma_Volatile_Function

            --  Group 1c - RM Table 16.3, GNAT implementation-defined pragmas
            --  marked "Yes".

            | Pragma_Ada_83
            | Pragma_Ada_95
            | Pragma_Ada_05
            | Pragma_Ada_12
            | Pragma_Ada_2005
            | Pragma_Ada_2012
            | Pragma_Annotate
            | Pragma_Assume_No_Invalid_Values
            --  Pragma_Check is handled specially above
            | Pragma_Check_Policy
            --  Pragma_Compile_Time_Error, Pragma_Compile_Time_Warning and
            --  Pragma_Debug are removed by FE and handled thus below.
            | Pragma_Default_Scalar_Storage_Order
            | Pragma_Export_Function
            | Pragma_Export_Procedure
            | Pragma_Ignore_Pragma
            | Pragma_Inline_Always
            --  Pragma_Invariant is handled specially above
            | Pragma_Linker_Section
            | Pragma_Max_Queue_Length
            | Pragma_No_Elaboration_Code_All
            | Pragma_No_Heap_Finalization
            | Pragma_No_Inline
            | Pragma_No_Tagged_Streams
            --  Pragma_Overflow_Mode is handled specially above
            | Pragma_Post
            --  Pragma_Postcondition is handled specially above
            | Pragma_Post_Class
            | Pragma_Pre
            --  Pragma_Precondition is handled specially above
            | Pragma_Pre_Class
            | Pragma_Predicate
            | Pragma_Predicate_Failure
            | Pragma_Provide_Shift_Operators
            | Pragma_Pure_Function
            | Pragma_Restriction_Warnings
            | Pragma_Secondary_Stack_Size
            | Pragma_Style_Checks
            | Pragma_Test_Case
            --  Pragma_Type_Invariant and Pragma_Type_Invariant_Class are
            --  handled specially above.
            | Pragma_Unmodified
            | Pragma_Unreferenced
            | Pragma_Unused
            | Pragma_Validity_Checks
            | Pragma_Volatile_Full_Access
            | Pragma_Warnings
            | Pragma_Weak_External                        =>
            return +Void;

         --  Group 1d - These pragmas are re-written and/or removed by the
         --  front-end in GNATprove, so they should never be seen here,
         --  unless they are ignored by virtue of pragma Ignore_Pragma.

         when Pragma_Assert
            | Pragma_Assert_And_Cut
            | Pragma_Assume
            | Pragma_Compile_Time_Error
            | Pragma_Compile_Time_Warning
            | Pragma_Debug
            | Pragma_Loop_Invariant                       =>
            return +Void;

         --  Group 2 - Remaining pragmas, enumerated here rather than a "when
         --  others" to force re-consideration when SNames.Pragma_Id is
         --  extended.
         --
         --  These can all be ignored - we have already generated a warning
         --  during Marking. In the future, these pragmas may move to be fully
         --  ignored or to be processed with more semantic detail as required.

         --  Group 2a - GNAT Defined and obsolete pragmas

         when Pragma_Abort_Defer
            | Pragma_Allow_Integer_Address
            | Pragma_Attribute_Definition
            | Pragma_C_Pass_By_Copy
            | Pragma_Check_Float_Overflow
            | Pragma_Check_Name
            | Pragma_Comment
            | Pragma_Common_Object
            | Pragma_Complete_Representation
            | Pragma_Complex_Representation
            | Pragma_Component_Alignment
            | Pragma_Controlled
            | Pragma_Convention_Identifier
            | Pragma_CPP_Class
            | Pragma_CPP_Constructor
            | Pragma_CPP_Virtual
            | Pragma_CPP_Vtable
            | Pragma_Debug_Policy
            | Pragma_Default_Storage_Pool
            | Pragma_Disable_Atomic_Synchronization
            | Pragma_Dispatching_Domain
            | Pragma_Elaboration_Checks
            | Pragma_Eliminate
            | Pragma_Enable_Atomic_Synchronization
            | Pragma_Export_Object
            | Pragma_Export_Valued_Procedure
            | Pragma_Extend_System
            | Pragma_Extensions_Allowed
            | Pragma_External
            | Pragma_External_Name_Casing
            | Pragma_Fast_Math
            | Pragma_Favor_Top_Level
            | Pragma_Finalize_Storage_Only
            | Pragma_Ident
            | Pragma_Implementation_Defined
            | Pragma_Implemented
            | Pragma_Implicit_Packing
            | Pragma_Import_Function
            | Pragma_Import_Object
            | Pragma_Import_Procedure
            | Pragma_Import_Valued_Procedure
            | Pragma_Initialize_Scalars
            | Pragma_Inline_Generic
            | Pragma_Interface
            | Pragma_Interface_Name
            | Pragma_Interrupt_State
            | Pragma_Keep_Names
            | Pragma_License
            | Pragma_Link_With
            | Pragma_Linker_Alias
            | Pragma_Linker_Constructor
            | Pragma_Linker_Destructor
            | Pragma_Loop_Optimize
            | Pragma_Machine_Attribute
            | Pragma_Main
            | Pragma_Main_Storage
            | Pragma_Memory_Size
            | Pragma_No_Body
            | Pragma_No_Run_Time
            | Pragma_No_Strict_Aliasing
            | Pragma_Obsolescent
            | Pragma_Optimize_Alignment
            | Pragma_Ordered
            | Pragma_Overriding_Renamings
            | Pragma_Passive
            | Pragma_Persistent_BSS
            | Pragma_Prefix_Exception_Messages
            | Pragma_Priority_Specific_Dispatching
            | Pragma_Profile_Warnings
            | Pragma_Propagate_Exceptions
            | Pragma_Psect_Object
            | Pragma_Rational
            | Pragma_Ravenscar
            | Pragma_Remote_Access_Type
            | Pragma_Rename_Pragma
            | Pragma_Restricted_Run_Time
            | Pragma_Share_Generic
            | Pragma_Shared
            | Pragma_Short_Circuit_And_Or
            | Pragma_Short_Descriptors
            | Pragma_Simple_Storage_Pool_Type
            | Pragma_Source_File_Name
            | Pragma_Source_File_Name_Project
            | Pragma_Source_Reference
            | Pragma_Static_Elaboration_Desired
            | Pragma_Storage_Unit
            | Pragma_Stream_Convert
            | Pragma_Subtitle
            | Pragma_Suppress_All
            | Pragma_Suppress_Debug_Info
            | Pragma_Suppress_Exception_Locations
            | Pragma_Suppress_Initialization
            | Pragma_System_Name
            | Pragma_Task_Info
            | Pragma_Task_Name
            | Pragma_Task_Storage
            | Pragma_Thread_Local_Storage
            | Pragma_Time_Slice
            | Pragma_Title
            | Pragma_Unimplemented_Unit
            | Pragma_Universal_Aliasing
            | Pragma_Unreferenced_Objects
            | Pragma_Unreserve_All_Interrupts
            | Pragma_Use_VADS_Size
            | Pragma_Warning_As_Error
            | Pragma_Wide_Character_Encoding

            --  Group 2b - Ada RM pragmas

            | Pragma_Discard_Names
            | Pragma_Task_Dispatching_Policy
            | Pragma_All_Calls_Remote
            | Pragma_Asynchronous
            | Pragma_Remote_Call_Interface
            | Pragma_Remote_Types
            | Pragma_Shared_Passive
            | Pragma_Lock_Free
            | Pragma_Storage_Size                         =>
            return +Void;

         --  Unknown_Pragma is treated here. We use an OTHERS case in order to
         --  deal with all the more recent pragmas introduced in GNAT for which
         --  we have not yet defined how they are supported in SPARK. Do not
         --  issue a warning on unknown pragmas, as an error is issued in
         --  SPARK.Definition.

         when others                                      =>
            return +Void;
      end case;
   end Transform_Pragma;

   ----------------------------
   -- Transform_Pragma_Check --
   ----------------------------

   procedure Transform_Pragma_Check
     (Stmt    : N_Pragma_Id;
      Params  : Transformation_Params;
      Expr    : out N_Subexpr_Id;
      Runtime : out W_Prog_Id;
      Pred    : out W_Pred_Id;
      Msg     : out String_Id)
   is
      Arg1          : constant Node_Id :=
        First (Pragma_Argument_Associations (Stmt));
      Arg2          : constant Node_Id := Next (Arg1);
      Arg3          : constant Node_Id := Next (Arg2);
      Assert_Params : Transformation_Params :=
        (Params with delta Phase => Generate_VCs_For_Assert);

   begin
      Expr := Expression (Arg2);
      Msg :=
        (if Present (Arg3) then Strval (Expression (Arg3)) else No_String);

      --  Special translation for assertions with cut operations

      if Contains_Cut_Operations (Expr) then
         declare
            Cond : W_Pred_Id;
         begin
            Transform_Expr_With_Cutpoints
              (Expr, Assert_Params, Runtime, Cond, Pred);
            Runtime :=
              Sequence
                (Runtime,
                 New_Located_Assert
                   (Expr, Cond, VC_Assert_Premise, EW_Assert));
         end;
      else
         Runtime := Transform_Prog (Expr, EW_Bool_Type, Assert_Params);
         Assert_Params.Gen_Marker := GM_Toplevel;
         Pred := Transform_Pred (Expr, Assert_Params);
      end if;
   end Transform_Pragma_Check;

   function Transform_Pragma_Check
     (Prag : N_Pragma_Id; Params : Transformation_Params; Force : Boolean)
      return W_Prog_Id
   is
      Reason     : constant VC_Kind := VC_Assert;
      Expr       : Node_Id;
      Check_Expr : W_Prog_Id;
      Pred       : W_Pred_Id;
      Msg        : String_Id;
      T          : W_Statement_Sequence_Id := Void_Sequence;

   begin
      --  pre / post / predicate are not handled here, unless Force is True

      if not Force and then Is_Ignored_Pragma_Check (Prag) then
         return +Void;
      end if;

      Transform_Pragma_Check (Prag, Params, Expr, Check_Expr, Pred, Msg);

      --  Translate Compile_Time_Error as an assumption

      if Is_Pragma_Check (Prag, Name_Compile_Time_Error) then
         Append (T, New_Assume_Statement (Pred => New_Not (Right => Pred)));
         Append (T, Warn_On_Inconsistent_Assume (Prag, Params.Warn_On_Dead));

      else
         --  Get rid of simple cases True and False

         declare
            Is_CT_Known : constant Boolean := Compile_Time_Known_Value (Expr);
         begin
            if Is_CT_Known
              or else Is_False_Boolean (+Pred)
              or else Is_True_Boolean (+Pred)
            then
               declare
                  Proved : constant Boolean :=
                    (if Is_CT_Known
                     then Is_True (Expr_Value (Expr))
                     else Is_True_Boolean (+Pred));
               begin
                  if Proved then
                     Emit_Static_Proof_Result
                       (Expr, Reason, Proved, Current_Subp);
                     Append (T, +Void);

                  --  Pragma assume does not require check.
                  --  Do not emit inconsistency warning in this specific
                  --  case as a plain pragma Assume (False) is almost
                  --  certainly deliberate.
                  elsif Is_Pragma_Check (Prag, Name_Assume) then
                     Append (T, New_Assume_Statement (Pred => Pred));
                     Register_Pragma_Assume_Statement (Prag);
                  else
                     Append
                       (T,
                        New_VC_Prog
                          (Ada_Node => Prag,
                           Expr     => +New_Identifier (Name => "absurd"),
                           Reason   => Reason));
                  end if;
               end;

            --  Now handle remaining cases of "regular" pragma Check/Assert
            --  and pragma Assume. This is also how pragmas Preconditions and
            --  Postconditions inside a subprogram body are translated, i.e.
            --  as regular assertions.

            elsif Is_Pragma_Check (Prag, Name_Assume) then
               Append (T, New_Assume_Statement (Pred => Pred));
               Append
                 (T, Warn_On_Inconsistent_Assume (Prag, Params.Warn_On_Dead));
               Register_Pragma_Assume_Statement (Prag);

            --  If the assertion contains a cut operation, its premise and
            --  side-conditions will be checked as part of the runtime checks,
            --  so the predicate should be assumed.

            elsif Contains_Cut_Operations (Expr) then
               Append (T, New_Assume_Statement (Pred => Pred));
            else
               Append
                 (T,
                  New_Located_Assert
                    (Expr,
                     Pred,
                     Reason,
                     EW_Assert,
                     Check_Info => New_Check_Info (User_Message => Msg)));
            end if;
         end;
      end if;

      if Check_Expr /= Why_Empty then
         Prepend (New_Ignore (Prog => Check_Expr), T);
      end if;

      return +T;
   end Transform_Pragma_Check;

   --------------------------------
   -- Transform_Priority_Pragmas --
   --------------------------------

   function Transform_Priority_Pragmas
     (Prag : N_Pragma_Id; Params : Transformation_Params) return W_Prog_Id
   is
      Pragma_Arguments : constant List_Id :=
        Pragma_Argument_Associations (Prag);

      Expr : constant Node_Id :=
        (if Present (Pragma_Arguments)
         then Expression (First (Pragma_Arguments))
         else Empty);

   begin
      --  The Priority aspect has no effect if it is specified for a subprogram
      --  other than the main subprogram.

      if Present (Expr)
        and then
          (not Is_Subprogram (Current_Subp)
           or else Might_Be_Main (Current_Subp))
      then
         declare
            --  Task Priorities (D.1 (17)):
            --
            --  For the Priority aspect, the value of the expression is
            --  converted to the subtype Priority; for the Interrupt_Priority
            --  aspect, this value is converted to the subtype Any_Priority.
            --
            --  Protected Subprograms (D.3 (6)):
            --
            --  The expression specified for the Priority or Interrupt_Priority
            --  aspect (see D.1) is evaluated as part of the creation of the
            --  corresponding protected object and converted to the subtype
            --  System.Any_Priority or System.Interrupt_Priority, respectively.
            --
            --  We use the Current_Subp entity to know whether the priority is
            --  a task priority or a protected priority. The priority is a task
            --  priority if it applies syntactically to a task or to a
            --  subprogram.

            Is_Task_Priority : constant Boolean :=
              Ekind (Current_Subp) in Task_Kind | Subprogram_Kind;

            Prag_Id : constant Pragma_Id := Get_Pragma_Id (Prag);

            Ty : constant Entity_Id :=
              RTE
                (if Is_Task_Priority
                 then
                   (if Prag_Id = Pragma_Interrupt_Priority
                    then RE_Any_Priority
                    else RE_Priority)
                 else
                   (if Prag_Id = Pragma_Interrupt_Priority
                    then RE_Interrupt_Priority
                    else RE_Any_Priority));

            Why_Expr : constant W_Expr_Id :=
              Transform_Expr
                (Expr          => Expr,
                 Domain        => EW_Term,
                 Params        => Params,
                 Expected_Type => EW_Int_Type);

         begin
            return
              New_Located_Assert
                (Ada_Node => Expr,
                 Pred     =>
                   +New_Range_Expr
                      (Domain => EW_Pred,
                       Low    =>
                         New_Attribute_Expr
                           (Domain => EW_Term,
                            Ty     => Ty,
                            Attr   => Attribute_First,
                            Params => Params),
                       High   =>
                         New_Attribute_Expr
                           (Domain => EW_Term,
                            Ty     => Ty,
                            Attr   => Attribute_Last,
                            Params => Params),
                       Expr   => Why_Expr),
                 Reason   => VC_Range_Check,
                 Kind     => EW_Check);
         end;
      else
         return +Void;
      end if;
   end Transform_Priority_Pragmas;

   -------------------------------------
   -- Transform_Quantified_Expression --
   -------------------------------------

   function Transform_Quantified_Expression
     (Expr   : N_Quantified_Expression_Id;
      Domain : EW_Domain;
      Params : Transformation_Params) return W_Expr_Id
   is

      function Transform_Condition
        (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
         return W_Expr_Id;
      --  Transform the condition of the expression. In the program domain,
      --  wrap the result in an ignore block as we only care about runtime
      --  errors.

      -------------------------
      -- Transform_Condition --
      -------------------------

      function Transform_Condition
        (Expr : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
         return W_Expr_Id
      is
         Result : constant W_Expr_Id := Transform_Expr (Expr, Domain, Params);

      begin
         --  Possibly warn on an unreachable quantified expression

         if Domain = EW_Prog then
            return
              +Warn_On_Dead_Branch
                 (Expr,
                  New_Ignore (Prog => +Result),
                  Params.Phase,
                  Params.Warn_On_Dead);
         else
            return Result;
         end if;
      end Transform_Condition;

      function Transform_Quantifier is new
        Generate_Quantified_Expression (Transform_Condition);

      Result : W_Expr_Id := Transform_Quantifier (Expr, Domain, Params);

   begin
      --  In the program domain, we use an any expr to generate a value wich
      --  is equal to the quantified formula in the predicate domain:
      --    Ignore (Checks); any bool {result = Expr}

      if Domain = EW_Prog then
         declare
            W_Expr_Pred : constant W_Expr_Id :=
              Transform_Quantifier (Expr, EW_Pred, Params);
            W_Equiv     : constant W_Expr_Id :=
              New_Connection
                (Domain => EW_Pred,
                 Left   =>
                   New_Call
                     (Domain => EW_Pred,
                      Name   => Why_Eq,
                      Typ    => EW_Bool_Type,
                      Args   =>
                        (+New_Result_Ident (EW_Bool_Type), +True_Term)),
                 Op     => EW_Equivalent,
                 Right  => W_Expr_Pred);
            W_Assume    : constant W_Prog_Id :=
              New_Any_Statement
                (Ada_Node    => Expr,
                 Return_Type => EW_Bool_Type,
                 Post        => +W_Equiv);
         begin
            Result := +Sequence (+Result, W_Assume);
         end;
      end if;

      return Result;
   end Transform_Quantified_Expression;

   ---------------------------------------------
   -- Transform_Record_Component_Associations --
   ---------------------------------------------

   function Transform_Record_Component_Associations
     (Domain             : EW_Domain;
      Typ                : Type_Kind_Id;
      Assocs             : List_Id;
      Params             : Transformation_Params;
      In_Delta_Aggregate : Boolean := False;
      In_Extension       : Boolean := False;
      Relaxed_Init       : Boolean;
      Discr_Ids          : out W_Identifier_Array;
      Discr_Vals         : out W_Expr_Array;
      Missing_Fields     : out Component_Sets.Set)
      return W_Field_Association_Array
   is
      function Components_Count (Assocs : List_Id) return Natural;
      --  Returns the number of component selectors in Assocs

      ----------------------
      -- Components_Count --
      ----------------------

      function Components_Count (Assocs : List_Id) return Natural is
         CL                    : List_Id;
         Association           : Node_Id := Nlists.First (Assocs);
         Associated_Components : Natural := 0;
      begin
         while Present (Association) loop
            if not Inherited_Discriminant (Association) then
               CL := Choice_List (Association);
               Associated_Components :=
                 Associated_Components + Integer (List_Length (CL));
            end if;
            Next (Association);
         end loop;
         return Associated_Components;
      end Components_Count;

      Component   : Entity_Id;
      Association : Node_Id;
      Field_Assoc : W_Field_Association_Array (1 .. Components_Count (Assocs));
      Num_Discr   : constant Natural := Count_Discriminants (Typ);
      Discr_Assoc : W_Field_Association_Array (1 .. Num_Discr);
      Field_Index : Positive := 1;
      Discr_Index : Positive := 1;
      CL          : List_Id;
      Choice      : Node_Id;

      --  Start of processing for Transform_Record_Component_Associations

   begin
      Association := Nlists.First (Assocs);

      if No (Association) then
         return (1 .. 0 => <>);
      end if;

      Ada_Ent_To_Why.Push_Scope (Symbol_Table);

      --  Start with the first component
      CL := Choice_List (Association);
      --  normal, fully defined aggregate, has singleton choice lists
      pragma Assert (In_Delta_Aggregate or else List_Length (CL) = 1);
      Choice := First (CL);

      Missing_Fields := Get_Component_Set (Typ);

      --  Loop over the associations and component choice lists
      while Present (Choice) loop
         declare
            Expr : W_Expr_Id;
         begin
            --  We don't expect "others" for delta aggregates (illegal). For
            --  normal aggregates occurances of "others" have been removed from
            --  the AST wich will have an association list is as long as the
            --  number of components, and with only singleton choice lists.

            pragma Assert (Nkind (Choice) /= N_Others_Choice);

            --  Inherited discriminants in an extension aggregate are already
            --  accounted for in the ancestor part. Ignore them here.

            if not Inherited_Discriminant (Association) then

               --  Use Entity link to get the corresponding record component

               pragma Assert (Present (Entity (Choice)));

               Component := Search_Component_In_Type (Typ, Entity (Choice));
               pragma Assert (Present (Component));

               declare
                  Comp_Ty      : constant Entity_Id := Etype (Component);
                  Comp_Relaxed : constant Boolean :=
                    (if Relaxed_Init
                     then Has_Init_Wrapper (Comp_Ty)
                     else Has_Relaxed_Init (Comp_Ty))
                    and then Ekind (Component) = E_Component;
                  W_Comp_Ty    : constant W_Type_Id :=
                    EW_Abstract (Comp_Ty, Comp_Relaxed);

               begin
                  --  For a regular association, use the provided value

                  if not Box_Present (Association) then
                     Expr :=
                       Transform_Expr
                         (Expr          => Expression (Association),
                          Expected_Type => W_Comp_Ty,
                          Domain        => Domain,
                          Params        => Params);

                  --  We have a box. If component has a default value in the
                  --  record declaration, the frontend has expended it.

                  elsif Present
                          (Expression (Enclosing_Declaration (Component)))
                  then
                     raise Program_Error;

                  --  Otherwise, compute the default value of the type

                  else
                     Expr :=
                       Compute_Default_Value
                         (Association, Comp_Ty, Comp_Relaxed, Domain, Params);
                  end if;
               end;

               --  Attributes of component's type have default values of their
               --  type.

               if Has_Record_Type (Etype (Component))
                 or else Full_View_Not_In_SPARK (Etype (Component))
               then
                  Expr :=
                    New_Tag_And_Ext_Update
                      (Domain => Domain,
                       Name   => Expr,
                       Ty     => Etype (Component));
               end if;

               if Ekind (Component) = E_Discriminant then

                  --  In record extensions, the discriminants are in the
                  --  ancestor part.

                  if not In_Extension then

                     --  To translate the default values of the fields, we
                     --  might need the entities of discriminants. Introduce an
                     --  identifier for each discriminant and store it in the
                     --  Symbol_Table.

                     Discr_Ids (Discr_Index) :=
                       New_Temp_Identifier
                         (Ada_Node  => Component,
                          Base_Name => Short_Name (Component),
                          Typ       => EW_Abstract (Etype (Component)));

                     Insert_Tmp_Item_For_Entity
                       (Component, Discr_Ids (Discr_Index));

                     Discr_Vals (Discr_Index) := Expr;
                     Discr_Assoc (Discr_Index) :=
                       New_Field_Association
                         (Domain => Domain,
                          Field  =>
                            To_Why_Id (Component, Rec => Root_Retysp (Typ)),
                          Value  => +Discr_Ids (Discr_Index));
                     Discr_Index := Discr_Index + 1;
                  end if;
               else
                  Missing_Fields.Delete (Component);
                  Field_Assoc (Field_Index) :=
                    New_Field_Association
                      (Domain => Domain,
                       Field  =>
                         To_Why_Id
                           (Component,
                            Rec          => Typ,
                            Relaxed_Init => Relaxed_Init),
                       Value  => Expr);
                  Field_Index := Field_Index + 1;
               end if;
            end if;

            --  Getting the next component from the associations' component
            --  lists, which may require selecting the next choice (for
            --  delta aggregates), or selecting the next component association.

            Next (Choice);
            if No (Choice) then
               Next (Association);
               if Present (Association) then
                  CL := Choice_List (Association);
                  pragma
                    Assert (In_Delta_Aggregate or else List_Length (CL) = 1);
                  Choice := First (CL);
               end if;
            end if;
         end;
      end loop;
      Ada_Ent_To_Why.Pop_Scope (Symbol_Table);

      pragma Assert (No (Association));
      pragma
        Assert
          (if In_Delta_Aggregate or In_Extension
           then Field_Index <= Components_Count (Assocs) + 1
           else Discr_Index = Discr_Assoc'Last + 1);
      return
        Discr_Assoc (1 .. Discr_Index - 1)
        & Field_Assoc (1 .. Field_Index - 1);
   end Transform_Record_Component_Associations;

   -------------------------------
   -- Transform_Record_Equality --
   -------------------------------

   function Transform_Record_Equality
     (Expr   : Node_Id;
      Left   : Node_Id;
      Right  : Node_Id;
      Domain : EW_Domain;
      Params : Transformation_Params) return W_Expr_Id
   is
      Op        : constant Node_Kind :=
        (if Nkind (Expr) = N_Function_Call then N_Op_Eq else Nkind (Expr));
      Subdomain : constant EW_Domain :=
        (if Domain = EW_Pred then EW_Term else Domain);

      Left_Type  : constant Type_Kind_Id := Etype (Left);
      BT         : constant W_Type_Id :=
        Base_Why_Type (Left_Type, Etype (Right));
      Left_Expr  : W_Expr_Id := Transform_Expr (Left, BT, Subdomain, Params);
      Right_Expr : W_Expr_Id := Transform_Expr (Right, BT, Subdomain, Params);

      T : W_Expr_Id;

   begin
      pragma Assert (Root_Retysp (Left_Type) = Root_Retysp (Etype (Right)));
      pragma
        Assert (Root_Retysp (Left_Type) = Root_Retysp (Get_Ada_Node (+BT)));

      --  Check the specific rules for builtin equality on
      --  unchecked union types.

      if Domain = EW_Prog then
         Check_UU_Restrictions (Expr);
      end if;

      --  Check that operands are initialized. Even if initialization
      --  checks are introduced for the conversion to BT, we still
      --  need to insert these checks here to ensure initialization of
      --  nested components with relaxed initialization if any.

      Left_Expr :=
        Insert_Initialization_Check
          (Left,
           Get_Ada_Node (+BT),
           Left_Expr,
           Domain,
           Exclude_Components => For_Eq);
      Right_Expr :=
        Insert_Initialization_Check
          (Right,
           Get_Ada_Node (+BT),
           Right_Expr,
           Domain,
           Exclude_Components => For_Eq);

      --  Potentially check invariants if subcomponents of BT have a
      --  user-defined equality.

      Left_Expr :=
        Insert_Invariant_Check_For_Eq
          (Left, Get_Ada_Node (+BT), Left_Expr, Domain);
      Right_Expr :=
        Insert_Invariant_Check_For_Eq
          (Right, Get_Ada_Node (+BT), Right_Expr, Domain);

      --  Introduce checks for the subcomponents of operands

      if Is_Class_Wide_Type (Left_Type)
        or else Call_Simulates_Contract_Dispatch (Expr)
      then
         pragma Assert (Op = N_Op_Eq);
         T :=
           New_Ada_Dispatching_Equality
             (Typ    => Left_Type,
              Domain => Domain,
              Left   => Left_Expr,
              Right  => Right_Expr);
      else
         T :=
           New_Call
             (Ada_Node => Expr,
              Domain   => Subdomain,
              Name     => E_Symb (Get_Ada_Node (+BT), WNE_Bool_Eq),
              Args     => (1 => Left_Expr, 2 => Right_Expr),
              Typ      => EW_Bool_Type);
      end if;

      if Domain = EW_Pred then
         T :=
           New_Comparison
             (Symbol => Transform_Compare_Op (Op, EW_Bool_Type, Domain),
              Left   => T,
              Right  => New_Literal (Domain => Subdomain, Value => EW_True),
              Domain => Domain);

      elsif Op = N_Op_Ne then
         pragma
           Annotate (Xcov, Exempt_On, "A /= B is expanded into not (A = B)");
         T :=
           New_Call
             (Domain => Domain,
              Name   => M_Boolean.Notb,
              Args   => (1 => T),
              Typ    => EW_Bool_Type);
         pragma Annotate (Xcov, Exempt_Off);
      end if;

      return T;
   end Transform_Record_Equality;

   ------------------------------------
   -- Transform_Shift_Or_Rotate_Call --
   ------------------------------------

   function Transform_Shift_Or_Rotate_Call
     (Expr   : N_Function_Call_Id;
      Oper   : N_Op_Shift;
      Domain : EW_Domain;
      Params : Transformation_Params) return W_Expr_Id
   is
      Subp      : constant Entity_Id := Entity (SPARK_Atree.Name (Expr));
      Context   : Ref_Context;
      Store     : W_Statement_Sequence_Id := Void_Sequence;
      Exc_Store : W_Statement_Sequence_Id := Void_Sequence;

      Args : constant W_Expr_Array :=
        Compute_Call_Args
          (Call      => Expr,
           Domain    => Domain,
           Context   => Context,
           Store     => Store,
           Exc_Store => Exc_Store,
           Params    => Params);
      pragma Assert (Args'Length = 2);
      pragma Assert (Context.Is_Empty);

      T : W_Expr_Id;

   begin
      --  ??? it is assumed that rotate calls are only valid on actual
      --  unsigned_8/16/32/64/128 types with the corresponding 'Size

      if Has_Modular_Integer_Type (Etype (Expr)) then
         declare
            Modulus_Val : constant Uint := Modulus (Etype (Subp));
            Nb_Of_Bits  : constant Pos :=
              (if Modulus_Val = UI_Expon (2, 8)
               then 8
               elsif Modulus_Val = UI_Expon (2, 16)
               then 16
               elsif Modulus_Val = UI_Expon (2, 32)
               then 32
               elsif Modulus_Val = UI_Expon (2, 64)
               then 64
               elsif Modulus_Val = UI_Expon (2, 128)
               then 128
               else raise Program_Error);
            Typ         : constant W_Type_Id :=
              (if Nb_Of_Bits = 8
               then EW_BitVector_8_Type
               elsif Nb_Of_Bits = 16
               then EW_BitVector_16_Type
               elsif Nb_Of_Bits = 32
               then EW_BitVector_32_Type
               elsif Nb_Of_Bits = 64
               then EW_BitVector_64_Type
               elsif Nb_Of_Bits = 128
               then EW_BitVector_128_Type
               else raise Program_Error);

            Arg1   : constant W_Expr_Id := Args (Args'First);
            Arg2   : constant W_Expr_Id := Args (Args'First + 1);
            Arg2_M : constant W_Expr_Id :=
              Insert_Simple_Conversion
                (Domain => EW_Term, Expr => Arg2, To => Typ);
            Name   : constant W_Identifier_Id :=
              (case Oper is
                 when N_Op_Shift_Right            => MF_BVs (Typ).Lsr,
                 when N_Op_Shift_Right_Arithmetic => MF_BVs (Typ).Asr,
                 when N_Op_Shift_Left             => MF_BVs (Typ).Lsl,
                 when N_Op_Rotate_Left            => MF_BVs (Typ).Rotate_Left,
                 when N_Op_Rotate_Right           =>
                   MF_BVs (Typ).Rotate_Right);
         begin
            --  A special care need to be put in the case of shifts on a
            --  bitvector of size smaller than 32. Indeed, in this case
            --  the amount of the shift can be greater than 2**(Size of the
            --  underlying bv), resulting in a modulo on the amount of the
            --  shift Introduced by the conversion at the why3 level.

            if Nb_Of_Bits < 32
              and then Name /= MF_BVs (Typ).Rotate_Left
              and then Name /= MF_BVs (Typ).Rotate_Right
            then
               declare
                  Nb_Of_Buits_UI : constant Uint := UI_From_Int (Nb_Of_Bits);
               begin
                  T :=
                    New_Conditional
                      (Ada_Node  => Expr,
                       Domain    => EW_Term,
                       Condition =>
                         New_Call
                           (Domain => Domain,
                            Name   => Int_Infix_Lt,
                            Args   =>
                              (1 => Arg2,
                               2 =>
                                 New_Integer_Constant
                                   (Value => Nb_Of_Buits_UI)),
                            Typ    => EW_Bool_Type),
                       Then_Part =>
                         New_Call
                           (Domain => EW_Term,
                            Name   => Name,
                            Args   => (1 => Arg1, 2 => Arg2_M),
                            Typ    => Typ),
                       Else_Part =>
                         New_Modular_Constant (Value => Uint_0, Typ => Typ),
                       Typ       => Typ);
               end;
            else
               T :=
                 New_Call
                   (Domain => EW_Term,
                    Name   => Name,
                    Args   => (1 => Arg1, 2 => Arg2_M),
                    Typ    => Typ);
            end if;
         end;

      else
         declare
            Arg1 : constant W_Expr_Id :=
              Insert_Simple_Conversion
                (Domain => EW_Term,
                 Expr   => Args (Args'First),
                 To     => EW_Int_Type);
            Arg2 : constant W_Expr_Id :=
              Insert_Simple_Conversion
                (Domain => EW_Term,
                 Expr   => Args (Args'First + 1),
                 To     => EW_Int_Type);
            --  Size in bits of the machine type
            Size : constant W_Expr_Id :=
              New_Integer_Constant (Value => Object_Size (Etype (Subp)));
            Name : constant W_Identifier_Id :=
              (case Oper is
                 when N_Op_Shift_Right            => M_Int_Shift.Shift_Right,
                 when N_Op_Shift_Right_Arithmetic =>
                   M_Int_Shift.Shift_Right_Arithmetic,
                 when N_Op_Shift_Left             => M_Int_Shift.Shift_Left,
                 when N_Op_Rotate_Left            => M_Int_Shift.Rotate_Left,
                 when N_Op_Rotate_Right           => M_Int_Shift.Rotate_Right);
         begin
            T :=
              New_Call
                (Domain => EW_Term,
                 Name   => Name,
                 Args   => (1 => Arg1, 2 => Arg2, 3 => Size),
                 Typ    => EW_Int_Type);
         end;
      end if;

      return T;
   end Transform_Shift_Or_Rotate_Call;

   ----------------------------------------
   -- Transform_Simple_Return_Expression --
   ----------------------------------------

   function Transform_Simple_Return_Expression
     (Expr        : N_Subexpr_Id;
      Subp        : Entity_Id;
      Return_Type : W_Type_Id;
      Params      : Transformation_Params) return W_Prog_Id
   is

      Result_Stmt : W_Prog_Id;

      --  Flag and context to handle potentially invalid results

      Result_Valid_Flag : W_Expr_Id := Why_Empty;
      Context           : Ref_Context;

      Dummy : Boolean;
   begin
      if Is_Potentially_Invalid (Subp) then
         Result_Stmt :=
           +Transform_Potentially_Invalid_Expr
              (Expr          => Expr,
               Expected_Type => Return_Type,
               Domain        => EW_Prog,
               Params        => Body_Params,
               Context       => Context,
               Valid_Flag    => Result_Valid_Flag);
      else
         Result_Stmt := Transform_Prog (Expr, Return_Type, Params);
      end if;

      --  Returned objects have exactly the expected tag

      if Is_Tagged_Type (Retysp (Etype (Subp))) then
         Result_Stmt :=
           New_Tag_And_Ext_Update
             (Ada_Node => Expr, Name => Result_Stmt, Ty => Etype (Subp));
      end if;

      Insert_Move_Of_Deep_Parts
        (Rhs     => Expr,
         Lhs_Typ => Etype (Subp),
         Expr    => Result_Stmt,
         Do_Move => Dummy);

      Result_Stmt :=
        New_Assignment
          (Ada_Node => Expr,
           Name     => Result_Name,
           Labels   => Symbol_Sets.Empty_Set,
           Value    => Result_Stmt,
           Typ      => Type_Of_Node (Subp));

      --  Also assign the validity tag of the result if any

      if Is_Potentially_Invalid (Subp) then
         Result_Stmt :=
           Sequence
             (Result_Stmt,
              New_Assignment
                (Ada_Node => Expr,
                 Name     => Get_Valid_Flag_For_Id (Result_Name, Etype (Subp)),
                 Labels   => Symbol_Sets.Empty_Set,
                 Value    => +Result_Valid_Flag,
                 Typ      => Get_Validity_Tree_Type (Etype (Subp))));

         Result_Stmt :=
           +Bindings_For_Ref_Context
              (Expr => +Result_Stmt, Context => Context, Domain => EW_Prog);
      end if;

      --  On return of traversal functions, perform dynamic accessibility
      --  checks. We approximate them in a static way.

      if Is_Traversal_Function (Subp) and then Nkind (Expr) /= N_Null then
         Emit_Dynamic_Accessibility_Check
           (Returned_Expr => Expr, Subp => Subp);
      end if;

      --  Update the value at end of the result

      if Is_Borrowing_Traversal_Function (Subp) then

         --  If the result is null, then the borrowed object cannot be modified

         if Nkind (Expr) = N_Null then
            declare
               Borrowed : constant Entity_Id := First_Formal (Subp);
            begin
               Append
                 (Result_Stmt,
                  New_Assume_Statement
                    (Pred =>
                       New_Comparison
                         (Symbol => Why_Eq,
                          Left   => +To_Local (Get_Borrowed_At_End (Subp)),
                          Right  =>
                            +Transform_Identifier
                               (Params => Params,
                                Expr   => Borrowed,
                                Ent    => Borrowed,
                                Domain => EW_Term))));
            end;

         --  Otherwise, compute the value at end from the assignment. This
         --  assumes the dynamic invariant of the value of the borrowed object
         --  at the end of the borrow, so it should be done after all checks at
         --  performed for the assignment so that we do not create an
         --  inconsistency.

         else
            Append
              (Result_Stmt,
               New_Update_For_Borrow_At_End (Brower => Subp, Path => Expr));
         end if;
      end if;
      return Result_Stmt;
   end Transform_Simple_Return_Expression;

   ---------------------
   -- Transform_Slice --
   ---------------------

   function Transform_Slice
     (N      : Node_Id;
      Expr   : W_Expr_Id;
      Params : Transformation_Params;
      Domain : EW_Domain) return W_Expr_Id
   is
      Target_Ty : constant W_Type_Id :=
        EW_Abstract
          (Etype (N),
           Relaxed_Init => Expr_Has_Relaxed_Init (N, No_Eval => False));
      Rng       : constant Node_Id := Get_Range (Discrete_Range (N));
      Pref_Term : constant W_Expr_Id :=
        New_Temp_For_Expr (Expr, Need_Temp => Domain = EW_Prog);
      T         : W_Expr_Id;
      Rng_Type  : constant W_Type_Id :=
        Base_Why_Type_No_Bool (Entity_Id'(Type_Of_Node (Low_Bound (Rng))));
      Low_Expr  : constant W_Term_Id :=
        New_Temp_For_Expr
          (Transform_Expr (Low_Bound (Rng), Rng_Type, Domain, Params));
      High_Expr : constant W_Term_Id :=
        New_Temp_For_Expr
          (Transform_Expr (High_Bound (Rng), Rng_Type, Domain, Params));

   begin
      T := Pref_Term;

      --  if needed, we convert the arrray to a simple base type

      if not Is_Static_Array_Type (Get_Ada_Node (+Get_Type (+Pref_Term))) then
         T := Array_Convert_To_Base (Domain, T);
      end if;

      --  Call the slice function

      T :=
        New_Slice_Call
          (Domain => Domain,
           Arr    => T,
           Typ    => Get_Type (+Pref_Term),
           Low    => +Low_Expr,
           High   => +High_Expr);

      --  If needed, we insert a check that the slice bounds are in the bounds
      --  of the prefix

      if Domain = EW_Prog then
         declare
            Ar_Low  : constant W_Term_Id :=
              Insert_Simple_Conversion
                (To   => Rng_Type,
                 Expr =>
                   Get_Array_Attr
                     (Expr => +Pref_Term, Attr => Attribute_First, Dim => 1));
            Ar_High : constant W_Term_Id :=
              Insert_Simple_Conversion
                (To   => Rng_Type,
                 Expr =>
                   Get_Array_Attr
                     (Expr => +Pref_Term, Attr => Attribute_Last, Dim => 1));
            Check   : constant W_Pred_Id :=
              New_Connection
                (Op    => EW_Imply,
                 Left  =>
                   New_Call
                     (Name =>
                        (if Rng_Type = EW_Int_Type
                         then Int_Infix_Le
                         else MF_BVs (Rng_Type).Ule),
                      Typ  => EW_Bool_Type,
                      Args => [+Low_Expr, +High_Expr]),
                 Right =>
                   New_And_Pred
                     (Left  =>
                        New_Range_Expr
                          (Low => Ar_Low, High => Ar_High, Expr => Low_Expr),
                      Right =>
                        New_Range_Expr
                          (Low  => Ar_Low,
                           High => Ar_High,
                           Expr => High_Expr)));
         begin
            Prepend
              (New_Located_Assert (N, Check, VC_Range_Check, EW_Assert), T);
         end;
      end if;

      if Is_Static_Array_Type (Etype (N)) then

         --  Fix the type of the Why3 AST

         T :=
           New_Label
             (Labels => Symbol_Sets.Empty_Set,
              Def    => T,
              Domain => Domain,
              Typ    => Target_Ty);

      --  When the slice bounds are not static, we produce a compound object
      --  contents + bounds.

      else
         T :=
           Array_Convert_From_Base
             (Domain => Domain,
              Ar     => T,
              Ty     => Get_Ada_Node (+Target_Ty),
              First  => +Low_Expr,
              Last   => +High_Expr);
      end if;

      T :=
        Binding_For_Temp (Domain => Domain, Tmp => +Pref_Term, Context => T);
      T := Binding_For_Temp (Domain => Domain, Tmp => +Low_Expr, Context => T);
      T :=
        Binding_For_Temp (Domain => Domain, Tmp => +High_Expr, Context => T);

      if Domain = EW_Prog
        and then Nkind (Discrete_Range (N)) = N_Subtype_Indication
      then
         Prepend
           (Check_Scalar_Range
              (Params => Params,
               N      => Rng,
               Base   => Entity (Subtype_Mark (Discrete_Range (N)))),
            T);
      end if;

      return T;
   end Transform_Slice;

   ----------------------------------------
   -- Transform_Statement_Or_Declaration --
   ----------------------------------------

   function Transform_Statement_Or_Declaration
     (Stmt_Or_Decl        : Node_Id;
      Params              : Transformation_Params;
      Assert_And_Cut_Prag : out Opt_N_Pragma_Id;
      Assert_And_Cut_Expr : out Opt_N_Subexpr_Id;
      Assert_And_Cut      : out W_Pred_Id) return W_Prog_Id is
   begin
      --  Make sure that outputs are initialized

      Assert_And_Cut_Prag := Empty;
      Assert_And_Cut_Expr := Empty;
      Assert_And_Cut := Why_Empty;

      --  Set error node so that bugbox information will be correct

      Current_Error_Node := Stmt_Or_Decl;

      case Nkind (Stmt_Or_Decl) is
         when N_Ignored_In_SPARK                                  =>
            return +Void;

         --  Create an identifier for the target name and call
         --  Transform_Assignment_Statement.

         when N_Assignment_Statement                              =>
            declare
               Lvalue : constant Entity_Id := Name (Stmt_Or_Decl);
               W_Ty   : constant W_Type_Id := Type_Of_Node (Lvalue);
               T      : W_Prog_Id;

            begin
               --  Sanity checking, the global state should be clean

               pragma Assert (Target_Name = Why_Empty);

               --  Create an identifier for references to the target name in
               --  the assigned expression.

               Target_Name :=
                 New_Temp_Identifier (Typ => W_Ty, Base_Name => "target");

               T := Transform_Assignment_Statement (Stmt_Or_Decl, Params);

               --  Only introduce a binding for Target_Name if it was actually
               --  used in the assignment.

               if Has_Target_Names (Stmt_Or_Decl) then
                  T :=
                    New_Binding
                      (Ada_Node => Stmt_Or_Decl,
                       Name     => Target_Name,
                       Def      =>
                         Transform_Prog
                           (Expr          => Lvalue,
                            Expected_Type => W_Ty,
                            Params        => Params),
                       Context  => T,
                       Typ      => W_Ty);
               end if;

               --  Clean up global state

               Target_Name := Why_Empty;

               return T;
            end;

         --  Translate a return statement by raising the predefined exception
         --  for returns, which is caught at the end of the subprogram. For
         --  functions, store the value returned in the local special variable
         --  for returned values, prior to raising the exception.

         when N_Simple_Return_Statement                           =>
            declare
               Raise_Stmt  : W_Prog_Id :=
                 New_Raise
                   (Ada_Node => Stmt_Or_Decl,
                    Name     => M_Main.Return_Exc,
                    Typ      => EW_Unit_Type);
               Result_Stmt : W_Prog_Id;

            begin
               --  Havoc borrowed objects and check for resource leaks on
               --  scopes traversed by the return statement.

               Prepend
                 (Finalization_Actions_On_Jump (Stmt_Or_Decl, Params),
                  Raise_Stmt);

               if Expression (Stmt_Or_Decl) /= Empty then
                  declare
                     Subp        : constant Entity_Id :=
                       Return_Applies_To
                         (Return_Statement_Entity (Stmt_Or_Decl));
                     Return_Type : constant W_Type_Id := Type_Of_Node (Subp);
                  begin
                     Result_Stmt :=
                       Transform_Simple_Return_Expression
                         (Expression (Stmt_Or_Decl),
                          Subp,
                          Return_Type,
                          Params);
                     return Sequence (Result_Stmt, Raise_Stmt);
                  end;
               else
                  return Raise_Stmt;
               end if;
            end;

         when N_Extended_Return_Statement                         =>
            declare
               Raise_Stmt : constant W_Prog_Id :=
                 New_Raise
                   (Ada_Node => Stmt_Or_Decl, Name => M_Main.Return_Exc);
               Expr       : W_Prog_Id :=
                 Transform_Statements_And_Declarations
                   (Return_Object_Declarations (Stmt_Or_Decl), Params);
               Ret_Obj    : constant Entity_Id :=
                 Get_Return_Object (Stmt_Or_Decl);
               Subp       : constant Entity_Id :=
                 Return_Applies_To (Return_Statement_Entity (Stmt_Or_Decl));
               Ret_Type   : constant W_Type_Id := Type_Of_Node (Subp);

               --  Based on Ada RM 6.5, the type of the return object and the
               --  result type of the function must be statically compatible,
               --  so no check should be needed.

               Obj_Deref : constant W_Prog_Id :=
                 +Insert_Simple_Conversion
                    (Domain => EW_Prog,
                     Expr   =>
                       Transform_Identifier
                         (Params            => Params,
                          Expr              => Ret_Obj,
                          Ent               => Ret_Obj,
                          Domain            => EW_Prog,
                          No_Validity_Check => Is_Potentially_Invalid (Subp)),
                     To     => Ret_Type);
               --  No need to introduce validity checks on Ret_Obj if an
               --  invalid object is expected.

               Result_Assign : W_Prog_Id :=
                 New_Assignment
                   (Name   => Result_Name,
                    Value  => Obj_Deref,
                    Labels => Symbol_Sets.Empty_Set,
                    Typ    => Ret_Type);
               --  Assign the result name

            begin
               if Present (Handled_Statement_Sequence (Stmt_Or_Decl)) then
                  Append
                    (Expr,
                     Transform_Handled_Statements
                       (Handled_Statement_Sequence (Stmt_Or_Decl), Params));
               end if;

               --  Set the validity flag of the result if any

               if Is_Potentially_Invalid (Subp) then
                  declare
                     Ret_Valid_Flag : constant W_Prog_Id :=
                       (if Object_Has_Valid_Id (Ret_Obj)
                        then
                          +Get_Valid_Id_From_Object
                             (Ret_Obj, Params.Ref_Allowed)
                        else +New_Valid_Value_For_Type (Etype (Subp)));

                  begin
                     --  No need to introduce sliding, the type of the return
                     --  object should be statically compatible with the return
                     --  type of the function.

                     Result_Assign :=
                       Sequence
                         (Result_Assign,
                          New_Assignment
                            (Name   =>
                               Get_Valid_Flag_For_Id
                                 (Result_Name, Etype (Subp)),
                             Value  => Ret_Valid_Flag,
                             Labels => Symbol_Sets.Empty_Set,
                             Typ    => Get_Validity_Tree_Type (Etype (Subp))));
                  end;
               end if;

               --  Wrap the sequence of statements inside a try block, in case
               --  it contains a return statement.

               return
                 New_Try_Block
                   (Prog    => Sequence (Expr, Raise_Stmt),
                    Handler =>
                      (1 =>
                         New_Handler
                           (Name => M_Main.Return_Exc,
                            Def  =>
                              Sequence
                                ((1 => Result_Assign,

                                  --  Havoc the local borrowers and check for
                                  --  memory leaks for objects declared in
                                  --  blocks traversed by the return statement.

                                  2 =>
                                    Finalization_Actions_On_Jump
                                      (Stmt_Or_Decl, Params),

                                  --  Reraise the exception

                                  3 => Raise_Stmt)))));
            end;

         when N_Goto_Statement                                    =>
            declare
               Raise_Stmt : constant W_Prog_Id :=
                 New_Raise
                   (Ada_Node => Stmt_Or_Decl,
                    Name     =>
                      Goto_Exception_Name (Entity (Name (Stmt_Or_Decl))),
                    Typ      => EW_Unit_Type);

            begin
               --  Havoc borrowed objects and check for resource leaks on
               --  scopes traversed by the goto statement.

               return
                 Sequence
                   (Finalization_Actions_On_Jump (Stmt_Or_Decl, Params),
                    Raise_Stmt);
            end;

         when N_Procedure_Call_Statement | N_Entry_Call_Statement =>
            return Transform_Call_With_Side_Effects (Params, Stmt_Or_Decl);

         when N_If_Statement                                      =>
            declare
               Cond        : constant Node_Id := Condition (Stmt_Or_Decl);
               Then_Part   : constant List_Id :=
                 Then_Statements (Stmt_Or_Decl);
               Then_Stmt   : W_Prog_Id;
               Num_Elsif   : constant Natural :=
                 Natural (List_Length (Elsif_Parts (Stmt_Or_Decl)));
               Elsif_Stmts : W_Prog_Array (1 .. Num_Elsif);
               Elsif_Conds : W_Prog_Array (1 .. Num_Elsif);
               Else_Part   : constant List_Id :=
                 Else_Statements (Stmt_Or_Decl);
               Else_Stmt   : W_Prog_Id;

               Do_Warn : Boolean := Params.Warn_On_Dead;
               --  Whether we should warn on dead branches. This may be set to
               --  False if we encounter a statically disabled branch.

               Warn_Then : constant Boolean :=
                 Do_Warn
                 and then
                   not Exp_Util.Is_Statically_Disabled
                         (Cond, False, Include_Valid => True);

            begin
               --  Possibly warn on dead code

               Then_Stmt :=
                 Transform_Statements_And_Declarations
                   (Then_Part, (Params with delta Warn_On_Dead => Warn_Then));

               Then_Stmt :=
                 +Warn_On_Dead_Code
                    (First (Then_Part), +Then_Stmt, Params.Phase, Warn_Then);

               Do_Warn :=
                 Do_Warn
                 and then
                   not Exp_Util.Is_Statically_Disabled
                         (Cond, True, Include_Valid => True);

               --  The elsif parts need to be traversed in order to propagate
               --  the Do_Warn flag. Compute the conditions and statements
               --  and store then in Elsif_Conds and Elsif_Stmts so the
               --  conditional can be reconstructed afterward.

               if Present (Elsif_Parts (Stmt_Or_Decl)) then
                  declare
                     Cur       : Node_Id := First (Elsif_Parts (Stmt_Or_Decl));
                     Cond      : Node_Id;
                     Warn_Then : Boolean;

                  begin

                     for I in Elsif_Conds'Range loop
                        Cond := Condition (Cur);
                        Elsif_Conds (I) :=
                          New_Counterexample_Assign
                            (Cur,
                             +Transform_Expr_With_Actions
                                (Cond,
                                 Condition_Actions (Cur),
                                 EW_Bool_Type,
                                 EW_Prog,
                                 Params =>
                                   (Params
                                    with delta Warn_On_Dead => Do_Warn)));

                        --  Possibly warn on an unreachable case branch

                        Warn_Then :=
                          Do_Warn
                          and then
                            not Exp_Util.Is_Statically_Disabled
                                  (Cond, False, Include_Valid => True);

                        Elsif_Stmts (I) :=
                          Transform_Statements_And_Declarations
                            (Then_Statements (Cur),
                             (Params with delta Warn_On_Dead => Warn_Then));

                        Elsif_Stmts (I) :=
                          +Warn_On_Dead_Code
                             (First (Then_Statements (Cur)),
                              +Elsif_Stmts (I),
                              Params.Phase,
                              Warn_Then);

                        Do_Warn :=
                          Do_Warn
                          and then
                            not Exp_Util.Is_Statically_Disabled
                                  (Cond, True, Include_Valid => True);

                        Next (Cur);
                     end loop;
                  end;
               end if;

               Else_Stmt :=
                 Transform_Statements_And_Declarations
                   (Else_Part, (Params with delta Warn_On_Dead => Do_Warn));

               if Is_Non_Empty_List (Else_Part) then
                  Else_Stmt :=
                    +Warn_On_Dead_Code
                       (First (Else_Part), +Else_Stmt, Params.Phase, Do_Warn);
               end if;

               --  Go over the elsif branches to reconstruct the conditional

               for I in reverse Elsif_Conds'Range loop
                  Else_Stmt :=
                    New_Simpl_Conditional
                      (Condition => Elsif_Conds (I),
                       Then_Part => Elsif_Stmts (I),
                       Else_Part => Else_Stmt);
               end loop;

               --  Finish by putting the main if-then-else on top.

               return
                 New_Simpl_Conditional
                   (Condition =>
                      New_Counterexample_Assign
                        (Stmt_Or_Decl,
                         Transform_Prog
                           (Cond, EW_Bool_Type, Params => Params)),
                    Then_Part => Then_Stmt,
                    Else_Part => Else_Stmt);
            end;

         when N_Object_Declaration
            | N_Object_Renaming_Declaration
            | N_Subtype_Declaration
            | N_Full_Type_Declaration
            | N_Itype_Reference                                   =>
            return Transform_Declaration (Stmt_Or_Decl, Params);

         when N_Loop_Statement                                    =>
            declare
               Term_Checks : W_Prog_Id := +Void;

            begin
               --  If the enclosing subprogram has a dynamic termination
               --  condition and the loop is not known to terminate, check that
               --  the loop cannot be accessed when the condition evaluates to
               --  True.

               if Get_Termination_Condition (Current_Subp).Kind = Dynamic
                 and then
                   not Flow_Utility.Termination_Proved
                         (Iteration_Scheme (Stmt_Or_Decl),
                          Get_Loop_Writes (Entity (Identifier (Stmt_Or_Decl))))
               then
                  pragma Assert (Termination_Condition_Name /= Why_Empty);

                  Term_Checks :=
                    New_Located_Assert
                      (Ada_Node => Stmt_Or_Decl,
                       Pred     =>
                         New_Not (Right => +Termination_Condition_Name),
                       Reason   => VC_Termination_Check,
                       Kind     => EW_Assert);
               end if;

               return
                 Sequence
                   (Term_Checks,
                    Transform_Loop_Statement (Stmt_Or_Decl, Params));
            end;

         when N_Exit_Statement | N_Continue_Statement             =>
            return Transform_Loop_Jump_Statement (Stmt_Or_Decl, Params);

         when N_Case_Statement                                    =>
            declare
               function Transform_Branch
                 (N      : Node_Id;
                  Domain : EW_Domain;
                  Params : Transformation_Params) return W_Expr_Id;
               --  Transform the statements of a branch

               ----------------------
               -- Transform_Branch --
               ----------------------

               function Transform_Branch
                 (N      : Node_Id;
                  Domain : EW_Domain;
                  Params : Transformation_Params) return W_Expr_Id
               is
                  pragma Unreferenced (Domain);
                  T : W_Expr_Id;
               begin
                  --  ??? Maybe we should merge the code for statements?
                  T :=
                    +Transform_Statements_And_Declarations
                       (Statements (N), Params);

                  --  Possibly warn on dead code

                  T :=
                    +Warn_On_Dead_Code
                       (First (Statements (N)),
                        +T,
                        Params.Phase,
                        Params.Warn_On_Dead);

                  return T;
               end Transform_Branch;

               function Transform_Case_Stmt is new
                 Generate_Case_Expression (Transform_Branch);

            begin
               return
                 +Transform_Case_Stmt
                    (N => Stmt_Or_Decl, Domain => EW_Prog, Params => Params);
            end;

         when N_Block_Statement                                   =>
            return Transform_Block_Statement (Stmt_Or_Decl, Params);

         when N_Pragma                                            =>
            if Is_Pragma_Assert_And_Cut (Stmt_Or_Decl) then
               declare
                  Expr       : Node_Id;
                  Check_Expr : W_Prog_Id;
                  Pred       : W_Pred_Id;
                  Msg        : String_Id;
               begin
                  Transform_Pragma_Check
                    (Stmt_Or_Decl,
                     Params,
                     Expr    => Expr,
                     Runtime => Check_Expr,
                     Pred    => Pred,
                     Msg     => Msg);
                  Assert_And_Cut_Prag := Stmt_Or_Decl;
                  Assert_And_Cut_Expr := Expr;
                  Assert_And_Cut := Pred;
                  return New_Ignore (Prog => Check_Expr);
               end;
            else
               return Transform_Pragma (Stmt_Or_Decl, Params, Force => False);
            end if;

         when N_Raise_xxx_Error                                   =>

            --  No condition should be present in SPARK code. Such code should
            --  be rejected after marking and not reach here.

            pragma Assert (No (Condition (Stmt_Or_Decl)));
            return Transform_Unhandled_Raise (Stmt_Or_Decl);

         when N_Raise_Statement                                   =>

            --  For handled exceptions, raise the Why3 exception Ada_Exc.
            --  Otherwise, check that the path is dead. Also transform the
            --  expression in the program domain if there is one to generate
            --  checks.

            if Present (Name (Stmt_Or_Decl)) then
               if Might_Raise_Handled_Exceptions (Stmt_Or_Decl) then

                  --  Havoc borrowed objects and check for resource leaks on
                  --  scopes traversed by the raise statement.

                  return
                    Sequence
                      ((1 =>
                          (if No (Expression (Stmt_Or_Decl))
                           then +Void
                           else
                             New_Ignore
                               (Stmt_Or_Decl,
                                Transform_Prog
                                  (Expression (Stmt_Or_Decl), Params))),
                        2 =>
                          Finalization_Actions_On_Raise (Stmt_Or_Decl, Params),
                        3 =>
                          New_Raise
                            (Ada_Node => Stmt_Or_Decl,
                             Name     => M_Main.Ada_Exc,
                             Arg      =>
                               +To_Why_Id (Entity (Name (Stmt_Or_Decl))))));
               else
                  return Transform_Unhandled_Raise (Stmt_Or_Decl);
               end if;

            --  Reraise the exception of the enclosing exception handler

            else
               pragma Assert (Handled_Exception_Name /= Why_Empty);

               return
                 New_Raise_Or_Absurd
                   (Ada_Node    => Stmt_Or_Decl,
                    Ex_Name     => Handled_Exception_Name,
                    Handled_Exc =>
                      Get_Raised_Exceptions
                        (Stmt_Or_Decl, Only_Handled => True),
                    Params      => Params);
            end if;

         --  Subprogram and package declarations are already taken care of
         --  explicitly. They should not be treated as part of a list of
         --  declarations.

         when N_Package_Body
            | N_Package_Declaration
            | N_Subprogram_Body
            | N_Subprogram_Declaration                            =>
            return +Void;

         when N_Delay_Statement                                   =>
            return
              New_Ignore
                (Ada_Node => Stmt_Or_Decl,
                 Prog     =>
                   Transform_Prog (Expression (Stmt_Or_Decl), Params));

         when others                                              =>
            Ada.Text_IO.Put_Line
              ("[Transform_Statement_Or_Declaration] kind ="
               & Node_Kind'Image (Nkind (Stmt_Or_Decl)));
            raise Not_Implemented;
      end case;
   end Transform_Statement_Or_Declaration;

   ------------------------------------------------
   -- Transform_Statement_Or_Declaration_In_List --
   ------------------------------------------------

   procedure Transform_Statement_Or_Declaration_In_List
     (Stmt_Or_Decl : Node_Id;
      Params       : Transformation_Params;
      Seq          : in out W_Statement_Sequence_Id)
   is
      Cut_Assertion_Prag : Opt_N_Pragma_Id;
      Cut_Assertion_Expr : Opt_N_Subexpr_Id;
      Cut_Assertion      : W_Pred_Id;
      Prog               : constant W_Prog_Id :=
        +Insert_Cnt_Loc_Label
           (Stmt_Or_Decl,
            +Transform_Statement_Or_Declaration
               (Stmt_Or_Decl        => Stmt_Or_Decl,
                Params              => Params,
                Assert_And_Cut_Prag => Cut_Assertion_Prag,
                Assert_And_Cut_Expr => Cut_Assertion_Expr,
                Assert_And_Cut      => Cut_Assertion));
   begin
      Append (Seq, Prog);

      --  If we are translating a label, catch the exception which may have
      --  been raised by goto statements referencing this label.

      if Nkind (Stmt_Or_Decl) = N_Label then
         pragma Assert (Cut_Assertion = Why_Empty);

         declare
            Exc : constant W_Name_Id :=
              Goto_Exception_Name (Entity (Identifier (Stmt_Or_Decl)));
         begin
            Insert_Exception (Exc);
            Seq :=
              +Sequence
                 (Progs =>
                    (1 =>
                       New_Try_Block
                         (Ada_Node => Stmt_Or_Decl,
                          Prog     => +Seq,
                          Handler  =>
                            (1 =>
                               New_Handler
                                 (Ada_Node => Stmt_Or_Decl,
                                  Name     => Exc,
                                  Def      => +Void)))));
         end;

      --  If we are translating an Assert_And_Cut pragma, enclose the previous
      --  statements in an abstract block and only keep the Cut_Assertion.

      elsif Cut_Assertion /= Why_Empty then

         --  If the assertion contains a cut operation, its premise and
         --  side-conditions will be checked as part of the runtime checks, so
         --  the assertion should be assumed.

         if Contains_Cut_Operations (Cut_Assertion_Expr) then
            Seq :=
              +Sequence
                 (Progs =>
                    (1 =>
                       New_Ignore
                         (Ada_Node => Cut_Assertion_Expr, Prog => +Seq),
                     2 => New_Assume_Statement (Pred => Cut_Assertion)));
         else
            declare
               Arg1 : constant Node_Id :=
                 First (Pragma_Argument_Associations (Cut_Assertion_Prag));
               Arg3 : constant Node_Id := Next (Next (Arg1));
               Msg  : constant String_Id :=
                 (if Present (Arg3)
                  then Strval (Expression (Arg3))
                  else No_String);
            begin
               Seq :=
                 +Sequence
                    (Progs =>
                       (1 =>
                          New_Located_Abstract
                            (Ada_Node   => Cut_Assertion_Expr,
                             Expr       => +Seq,
                             Post       => Cut_Assertion,
                             Reason     => VC_Assert,
                             Check_Info =>
                               New_Check_Info (User_Message => Msg))));
            end;
         end if;

         --  Assume the dynamic property of variables referenced in
         --  Cut_Assertion.
         --  ??? We should add the dynamic property of variables modified
         --  in the previous statements, but it is more difficult to get.

         declare
            Vars : constant Node_Sets.Set :=
              Compute_Ada_Node_Set (+Cut_Assertion);
         begin
            for V of Vars loop
               if Nkind (V) in N_Entity
                 and then Is_Object (V)
                 and then Ada_Ent_To_Why.Has_Element (Symbol_Table, V)
                 and then Is_Mutable_In_Why (V)
               then
                  Append
                    (Seq,
                     Assume_Dynamic_Invariant
                       (Expr          =>
                          +Transform_Identifier
                             (Params => Params,
                              Expr   => V,
                              Ent    => V,
                              Domain => EW_Term),
                        Ty            => Etype (V),
                        Valid         =>
                          Get_Valid_Id_From_Object (V, Ref_Allowed => True),
                        Initialized   => False,
                        Only_Var      => True,
                        Top_Predicate => True));
               end if;
            end loop;
         end;
      end if;
   end Transform_Statement_Or_Declaration_In_List;

   -------------------------------------------
   -- Transform_Statements_And_Declarations --
   -------------------------------------------

   function Transform_Statements_And_Declarations
     (Stmts_And_Decls : List_Id; Params : Transformation_Params)
      return W_Prog_Id
   is
      Cur_Stmt_Or_Decl : Node_Id := Nlists.First (Stmts_And_Decls);
      Result           : W_Statement_Sequence_Id := Void_Sequence;

   begin
      if No (Cur_Stmt_Or_Decl) then
         return +Void;
      end if;

      while Present (Cur_Stmt_Or_Decl) loop
         Transform_Statement_Or_Declaration_In_List
           (Stmt_Or_Decl => Cur_Stmt_Or_Decl, Params => Params, Seq => Result);

         Nlists.Next (Cur_Stmt_Or_Decl);
      end loop;

      return +Result;
   end Transform_Statements_And_Declarations;

   ------------------------------
   -- Transform_String_Literal --
   ------------------------------

   function Transform_String_Literal
     (N : Node_Id; Domain : EW_Domain; Params : Transformation_Params)
      return W_Expr_Id
   is
      Is_Static : constant Boolean := Nkind (N) = N_String_Literal;
      Expr      : constant N_String_Literal_Id :=
        (if Is_Static then N else Expression (N));
      Ty        : constant Entity_Id := Type_Of_Node (N);
      pragma Assert (Is_Constrained (Ty));
      pragma Assert (Is_Static = Is_Static_Array_Type (Ty));

      Low       : constant Node_Id :=
        (if Is_Static then String_Literal_Low_Bound (Ty) else Empty);
      Why_Type  : constant W_Type_Id := New_Abstract_Base_Type (Ty);
      Args      : constant W_Expr_Array :=
        (1 =>
           (if Is_Static
            then +Void
            else
              +Get_Array_Attr
                 (Domain => Term_Domain (Domain),
                  Ty     => Ty,
                  Attr   => Attribute_First,
                  Dim    => 1,
                  Params => Params)));
      --  If the low bound is not static, give it as a parameter. Otherwise,
      --  use a function with a unit parameter instead of a constant so that
      --  the axiom is only instantiated when the literal is used.
      Str_Value : constant String_Id := Strval (Expr);
      Length    : constant Nat := String_Length (Str_Value);
      Idx       : constant Entity_Id := First_Index (Retysp (Etype (Ty)));
      Idx_Ty    : constant Entity_Id := Retysp (Etype (Idx));
      B_Ty      : constant W_Type_Id := Base_Why_Type_No_Bool (Idx_Ty);

      M  : W_Module_Id := E_Module (Expr);
      Id : W_Identifier_Id;
      T  : W_Expr_Id;

   begin
      if M = Why_Empty then
         declare
            Low_Id  : constant W_Identifier_Id :=
              New_Temp_Identifier
                (Base_Name => "low",
                 Typ       => Nth_Index_Rep_Type_No_Bool (Ty, 1));
            Binders : constant Binder_Array :=
              (1 =>
                 (if Is_Static
                  then Unit_Param
                  else
                    Binder_Type'
                      (B_Name => Low_Id,
                       B_Ent  => Null_Entity_Name,
                       others => <>)));
            Name    : constant String :=
              New_Temp_Identifier ("String_Literal");
            Id      : constant W_Identifier_Id :=
              New_Identifier (Ada_Node => N, Name => Name, Typ => Why_Type);
            Th      : Theory_UC;
         begin
            Insert_Extra_Module
              (Expr, New_Module (File => No_Symbol, Name => Name));

            M := E_Module (Expr);

            Th :=
              Open_Theory
                (WF_Context,
                 M,
                 Comment =>
                   "Module for defining a value for string literal "
                   & (if Sloc (N) > 0
                      then " defined at " & Build_Location_String (Sloc (N))
                      else "")
                   & ", created in "
                   & GNAT.Source_Info.Enclosing_Entity);

            --  Generate an abstract logic function for the Why3 map of the
            --  literal.

            Emit
              (Th,
               New_Function_Decl
                 (Domain      => EW_Pterm,
                  Name        => Id,
                  Location    => No_Location,
                  Labels      => Symbol_Sets.Empty_Set,
                  Binders     => Binders,
                  Return_Type => Why_Type));

            --  We now generate an axiom which gives the values stored in Id,
            --  when the literal contains only plain Character as expected by
            --  String_To_Name_Buffer.

            if not (Has_Wide_Character (Expr)
                    or else Has_Wide_Wide_Character (Expr))
            then
               declare
                  Call       : constant W_Term_Id :=
                    +New_Call
                       (Domain  => EW_Term,
                        Name    => Id,
                        Binders => Binders,
                        Typ     => Why_Type);
                  Axiom_Name : constant String := Name & "__" & Def_Axiom;
                  Expr_Ar    : W_Pred_Array (1 .. Natural (Length));
                  Def        : W_Pred_Id;

               begin
                  --  For each index in the string, add an assumption
                  --  specifying the value stored in Id at this index.

                  for I in 1 .. Length loop
                     declare
                        Offset  : constant Uint := UI_From_Int (I - 1);
                        Idx_Val : constant W_Term_Id :=
                          (if Is_Static
                           then
                             New_Discrete_Constant
                               (Value => Expr_Value (Low) + Offset,
                                Typ   => B_Ty)
                           else
                             +New_Discrete_Add
                                (Domain => EW_Term,
                                 Left   => +Low_Id,
                                 Right  =>
                                   New_Discrete_Constant
                                     (Value => Offset, Typ => B_Ty)));
                        Arr_Val : constant W_Term_Id :=
                          New_Array_Access
                            (Ar => Call, Index => (1 => +Idx_Val));
                        Char    : constant W_Term_Id :=
                          New_Integer_Constant
                            (Value =>
                               UI_From_CC (Get_String_Char (Str_Value, I)));
                     begin
                        Expr_Ar (Positive (I)) :=
                          New_Comparison
                            (Symbol => Why_Eq,
                             Left   =>
                               Insert_Simple_Conversion
                                 (Expr => Arr_Val, To => EW_Int_Type),
                             Right  => Char);
                     end;
                  end loop;

                  if Length > 0 then
                     Def := New_And_Pred (Expr_Ar);
                  else
                     Def := True_Pred;
                  end if;

                  --  Add the value of the bounds for string literals with a
                  --  non-static low bound.

                  if not Is_Static then
                     declare
                        High_Term    : constant W_Term_Id :=
                          (if Length = 0
                           then
                             +New_Discrete_Substract
                                (Domain => EW_Term,
                                 Left   => +Low_Id,
                                 Right  =>
                                   New_Discrete_Constant
                                     (Value => Uint_1, Typ => B_Ty),
                                 Typ    => B_Ty)
                           else
                             +New_Discrete_Add
                                (Domain => EW_Term,
                                 Left   => +Low_Id,
                                 Right  =>
                                   New_Discrete_Constant
                                     (Value => UI_From_Int (Length - 1),
                                      Typ   => B_Ty),
                                 Typ    => B_Ty));
                        Bounds_Value : W_Pred_Id :=
                          New_And_Pred
                            (Left  =>
                               New_Comparison
                                 (Symbol => Why_Eq,
                                  Left   =>
                                    Get_Array_Attr
                                      (Expr => Call,
                                       Attr => Attribute_First,
                                       Dim  => 1),
                                  Right  => +Low_Id),
                             Right =>
                               New_Comparison
                                 (Symbol => Why_Eq,
                                  Left   =>
                                    +Get_Array_Attr
                                       (Expr => Call,
                                        Attr => Attribute_Last,
                                        Dim  => 1),
                                  Right  => High_Term));

                     begin
                        --  If the computation of the high bound wrap-arounds,
                        --  do not assume the bounds value to avoid generating
                        --  an incorrect axiom.

                        if Is_Modular_Integer_Type (Idx_Ty) then
                           if Length = 0 then
                              Bounds_Value :=
                                New_Conditional
                                  (Condition =>
                                     New_Comparison
                                       (Symbol => MF_BVs (B_Ty).Ugt,
                                        Left   => +Low_Id,
                                        Right  => High_Term),
                                   Then_Part => Bounds_Value);
                           elsif Length >= 1 then
                              Bounds_Value :=
                                New_Conditional
                                  (Condition =>
                                     New_Comparison
                                       (Symbol => MF_BVs (B_Ty).Ule,
                                        Left   => +Low_Id,
                                        Right  => High_Term),
                                   Then_Part => Bounds_Value);
                           end if;
                        end if;

                        --  The low bound is taken as parameter, we should add
                        --  a guard to the axiom for the dynamic property of
                        --  the array to avoid generating an unsound axiom if
                        --  the bounds are not in their type.

                        Bounds_Value :=
                          New_Conditional
                            (Condition =>
                               +New_Dynamic_Property
                                  (Domain => EW_Pred,
                                   Ty     => Base_Type (Ty),
                                   Args   => (+Low_Id, +High_Term),
                                   Params => Params),
                             Then_Part => Bounds_Value,
                             Typ       => EW_Bool_Type);

                        Def :=
                          New_And_Pred (Left => Def, Right => Bounds_Value);
                     end;
                  end if;

                  --  Emit an axiom containing all the assumptions

                  Emit
                    (Th,
                     New_Axiom
                       (Ada_Node => N,
                        Name     => NID (Axiom_Name),
                        Def      =>
                          New_Universal_Quantif
                            (Binders  => Binders,
                             Triggers =>
                               New_Triggers
                                 (Triggers =>
                                    (1 =>
                                       New_Trigger (Terms => (1 => +Call)))),
                             Pred     => Def),
                        Dep      =>
                          New_Axiom_Dep (Name => Id, Kind => EW_Axdep_Func)));

                  if Is_Static then
                     Def :=
                       New_Well_Formed_Pred
                         (New_Call
                            (Name => Id,
                             Args => (1 => +Void),
                             Typ  => Why_Type));

                  else
                     Def :=
                       New_Universal_Quantif
                         (Binders  => Binders,
                          Triggers =>
                            New_Triggers
                              (Triggers =>
                                 (1 => New_Trigger (Terms => (1 => +Call)))),
                          Pred     => New_Well_Formed_Pred (Call));
                  end if;

                  Emit
                    (Th,
                     New_Axiom
                       (Ada_Node => Expr,
                        Name     => NID (Axiom_Name & "__well_formed"),
                        Def      => Def,
                        Dep      =>
                          New_Axiom_Dep (Name => Id, Kind => EW_Axdep_Func)));
               end;
            end if;

            Close_Theory
              (Th, Kind => Definition_Theory, Defined_Entity => Expr);
         end;
      end if;

      Id :=
        New_Identifier
          (Ada_Node => Expr,
           Domain   => Domain,
           Module   => M,
           Symb     => NID (Lower_Case_First (Img (Get_Name (M)))),
           Typ      => Why_Type);

      T :=
        New_Call
          (Ada_Node => Expr,
           Domain   => Domain,
           Name     => Id,
           Args     => Args,
           Typ      => Get_Typ (Id));

      --  In the program domain, emit the necessary range checks. No need to
      --  emit them if everything is static. This case is rejected by the
      --  compiler.

      if Domain = EW_Prog then
         declare
            Low_Expr : constant W_Term_Id :=
              (if Is_Static
               then
                 New_Discrete_Constant (Value => Expr_Value (Low), Typ => B_Ty)
               else
                 +New_Attribute_Expr
                    (Idx_Ty, EW_Term, Attribute_First, Params));
            Checks   : W_Pred_Id := True_Pred;

         begin
            --  For empty strings, check that Low_Expr is not the
            --  first element of the base type.

            if Length = 0 then
               if Is_Static
                 and then
                   Compile_Time_Known_Value
                     (Type_Low_Bound (Base_Type (Idx_Ty)))
               then
                  pragma
                    Assert
                      (Expr_Value (Low)
                       /= Expr_Value (Type_Low_Bound (Base_Type (Idx_Ty))));
               else
                  Checks :=
                    New_Comparison
                      (Symbol => Why_Neq,
                       Left   => Low_Expr,
                       Right  =>
                         +New_Attribute_Expr
                            (Base_Type (Idx_Ty),
                             EW_Term,
                             Attribute_First,
                             Params));
               end if;

            else
               declare
                  Offset     : constant W_Term_Id :=
                    New_Discrete_Constant
                      (Value => UI_From_Int (Length - 1), Typ => B_Ty);
                  Last_Index : constant W_Term_Id :=
                    (if Why_Type_Is_BitVector (B_Ty)
                     then
                       +New_Binary_Op_Expr
                          (Op          => N_Op_Add,
                           Left        => +Low_Expr,
                           Right       => +Offset,
                           Left_Type   => Idx_Ty,
                           Right_Type  => Idx_Ty,
                           Return_Type => Idx_Ty,
                           Domain      => EW_Term)
                     else
                       +New_Discrete_Add
                          (Domain => EW_Term,
                           Left   => +Low_Expr,
                           Right  => +Offset));

               begin
                  --  Check that the last index is at most the last
                  --  index of the subtype.

                  if Is_Static
                    and then
                      Compile_Time_Known_Value (Type_High_Bound (Idx_Ty))
                  then
                     pragma
                       Assert
                         (Expr_Value (Low) + UI_From_Int (Length - 1)
                          <= Expr_Value (Type_High_Bound (Idx_Ty)));
                  else
                     Checks :=
                       New_Comparison
                         (Symbol =>
                            (if Why_Type_Is_BitVector (B_Ty)
                             then MF_BVs (B_Ty).Ule
                             else Int_Infix_Le),
                          Left   => Last_Index,
                          Right  =>
                            +New_Attribute_Expr
                               (Idx_Ty, EW_Term, Attribute_Last, Params));
                  end if;

                  --  For bitvectors, add no-wraparound check

                  if Why_Type_Is_BitVector (B_Ty) then
                     if Is_Static
                       and then
                         Compile_Time_Known_Value (Type_High_Bound (Idx_Ty))
                     then
                        pragma
                          Assert
                            (Expr_Value (Low) + UI_From_Int (Length - 1)
                             <= Expr_Value (Type_High_Bound (Idx_Ty)));
                     else
                        Checks :=
                          New_And_Pred
                            (New_Comparison
                               (Symbol => MF_BVs (B_Ty).Ule,
                                Left   => Low_Expr,
                                Right  => Last_Index),
                             Checks);
                     end if;
                  end if;
               end;

            end if;

            if not Is_True_Boolean (+Checks) then
               T :=
                 +Sequence
                    (New_Ignore
                       (Prog =>
                          New_Located_Assert
                            (Ada_Node => Expr,
                             Pred     => Checks,
                             Reason   => VC_Range_Check,
                             Kind     => EW_Assert)),
                     Right => +T);
            end if;
         end;
      end if;

      return T;
   end Transform_String_Literal;

   -------------------------------
   -- Type_Invariant_Expression --
   -------------------------------

   function Type_Invariant_Expression
     (Expr     : W_Term_Id;
      Inv_Subp : E_Procedure_Id;
      Params   : Transformation_Params) return W_Pred_Id
   is
      Result    : W_Pred_Id := True_Pred;
      Inv_Exprs : constant Node_Lists.List :=
        Get_Exprs_From_Check_Only_Proc (Inv_Subp);
      Inv_Param : constant Entity_Id := First_Formal (Inv_Subp);
      Inv_Id    : constant W_Identifier_Id :=
        New_Temp_Identifier (Inv_Param, Get_Type (+Expr));

   begin
      Ada_Ent_To_Why.Push_Scope (Symbol_Table);

      --  Register the temporary identifier Inv_Id for parameter Inv_Param in
      --  the symbol table. This ensures both that a distinct name is used each
      --  time (preventing name capture), and that the type of Expr is used as
      --  the type used to represent Inv_Param (avoiding type conversion).

      Insert_Tmp_Item_For_Entity (Inv_Param, Inv_Id);

      --  Transform the invariant expressions into Why3

      for Expr of Inv_Exprs loop
         Result :=
           New_And_Pred
             (Result,
              Transform_Pred
                (Expr   => Expr,
                 Params => (Params with delta Gen_Marker => GM_Label)));
      end loop;

      --  Relate the name Inv_Id used in the invariant expression to the
      --  value Expr for which the invariant is checked.

      Result :=
        New_Binding
          (Name    => Inv_Id,
           Def     => Expr,
           Context => Result,
           Typ     => Get_Type (+Result));

      Ada_Ent_To_Why.Pop_Scope (Symbol_Table);

      return Result;
   end Type_Invariant_Expression;

   -------------------------------
   -- Variables_In_Default_Init --
   -------------------------------

   procedure Variables_In_Default_Init
     (Ty : Type_Kind_Id; Variables : in out Flow_Id_Sets.Set)
   is
      Ty_Ext : constant Entity_Id := Retysp (Ty);
   begin
      if Is_Scalar_Type (Ty_Ext) then
         if Has_Default_Aspect (Ty_Ext) then
            Variables.Union
              (Get_Variables_For_Proof
                 (Default_Aspect_Value (Ty_Ext), Ty_Ext));
         end if;
      elsif Is_Array_Type (Ty_Ext)
        and then Ekind (Ty_Ext) /= E_String_Literal_Subtype
      then
         pragma Assert (Is_Constrained (Ty_Ext));

         --  Generates:
         --  forall i1 : int ..
         --   in_range (i1) /\ .. ->
         --    get (<Expr>, i1, ...) = <Default_Component_Value>    <if any>
         --    default_init (get (<Expr>, i1, ...), Component_Type) <otherwise>

         if Has_Default_Aspect (Ty_Ext) then

            --  if Ty_Ext as a Default_Component_Value aspect,
            --  generate get (<Expr>, i1, ...) = <Default_Component_Value>

            Variables.Union
              (Get_Variables_For_Proof
                 (Default_Aspect_Component_Value (Ty_Ext), Ty_Ext));
         else

            --  otherwise, use its Component_Type default value.

            Variables_In_Default_Init (Component_Type (Ty_Ext), Variables);
         end if;

         --  Add variables for bounds of dynamically constrained types

         if Is_Constrained (Ty_Ext) and then not Is_Static_Array_Type (Ty_Ext)
         then
            declare
               Index : Node_Id := First_Index (Ty_Ext);
            begin
               while Present (Index) loop
                  Variables.Union
                    (Get_Variables_For_Proof
                       (Low_Bound (Get_Range (Index)), Ty_Ext));
                  Variables.Union
                    (Get_Variables_For_Proof
                       (High_Bound (Get_Range (Index)), Ty_Ext));
                  Next_Index (Index);
               end loop;
            end;
         end if;

      elsif Is_Record_Type (Ty_Ext)
        or else Is_Incomplete_Or_Private_Type (Ty_Ext)
      then

         --  Generates:
         --  let tmp1 = <Expr>.rec__disc1 in
         --  <Expr>.is_constrained = False /\ <if Ty_Ext as default discrs>
         --  <Expr>.rec__disc1 = Discr1.default  <if Ty_Ext is unconstrained>
         --  <Expr>.rec__disc1 = Discr1 /\ ..    <if Ty_Ext is constrained>
         --  (check_for_field1 expr ->
         --      <Expr>.rec__field1 = Field1.def      <if Field1 has a default>
         --      default_init (<Expr>.rec__field1, Etype (Field1))) <otherwise>
         --  /\ ..

         declare
            Has_Discr : constant Boolean := Has_Discriminants (Ty_Ext);

            Discr : Node_Id :=
              (if Has_Discr then First_Discriminant (Ty_Ext) else Empty);
            Elmt  : Elmt_Id :=
              (if Has_Discr and then Is_Constrained (Ty_Ext)
               then First_Elmt (Stored_Constraint (Ty_Ext))
               else No_Elmt);
         begin

            --  Go through discriminants to create
            --  <Expr>.rec__disc1 = Discr1.default <if Ty_Ext is unconstrained>
            --  <Expr>.rec__disc1 = Discr1 /\ ..   <if Ty_Ext is constrained>

            while Present (Discr) loop
               if Is_Constrained (Ty_Ext) then

                  --  Generate <Expr>.rec__disc1 = Discr

                  Variables.Union
                    (Get_Variables_For_Proof (Node (Elmt), Ty_Ext));
                  Next_Elmt (Elmt);
               else
                  pragma Assert (Has_Defaulted_Discriminants (Ty_Ext));

                  --  Generate <Expr>.rec__disc1 = Discr1.default

                  Variables.Union
                    (Get_Variables_For_Proof
                       (Discriminant_Default_Value (Discr), Ty_Ext));
               end if;
               Next_Discriminant (Discr);
            end loop;

            --  Go through other fields to create the expression
            --  (check_for_field1 expr ->
            --   <Expr>.rec__field1 = Field1.def      <if Field1 has a default>
            --   default_init (<Expr>.rec__field1, Etype (Field1))) <otherwise>
            --  /\ ..

            if Is_Record_Type (Ty_Ext)
              or else Is_Incomplete_Or_Private_Type (Ty_Ext)
            then

               for Field of Get_Component_Set (Ty_Ext) loop
                  if not Is_Type (Field) then
                     if Present (Expression (Enclosing_Declaration (Field)))
                     then

                        --  if Field has a default expression, use it.
                        --   <Expr>.rec__field1 = Field1.default

                        Variables.Union
                          (Get_Variables_For_Proof
                             (Expression (Enclosing_Declaration (Field)),
                              Ty_Ext));
                     else

                        --  otherwise, use its Field's Etype default value.
                        --   default_init (<Expr>.rec__field1, Etype (Field1)))

                        Variables_In_Default_Init (Etype (Field), Variables);
                     end if;
                  end if;
               end loop;
            end if;
         end;
      end if;

      --  Assume the default initial condition for Ty, when specified as a
      --  boolean expression.

      if Has_DIC (Ty) then
         declare
            procedure Get_Variables_From_DIC
              (Default_Init_Param : Formal_Kind_Id;
               Default_Init_Expr  : Node_Id)
            with
              Pre =>
                Ekind (Default_Init_Param) = E_In_Parameter
                and then Nkind (Default_Init_Expr) in N_Subexpr;

            ----------------------------
            -- Get_Variables_From_DIC --
            ----------------------------

            procedure Get_Variables_From_DIC
              (Default_Init_Param : Formal_Kind_Id;
               Default_Init_Expr  : Node_Id) is
            begin
               if Present (Default_Init_Expr) then

                  Variables.Union
                    (Get_Variables_For_Proof (Default_Init_Expr, Ty_Ext));

                  --  Remove parameter of DIC procedure

                  Variables.Exclude (Direct_Mapping_Id (Default_Init_Param));
               end if;
            end Get_Variables_From_DIC;

            procedure Get_Variables_From_All_DIC is new
              Iterate_Applicable_DIC (Get_Variables_From_DIC);
         begin
            Get_Variables_From_All_DIC (Ty);
         end;
      end if;
   end Variables_In_Default_Init;

   ------------------------------------
   -- Variables_In_Dynamic_Predicate --
   ------------------------------------

   procedure Variables_In_Dynamic_Predicate
     (Ty : Type_Kind_Id; Variables : in out Flow_Id_Sets.Set)
   is
      procedure Get_Variables_From_Predicate
        (Pred_Param : Formal_Kind_Id; Pred_Expr : Node_Id);

      ----------------------------------
      -- Get_Variables_From_Predicate --
      ----------------------------------

      procedure Get_Variables_From_Predicate
        (Pred_Param : Formal_Kind_Id; Pred_Expr : Node_Id) is
      begin
         Variables.Union
           (Get_Variables_For_Proof (Pred_Expr, Etype (Pred_Param)));
         Variables.Exclude (Direct_Mapping_Id (Pred_Param));
      end Get_Variables_From_Predicate;

      procedure Get_Variables_From_All_Preds is new
        Iterate_Applicable_Predicates (Get_Variables_From_Predicate);
   begin
      Get_Variables_From_All_Preds (Ty);
   end Variables_In_Dynamic_Predicate;

   ------------------------------------
   -- Variables_In_Dynamic_Invariant --
   ------------------------------------

   procedure Variables_In_Dynamic_Invariant
     (Ty : Type_Kind_Id; Variables : in out Flow_Id_Sets.Set; Scop : Entity_Id)
   is

      procedure Variables_In_Dynamic_Invariant
        (Ty          : Entity_Id;
         Variables   : in out Flow_Id_Sets.Set;
         Incompl_Acc : in out Entity_Sets.Set);
      --  Auxiliary function with an additional parameter storing access
      --  types to incomplete types already encountered (to avoid looping
      --  on recursive data-structures).

      ------------------------------------
      -- Variables_In_Dynamic_Invariant --
      ------------------------------------

      procedure Variables_In_Dynamic_Invariant
        (Ty          : Entity_Id;
         Variables   : in out Flow_Id_Sets.Set;
         Incompl_Acc : in out Entity_Sets.Set)
      is
         Spec_Ty : constant Entity_Id :=
           (if Is_Class_Wide_Type (Ty)
            then Get_Specific_Type_From_Classwide (Ty)
            else Ty);
         Ty_Ext  : constant Entity_Id := Retysp (Spec_Ty);

      begin
         --  Dynamic property of the type itself

         if Type_Is_Modeled_As_Base (Ty_Ext) then

            --  If a scalar type is not modeled as base, then its bounds are
            --  constants.
            --  Otherwise, variables may occur in their expressions.

            declare
               Rng : constant Node_Id := Get_Range (Ty_Ext);
            begin
               Variables.Union
                 (Get_Variables_For_Proof (Low_Bound (Rng), Ty_Ext));
               Variables.Union
                 (Get_Variables_For_Proof (High_Bound (Rng), Ty_Ext));
            end;
         elsif Is_Array_Type (Ty_Ext)
           and then not Is_Static_Array_Type (Ty_Ext)
         then

            --  Variables coming from the bounds of the index types

            declare
               Index : Node_Id := First_Index (Ty_Ext);
            begin
               while Present (Index) loop
                  if Type_Is_Modeled_As_Base (Etype (Index)) then
                     declare
                        Rng : constant Node_Id := Get_Range (Etype (Index));
                     begin
                        Variables.Union
                          (Get_Variables_For_Proof (Low_Bound (Rng), Ty_Ext));
                        Variables.Union
                          (Get_Variables_For_Proof (High_Bound (Rng), Ty_Ext));
                     end;
                  end if;
                  Next_Index (Index);
               end loop;
            end;

            --  If the array is constrained, also assume the value of its
            --  bounds.

            if Is_Constrained (Ty_Ext) then
               declare
                  Index : Node_Id := First_Index (Ty_Ext);
               begin
                  while Present (Index) loop
                     declare
                        Rng : constant Node_Id := Get_Range (Index);
                     begin
                        Variables.Union
                          (Get_Variables_For_Proof (Low_Bound (Rng), Ty_Ext));
                        Variables.Union
                          (Get_Variables_For_Proof (High_Bound (Rng), Ty_Ext));
                     end;
                     Next_Index (Index);
                  end loop;
               end;
            end if;

         elsif Has_Discriminants (Ty_Ext) then

            --  Variables coming from the record's discriminants

            declare
               Discr : Entity_Id := First_Discriminant (Ty_Ext);
               Elmt  : Elmt_Id :=
                 (if Is_Constrained (Ty_Ext)
                  then First_Elmt (Discriminant_Constraint (Ty_Ext))
                  else No_Elmt);
            begin
               while Present (Discr) loop
                  if Is_Constrained (Ty_Ext) then
                     Variables.Union
                       (Get_Variables_For_Proof (Node (Elmt), Ty_Ext));
                     Next_Elmt (Elmt);
                  end if;

                  Variables_In_Dynamic_Invariant
                    (Etype (Discr), Variables, Incompl_Acc);
                  Next_Discriminant (Discr);
               end loop;
            end;
         end if;

         --  Variables in the predicate of the type

         if Has_Predicates (Ty_Ext) then
            Variables_In_Dynamic_Predicate (Ty_Ext, Variables);
         end if;

         --  Dynamic Invariant of Ty_Ext's components

         if Is_Array_Type (Ty_Ext)
           and then Ekind (Ty_Ext) /= E_String_Literal_Subtype
         then

            Variables_In_Dynamic_Invariant
              (Component_Type (Ty_Ext), Variables, Incompl_Acc);

         elsif Is_Record_Type (Ty_Ext)
           or else Is_Incomplete_Or_Private_Type (Ty_Ext)
         then

            for Field of Get_Component_Set (Ty_Ext) loop
               if not Is_Type (Field) then
                  Variables_In_Dynamic_Invariant
                    (Etype (Field), Variables, Incompl_Acc);
               end if;
            end loop;
         elsif Is_Access_Type (Ty_Ext)
           and then not Is_Access_Subprogram_Type (Ty_Ext)
           and then
             (not Designates_Incomplete_Type (Repr_Pointer_Type (Ty_Ext))
              or else not Incompl_Acc.Contains (Repr_Pointer_Type (Ty_Ext)))
         then
            if Designates_Incomplete_Type (Repr_Pointer_Type (Ty_Ext)) then
               Incompl_Acc.Insert (Repr_Pointer_Type (Ty_Ext));
            end if;

            Variables_In_Dynamic_Invariant
              (Directly_Designated_Type (Ty_Ext), Variables, Incompl_Acc);
         end if;

         --  Assumed type invariant of Ty_Ext and its parents if any

         declare
            Current : Entity_Id := Ty_Ext;
            Parent  : Entity_Id;
         begin
            loop
               if Has_Invariants_In_SPARK (Current)
                 and then
                   (Invariant_Assumed_In_Main (Current)
                    or else
                      (Present (Scop)
                       and then Invariant_Assumed_In_Scope (Current, Scop)))
               then
                  Variables_In_Type_Invariant (Current, Variables);
               end if;

               Parent := Retysp (Etype (Current));
               exit when Current = Parent;
               Current := Parent;
            end loop;
         end;
      end Variables_In_Dynamic_Invariant;

      --  Local variables

      Incompl_Acc : Entity_Sets.Set;

      --  Start of processing for Variables_In_Dynamic_Invariant

   begin
      Variables_In_Dynamic_Invariant (Ty, Variables, Incompl_Acc);
   end Variables_In_Dynamic_Invariant;

   ---------------------------------
   -- Variables_In_Type_Invariant --
   ---------------------------------

   procedure Variables_In_Type_Invariant
     (Ty : Type_Kind_Id; Variables : in out Flow_Id_Sets.Set)
   is
      Rep_Type       : constant Entity_Id := Retysp (Ty);
      Inv_Subp       : constant Node_Id := Invariant_Procedure (Rep_Type);
      Type_Inv_Exprs : constant Node_Lists.List :=
        Get_Exprs_From_Check_Only_Proc (Inv_Subp);
      Inv_Param      : constant Entity_Id := First_Formal (Inv_Subp);

   begin
      for Expr of Type_Inv_Exprs loop
         Variables.Union (Get_Variables_For_Proof (Expr, Rep_Type));
      end loop;

      --  Remove parameter of invariant procedure

      Variables.Exclude (Direct_Mapping_Id (Unique_Entity (Inv_Param)));
   end Variables_In_Type_Invariant;

   -------------------------
   -- Warn_On_Dead_Branch --
   -------------------------

   function Warn_On_Dead_Branch
     (N       : N_Subexpr_Id;
      W       : W_Prog_Id;
      Phase   : Transformation_Phase;
      Do_Warn : Boolean) return W_Prog_Id
   is (Warn_On_Dead_Branch_Or_Code
         (N, W, Branch => True, Phase => Phase, Do_Warn => Do_Warn));

   ---------------------------------
   -- Warn_On_Dead_Branch_Or_Code --
   ---------------------------------

   function Warn_On_Dead_Branch_Or_Code
     (N       : Node_Id;
      W       : W_Prog_Id;
      Branch  : Boolean;
      Phase   : Transformation_Phase;
      Do_Warn : Boolean) return W_Prog_Id
   is
      Stmt : W_Prog_Id;

   begin
      --  Only issue a check for unreachable branch if:
      --  - switch --proof-warnings is set
      --  - and warnings are not suppressed
      --  - and this specific warning is not suppressed
      --  - and a warning can be issued on that node
      --  - and the phase corresponds to generating VCs
      --  - and when the next statement if not an unconditional error, signaled
      --    typically as a raise statement or a pragma Assert (False).
      if Gnat2Why_Args.Proof_Warnings
        and then Opt.Warning_Mode /= Opt.Suppress
        and then Do_Warn
        and then May_Issue_Warning_On_Node (N)
        and then Phase in Generate_VCs
        and then not Is_Error_Signaling_Statement (N)
      then
         Stmt :=
           New_Located_Assert
             (Ada_Node => N,
              Pred     => False_Pred,
              Reason   =>
                (if Branch then VC_Unreachable_Branch else VC_Dead_Code),
              Kind     => EW_Check);

         return
           Sequence
             ((1 =>
                 New_Comment
                   (Comment =>
                      NID
                        ("Check dead branch "
                         & Build_Location_String (Sloc (N)))),
               2 => New_Ignore (Prog => Stmt),
               3 => W));

      --  Otherwise return the argument unmodified

      else
         return W;
      end if;
   end Warn_On_Dead_Branch_Or_Code;

   -----------------------
   -- Warn_On_Dead_Code --
   -----------------------

   function Warn_On_Dead_Code
     (N       : Node_Id;
      W       : W_Prog_Id;
      Phase   : Transformation_Phase;
      Do_Warn : Boolean) return W_Prog_Id
   is (+Warn_On_Dead_Branch_Or_Code
          (N, +W, Branch => False, Phase => Phase, Do_Warn => Do_Warn));

   ---------------------------------
   -- Warn_On_Inconsistent_Assume --
   ---------------------------------

   function Warn_On_Inconsistent_Assume
     (N : Node_Id; Do_Warn : Boolean) return W_Prog_Id
   is
      Stmt : W_Prog_Id;

   begin
      --  Only issue a check for unreachable branch if:
      --  - switch --proof-warnings is set,
      --  - warnings are not suppressed,
      --  - this specific warning is not suppressed,
      --  - and a warning can be issued on that node.
      if Gnat2Why_Args.Proof_Warnings
        and then Opt.Warning_Mode /= Opt.Suppress
        and then Do_Warn
        and then May_Issue_Warning_On_Node (N)
      then
         Stmt :=
           New_Located_Assert
             (Ada_Node => N,
              Pred     => False_Pred,
              Reason   => VC_Inconsistent_Assume,
              Kind     => EW_Check);

         return
           Sequence
             ((1 =>
                 New_Comment
                   (Comment =>
                      NID
                        ("Check inconsistent assume "
                         & Build_Location_String (Sloc (N)))),
               2 => New_Ignore (Prog => Stmt)));

      else
         return +Void;
      end if;
   end Warn_On_Inconsistent_Assume;

end Gnat2Why.Expr;
