let rec lval_to_loc ~with_alarms state lv =
  let _,_,r =
    lval_to_loc_deps_option
      ~with_alarms
      ~deps:None
      ~reduce_valid_index:(Parameters.SafeArrays.get ())
      state
      lv
  in
  r

and lval_to_loc_deps_option
    ~with_alarms ~deps (state:Relations_type.Model.t) ~reduce_valid_index
    (base,offset as lv)  =
  if not (Relations_type.Model.is_reachable state) then
    state, deps, loc_bottom
  else
    let typ = match base with
    | Var host -> host.vtype
    | Mem x -> typeOf x
    in
    try
      let state, deps, offs =
        eval_offset
          ~reduce_valid_index
          ~with_alarms deps typ state offset
      in
      base_to_loc ~with_alarms ?deps state lv base offs
    with Offset_not_based_on_Null(deps,offset) ->
      let state, deps, loc_if_there_wasnt_offset =
        base_to_loc ~with_alarms ?deps state lv base Ival.zero
      in
      state, deps,
      loc_bits_to_loc lv
        (Location_Bits.join
            (loc_bytes_to_loc_bits offset)
            loc_if_there_wasnt_offset.loc)

(* pc says: only called in addrOf *)
and lval_to_loc_with_offset_deps_only
    ~deps (state:Relations_type.Model.t) v
    =
  lval_to_loc_with_offset_deps_only_option ~deps:(Some deps) state v

and lval_to_loc_with_deps ~deps state lv ~with_alarms =
  lval_to_loc_deps_option ~with_alarms ~deps:(Some deps) state lv

(* pc says: only called in addrOf *)
and lval_to_loc_with_offset_deps_only_option
    ~with_alarms ~deps (state:Relations_type.Model.t) (_base, _offset as v)
    =
  lval_to_loc_deps_option
    ~with_alarms ~deps (state:Relations_type.Model.t) (v)
    ~reduce_valid_index:false


(** Detects if an expression can be considered as a lvalue even though it is hidden by a cast that does not change the lvalue. Raises exn if it is not an lvalue.

TODO: When the goal is to recognize the form (cast)l-value == expr, it would be better and more powerful to have chains of inverse functions *)



and pass_cast ~with_alarms state exn typ e =
  (* type might be the same but their attributes.
     But volatile attribute cannot be skipped *)

  if not (Cilutil.equals
             (typeSigWithAttrs (filterAttributes "volatile") typ)
             (typeSigWithAttrs (filterAttributes "volatile") (typeOf e)))
  then
    (try
        let typeofe = typeOf e in
        (* Any volatile attribute may have an effect on the expression value *)
        if hasAttribute "volatile" (typeAttrs typeofe)
          || hasAttribute  "volatile" (typeAttrs typ)
        then raise exn;
        let sztyp = sizeof typ in
        let szexpr = sizeof typeofe in
        let typ_ge_typeofe =
          match sztyp,szexpr with
            Int_Base.Value styp, Int_Base.Value sexpr -> Int.ge styp sexpr
          | _ -> false
        in
        if typ_ge_typeofe then
          let sityp = is_signed_int_enum_pointer typ in
          let sisexpr = is_signed_int_enum_pointer (typeOf e) in
          if sityp = sisexpr then ()
            (* destination type is larger and has the same sign as
               the original type *)

          else begin (* try to ignore the cast if it acts as identity
                        on the value [e] even if signed/unsigned
                        conflict. *)

              match unrollType typ with
              | TInt _ | TEnum _ ->
                  let size = Int.of_int (bitsSizeOf typ) in
                  let signed = sityp in
                  (try
                      let old_ival = V.find_ival
                        (eval_expr ~with_alarms state e)
                      in
                      if (Ival.equal
                             old_ival
                             (Ival.cast ~size ~signed ~value:old_ival))
                      then () (* [e] is not sensitive to cast *)
                      else raise exn
                    with
                    | Not_found
                    | V.Not_based_on_null ->
                        raise exn)
                    (* this is not always injective, thus cannot be
                       easily reverted. *)

              | _ -> raise exn
            end
        else raise exn
      with Neither_Int_Nor_Enum_Nor_Pointer
        -> raise exn)

and find_lv ~with_alarms (state:Relations_type.Model.t) ee =
  (* [BM] Do not recognize an lval whenever a volatile is involved to
     prevent copy/paste optimization. IS THIS THE RIGHTPLACE PC ?*)

  if hasAttribute "volatile" (typeAttrs (typeOf ee)) then
    raise Cannot_find_lv;
  match ee.enode with
  | Lval lv -> lv
  | CastE (typ,e) ->
      ( match unrollType typ, unrollType (typeOf e) with
        TFloat _, TFloat _ -> find_lv ~with_alarms state e
          (* see remark at pass_cast about inverse functions *)
      | _ ->
          pass_cast ~with_alarms state Cannot_find_lv typ e;
          find_lv ~with_alarms state e)
  | _ -> raise Cannot_find_lv

and find_lv_plus ~with_alarms state e =
  let acc = ref [] in
  let rec find_lv_plus_rec e current_offs =
    try
      let lv = find_lv ~with_alarms state e in
      if not (hasAttribute "volatile" (typeAttrs (Cil.typeOfLval lv)))
      then acc := (lv,current_offs) :: !acc
    with Cannot_find_lv ->
      match e.enode with
        BinOp(op, e1, e2, typ) ->
          begin
            match unrollType typ with
              TFloat _ -> ()
            | _ -> begin
                  match op with
                    PlusA ->
                      let ev1 = eval_expr ~with_alarms state e1 in
                      let ev2 = eval_expr ~with_alarms state e2 in
                      ( try
                          let ival1 = V.find_ival ev1 in
                          find_lv_plus_rec e2 (Ival.add current_offs ival1)
                        with V.Not_based_on_null -> ());
                      ( try
                          let ival2 = V.find_ival ev2 in
                          find_lv_plus_rec e1 (Ival.add current_offs ival2)
                        with V.Not_based_on_null -> ());
                  | (MinusA|MinusPI|PlusPI|IndexPI as b) ->
                      let ev2 = eval_expr ~with_alarms state e2 in
                      ( try
                          let ival2 = V.find_ival ev2 in
                          let ival2 =
                            if b = MinusA
                            then ival2
                            else
                              let ival2 =
                                Ival.scale
                                  (Int_Base.project (osizeof_pointed typ))
                                  ival2
                              in
                              if b = MinusPI
                              then ival2
                              else Ival.neg ival2
                          in
                          find_lv_plus_rec e1 (Ival.sub current_offs ival2)
                        with V.Not_based_on_null | Int_Base.Error_Top-> ());
                  | _ -> ()
              end
          end
      | CastE(typ,e) ->
          ( try
              pass_cast ~with_alarms  state Cannot_find_lv typ e;
            find_lv_plus_rec e current_offs
            with Cannot_find_lv -> ())
      | _ -> ()
  in
  find_lv_plus_rec e Ival.singleton_zero;
  (*List.iter
    (fun (lv,ival) ->
    ignore (Pretty.printf "find_lv_plus %a : %s\n"
    d_lval lv
    (pretty_to_string Ival.pretty ival)))
    !acc;*)

  !acc

and base_to_loc ~with_alarms ?deps state lv base offs =
  if Ival.equal Ival.bottom offs
  then begin
      Relations_type.Model.bottom,
    (Some Zone.bottom),
    loc_bits_to_loc lv Location_Bits.bottom
    end
  else
    let result = match base with
    | Var host ->
        let base = Base.create_varinfo host in
        state, deps,
        loc_bits_to_loc lv (Location_Bits.inject base offs)
    | Mem x ->
        let state, deps, loc_lv =
          eval_expr_with_deps_state ~with_alarms deps state x
        in
        let loc_bits =
          Location_Bits.location_shift
            offs
            (loc_bytes_to_loc_bits loc_lv)
        in
        state, deps, loc_bits_to_loc lv loc_bits
    in
    CilE.set_syntactic_context (CilE.SyMem lv);
    result

and eval_expr ~with_alarms state e =
  snd (eval_expr_with_deps ~with_alarms None state e)

and get_vars ~with_alarms state cond =
  let rec get_vars acc cond =
    match cond.enode with
    | Lval (Var v, off as lv) ->
        let offset =
          try
            let _, _, offset =
              eval_offset ~reduce_valid_index:true ~with_alarms None
                v.vtype state off
            in
            offset
          with Offset_not_based_on_Null _ ->
            Ival.top
        in
        if Ival.cardinal_zero_or_one offset
        then
          let varid = Base.create_varinfo v in
          let loc =
            Locations.make_loc
              (Locations.Location_Bits.inject varid offset)
              (sizeof_lval lv)
          in
          loc :: acc
        else
          get_vars_offset acc off
    | Lval (Mem e,_off) ->
        get_vars acc e
    | BinOp(_,v1,v2,_) ->
        get_vars (get_vars acc v1) v2
    | UnOp(_,v1,_) ->
        get_vars acc v1
    | CastE (_typ,exp) ->
        get_vars acc exp
    | _ -> acc (* TODO : more cases can be done *)
  and get_vars_offset acc offset =
    match offset with
      NoOffset -> acc
    | Field (_,off) -> get_vars_offset acc off
    | Index (ind,off) -> get_vars (get_vars_offset acc off) ind
  in
  get_vars [] cond

and reduce_by_valid_expr ~with_alarms ~positive exp state =
  try
    ignore (with_alarms);
    let lv =
      match exp.enode with
        Lval lv -> lv
      | _ -> raise Cannot_find_lv
    in
    (* TODO: utiliser find_lv_plus pour traiter plus d'expressions *)
    let loc = lval_to_loc ~with_alarms:CilE.warn_none_mode state lv in
    if not (Locations.valid_cardinal_zero_or_one loc)
    then state
    else
      let value = Relations_type.Model.find
        ~with_alarms:CilE.warn_none_mode
        state
        loc
      in
      ( match value with
        Location_Bytes.Top _ ->
          (* we won't reduce anything anyway,
             and we may lose information if loc contains misaligned data *)

          raise Cannot_find_lv
      | _ -> () );
      let value_as_loc =
        make_loc
          (loc_bytes_to_loc_bits value)
          (sizeof_pointed (Cil.typeOfLval lv))
      in
      let reduced_value =
        loc_to_loc_without_size
          (if positive
            then valid_part value_as_loc
            else invalid_part value_as_loc )
      in
      if Location_Bytes.equal value reduced_value
      then state
      else begin
          if Location_Bytes.equal Location_Bytes.bottom reduced_value
          then Relations_type.Model.bottom
          else
            Relations_type.Model.reduce_binding
              state
              loc
              reduced_value
        end
  with Cannot_find_lv -> state

and eval_expr_with_deps ~with_alarms deps (state : Relations_type.Model.t) e =
  let _,deps,r = eval_expr_with_deps_state ~with_alarms deps state e in
  deps, r

and eval_BinOp ~with_alarms op e1 e2 typ deps state =
  let state, deps, ev1 =
    eval_expr_with_deps_state ~with_alarms deps state e1
  in
  if V.is_bottom ev1
  then Relations_type.Model.bottom, (Some Zone.bottom) ,V.bottom
  else
    let state, deps, ev2 =
      eval_expr_with_deps_state ~with_alarms deps state e2
    in
    if V.is_bottom ev2
    then Relations_type.Model.bottom, (Some Zone.bottom) ,V.bottom
    else begin
        CilE.set_syntactic_context (CilE.SyBinOp (op,e1,e2));
        begin match unrollType (typeOf e1) with
        | TFloat _ ->
            let interpreted_expr =
              (* refactor: shouldn't this be somewhere else? *)
              try
                let f1 =
                  try
                    let v1 = V.find_ival ev1 in
                    Ival.project_float v1
                  with V.Not_based_on_null
                  | Ival.Float_abstract.Nan_or_infinite ->
                      Value_parameters.warning ~current:true ~once:true
                        "float value must be finite: assert(TODO)";
                      Ival.Float_abstract.top
                in
                let f2 =
                  try
                    let v2 = V.find_ival ev2 in
                    Ival.project_float v2
                  with V.Not_based_on_null
                  | Ival.Float_abstract.Nan_or_infinite ->
                      Value_parameters.warning ~current:true ~once:true
                        "converting value to float: assert(TODO)";
                      Ival.Float_abstract.top
                in
                let binary_float_floats _name f =
                  try
                    V.inject_ival (Ival.inject_float (f f1 f2))
                  with
                    Ival.Float_abstract.Nan_or_infinite ->
                      CilE.warn_result_nan_infinite with_alarms ;
                      V.top_float
                  | Ival.Float_abstract.Bottom ->
                      CilE.warn_result_nan_infinite with_alarms ;
                      V.bottom
                in
                begin match op with
                | PlusA ->
                    binary_float_floats "+." Ival.Float_abstract.add_float
                | MinusA ->
                    binary_float_floats "-." Ival.Float_abstract.sub_float
                | Mult ->
                    binary_float_floats "*." Ival.Float_abstract.mult_float
                | Div ->
                    if Ival.Float_abstract.contains_zero f2
                    then
                      Value_parameters.warning ~once:true ~current:true
                        "float division: assert(TODO)";
                    binary_float_floats "/." Ival.Float_abstract.div_float
                | Eq ->
                    let contains_zero, contains_non_zero =
                      Ival.Float_abstract.equal_float_ieee f1 f2
                    in
                    V.interp_boolean ~contains_zero ~contains_non_zero
                | Ne ->
                    let contains_non_zero, contains_zero =
                      Ival.Float_abstract.equal_float_ieee f1 f2
                    in
                    V.interp_boolean ~contains_zero ~contains_non_zero
                | Lt ->
                    V.interp_boolean
                      ~contains_zero:(Ival.Float_abstract.maybe_le_ieee_float f2 f1)
                      ~contains_non_zero:(Ival.Float_abstract.maybe_lt_ieee_float f1 f2)
                | Le ->
                    V.interp_boolean
                      ~contains_zero:(Ival.Float_abstract.maybe_lt_ieee_float f2 f1)
                      ~contains_non_zero:(Ival.Float_abstract.maybe_le_ieee_float f1 f2)
                | Gt ->
                    V.interp_boolean
                      ~contains_zero:(Ival.Float_abstract.maybe_le_ieee_float f1 f2)
                      ~contains_non_zero:(Ival.Float_abstract.maybe_lt_ieee_float f2 f1)
                | Ge ->
                    V.interp_boolean
                      ~contains_zero:(Ival.Float_abstract.maybe_lt_ieee_float f1 f2)
                      ~contains_non_zero:(Ival.Float_abstract.maybe_le_ieee_float f2 f1)
                | _ -> raise V.Not_based_on_null
                end
              with V.Not_based_on_null | Ival.F.Nan_or_infinite ->
                Value_parameters.warning ~once:true ~current:true "float operation on address: assert (TODO)";

                V.join
                  (V.topify_arith_origin ev1)
                  (V.topify_arith_origin ev2)
            in
            state, deps, interpreted_expr
        | TInt _ | TPtr (_, _) | _ ->
            let interpreted_expr = begin match op with
            | PlusPI | IndexPI ->
                V.add_untyped (osizeof_pointed typ) ev1 ev2
            | MinusPI ->
                V.add_untyped (Int_Base.neg (osizeof_pointed typ)) ev1 ev2
            | PlusA ->
                V.add_untyped (Int_Base.inject Int.one) ev1 ev2
            | MinusA | MinusPP ->
                let minus_val = V.add_untyped Int_Base.minus_one ev1 ev2 in
                if op = MinusA
                then minus_val
                else (* MinusPP *)
                  ( try
                      let size =
                        Int_Base.project (sizeof_pointed(Cil.typeOf e1))
                      in
                      let size = Int.div size (Int.of_int 8) in
                      if Int.equal size Int.one then
                        minus_val
                      else
                        let minus_val = Cvalue_type.V.find_ival minus_val in
                        Cvalue_type.V.inject_ival
                          (Ival.scale_div ~pos:true size minus_val)
                    with
                      Int_Base.Error_Top | Cvalue_type.V.Not_based_on_null | Not_found ->
                        V.join
                          (V.topify_arith_origin ev1)
                          (V.topify_arith_origin ev2))
            | Mod -> V.c_rem ~with_alarms ev1 ev2
            | Div -> V.div ~with_alarms ev1 ev2
            | Mult -> V.arithmetic_function ~with_alarms "*" Ival.mul ev1 ev2
            | LOr ->
                assert false
                  (* This code makes a strict evaluation: V.interp_boolean
                     ~contains_zero: (V.contains_zero ev1 &&
                     V.contains_zero ev2) ~contains_non_zero:
                     (V.contains_non_zero ev1 || V.contains_non_zero
                     ev2)*)

            | LAnd ->
                assert false
                  (* This code makes a strict evaluation:
                     V.interp_boolean ~contains_zero: (V.contains_zero
                     ev1 || V.contains_zero ev2) ~contains_non_zero:
                     (V.contains_non_zero ev1 && V.contains_non_zero
                     ev2)*)

            | BOr -> V.oper_on_values ~with_alarms "|" Int.logor ev1 ev2
            | BXor -> V.oper_on_values ~with_alarms "^" Int.logxor ev1 ev2
            | BAnd ->
                ( try
                    let size = bitsSizeOf (typeOf e1)
                    in
                    V.bitwise_and ~size ev1 ev2
                  with SizeOfError _ ->
                    V.join
                      (V.topify_arith_origin ev1)
                      (V.topify_arith_origin ev2))

            | Eq | Ne | Ge | Le | Gt | Lt ->
                let ev1, ev2 = check_comparable ~with_alarms ev1 ev2 in
                let f = match op with
                | Eq -> V.check_equal true
                | Ne -> V.check_equal false
                | Ge -> V.comparisons ">=" V.do_ge
                | Le -> V.comparisons "<=" V.do_le
                | Gt -> V.comparisons ">" V.do_gt
                | Lt -> V.comparisons "<" V.do_lt
                | _ -> assert false
                in
                f ev1 ev2
            | Shiftrt ->
                begin try
                    let signed = is_signed_int_enum_pointer typ in
                    V.shift_right ~with_alarms ~size:(bitsSizeOf typ) ~signed ev1 ev2
                      (*if signed then
                        V.oper_on_values ~with_alarms ">>" Int.shift_right ev1 ev2
                        else
                        V.oper_on_values ~with_alarms ">>" Int.log_shift_right ev1 ev2*)

                  with SizeOfError _ ->
                    (match with_alarms.CilE.imprecision_tracing with
                    | CilE.Aignore -> ()
                    | CilE.Acall f -> f ()
                    | CilE.Alog -> Value_parameters.result "shifting value of unknown size");
                    V.top  (* TODO: topify ... *)
                end
            | Shiftlt ->
                begin try
                    V.shift_left ~with_alarms ~size:(bitsSizeOf typ) ev1 ev2
                  with SizeOfError _ ->
                    (match with_alarms.CilE.imprecision_tracing with
                    | CilE.Aignore -> ()
                    | CilE.Acall f -> f ()
                    | CilE.Alog -> Value_parameters.result "shifting value of unknown size");
                    V.top (* TODO: topify ... *)
                end
              end
            in
            (* Warn if overflow in a signed int operation *)
            let interpreted_expr =
              match typ with
                TInt(kind, _) when isSigned kind && false ->
                  let size = bitsSizeOf typ in
                  let all_values =
                    V.create_all_values ~modu:Int.one ~signed:true ~size
                  in
                  if V.is_included interpreted_expr all_values
                  then interpreted_expr
                  else begin
                      CilE.set_syntactic_context (CilE.SyBinOp (op,e1,e2));
                      CilE.warn_signed_overflow with_alarms;
                      let r = V.narrow all_values interpreted_expr in
                      Value_parameters.debug
                        "overflow %a -> %a@."
                        V.pretty interpreted_expr
                        V.pretty r;
                      r
                    end
              | _ -> interpreted_expr
            in
            state, deps, interpreted_expr
        end
      end

and eval_expr_with_deps_state
    ~with_alarms deps (state : Relations_type.Model.t) e =
  (* Pretty.printf "EXPR to EVAL:%a\n" d_exp e; *)
  let state, deps, expr =
    match (Cil.stripInfo e).enode with
    | Info _ -> assert false
    | Const v ->
        let r =
          begin match v with
          | CInt64 (i,k,_s) ->
              V.inject_int (
                  if isSigned k then Int.of_int64 i
                  else (* For 64 bits type we need to reinterpret the sign *)
                    let s = Printf.sprintf "%Lu" i in
                    Int.of_string s)
          | CChr c ->
              (match charConstToInt c with
              | CInt64 (i,_,_) -> V.inject_int (Int.of_int64 i)
              | _ -> assert false)
          | CReal (f, _fsize, _) ->
              Value_parameters.result ~once:true "float support is experimental";
              let f = Ival.F.of_float f in
              V.inject_ival (Ival.inject_float (Ival.Float_abstract.inject f f))
          | CWStr _ ->
              Value_parameters.result "approximation because of a wide string";
              (* TODO *) V.top_int
          | CStr s ->
              V.inject (Base.create_string s) Ival.zero
          | CEnum {eival = e} ->
              let _,_, r =
                eval_expr_with_deps_state ~with_alarms deps state e
              in
              r
          end
        in
        state, deps, r
    | BinOp (op,e1,e2,typ) ->
        eval_BinOp ~with_alarms op e1 e2 typ deps state
    | Lval lv ->
        eval_lval ~with_alarms deps state lv
    | AddrOf v | StartOf v ->
        let state, deps, r =
          lval_to_loc_with_offset_deps_only_option ~with_alarms ?deps state v
        in
        state, deps, loc_to_loc_without_size r

    | CastE (typ, e) ->
        let deps, evaled_expr =
          eval_expr_with_deps ~with_alarms deps state e
        in
        let src_typ = unrollType (typeOf e) in
        let dest_type = unrollType typ in
        state, deps, do_promotion ~with_alarms ~dest_type ~src_typ evaled_expr

    | SizeOf typ ->
        let r =
          try V.inject_ival
            (Ival.inject_singleton ((Int.of_int ((bitsSizeOf typ) / 8))))
          with SizeOfError _ ->
            error "cannot interpret sizeof(incomplete type)";
            V.top_int
        in
        state, deps, r
    | SizeOfE e ->
        let typ = typeOf e in
        let r =
          try V.inject_ival
            (Ival.inject_singleton ((Int.of_int ((bitsSizeOf typ) / 8))))
          with SizeOfError _ ->
            error "cannot interpret sizeof(incomplete type)";
            V.top_int
        in
        state, deps, r

    | UnOp (LNot, e, _) ->
        (* TODO:  on float, LNot is equivalent to == 0.0 *)
        let deps, expr = eval_expr_with_deps ~with_alarms deps state e in
        CilE.set_syntactic_context (CilE.SyBinOp (EqCil.zero, e));
        let _, expr =
          check_comparable ~with_alarms V.singleton_zero expr
        in
        CilE.set_syntactic_context (CilE.SyUnOp e);
        let t1 = typeOf e in
        if isIntegralType t1 || isPointerType t1
        then
          state, deps, V.interp_boolean
            ~contains_zero:(V.contains_non_zero expr)
            ~contains_non_zero:(V.contains_zero expr)
        else state, deps, V.zero_or_one

    | UnOp (Neg, e, t) ->
        let t = unrollType t in
        ( match t with TFloat _ ->
          let deps, expr = eval_expr_with_deps ~with_alarms deps state e in
          CilE.set_syntactic_context (CilE.SyUnOp e);
          let result =
            try
              let v = V.find_ival expr in
              let f =
                Ival.project_float v
              in
              V.inject_ival (Ival.inject_float (Ival.Float_abstract.neg_float f))
            with
              V.Not_based_on_null ->
                Value_parameters.warning ~once:true ~current:true
                  "converting address to float: assert(TODO)";
                V.topify_arith_origin expr
            | Ival.Float_abstract.Nan_or_infinite ->
                Value_parameters.warning ~once:true ~current:true
                  "converting value to float: assert (TODO)";
                V.top_float
          in
          state, deps, result
        | _ ->
            let deps, expr = eval_expr_with_deps ~with_alarms deps state e in
            CilE.set_syntactic_context (CilE.SyUnOp e);
            let result =
              try
                let v = V.find_ival expr in
                V.inject_ival (Ival.neg v)
              with V.Not_based_on_null -> V.topify_arith_origin expr
            in
            state, deps, result)

    | UnOp (BNot, e, _) ->
        let deps, expr = eval_expr_with_deps ~with_alarms deps state e in
        CilE.set_syntactic_context (CilE.SyUnOp e);
        let result =
          try
            let v = V.find_ival expr in
            V.inject_ival
              (Ival.apply_set_unary "~" Int.lognot v)
          with V.Not_based_on_null -> V.topify_arith_origin expr
        in
        state, deps, result
    | AlignOfE _|AlignOf _|SizeOfStr _
        ->
        Value_parameters.result "C construct alignof or sizeof string not precisely handled";
          state, deps, V.top_int
  in
  let r =
    if hasAttribute "volatile" (typeAttrs (typeOf e))
      && not (Cvalue_type.V.equal Cvalue_type.V.bottom expr)
    then V.top_int
    else
      expr
  in
  let state,r_ptr = PtrRelational.eval_expr ~with_alarms state e in
  let r = Cvalue_type.V.narrow r_ptr r in
  let r = do_cast ~with_alarms (typeOf e) r in
  state, deps, r

and eval_expr_with_deps_state_subdiv ~with_alarms deps
    (state : Relations_type.Model.t) e =
  let ((state_without_subdiv, deps_without_subdiv, result_without_subdiv) as result) =
    eval_expr_with_deps_state  ~with_alarms deps
      (state : Relations_type.Model.t) e
  in
  if true then result else
    if not (Locations.Location_Bytes.is_included result_without_subdiv Locations.Location_Bytes.top_int)
    then begin
        Value_parameters.debug ~level:2 "subdiv: expression has an address result";
        result
      end
    else
      let compare_min, compare_max =
        if Locations.Location_Bytes.is_included result_without_subdiv Locations.Location_Bytes.top_float
        then begin
            Value_parameters.debug ~level:2 "optimizing floating-point expression";
            Cvalue_type.V.compare_min_float, Cvalue_type.V.compare_max_float
          end
        else begin
            Value_parameters.debug ~level:2 "optimizing integer expression";
            Pervasives.compare, Pervasives.compare
          end
      in
      let vars = (get_vars ~with_alarms:CilE.warn_none_mode state e) in
      Value_parameters.debug ~level:2 "variable list: %a"
        (Pretty_utils.pp_list Locations.pretty)
        vars;
      let rec try_sub vars =
        match vars with
          [] | [ _ ] ->
            result
        | v :: tail ->
            try
              if not (List.exists (fun x -> Locations.loc_equal v x) tail)
              then raise Too_linear;
              let value =
                Relations_type.Model.find
                  ~with_alarms:CilE.warn_none_mode
                  state
                  v
              in
              Value_parameters.debug ~level:2 "Considering optimizing variable %a (value %a)"
                Locations.pretty v Cvalue_type.V.pretty value;
              if Cvalue_type.V.cardinal_zero_or_one value
                || not (Locations.Location_Bytes.is_included value Locations.Location_Bytes.top_float)
              then raise Too_linear;

              let working_list = ref [ (value, result_without_subdiv) ] in
              let subdiv_for_bound better_bound =
                let rec insert_subvalue_in_list (v, exp_value) l =
                  match l with
                    [] -> [(v, exp_value)]
                  | (v1, exp_value1) :: tail ->
                      if better_bound exp_value1 exp_value >= 0
                      then (v, exp_value) :: l
                      else
                        let r = insert_subvalue_in_list (v, exp_value) tail in
                        (v1, exp_value1) :: r
                in
                let exp_subvalue subvalue l =
                  let substate =
                    (* FIXME: should be relation-aware primitive *)
                    Relations_type.Model.add_binding
                      ~with_alarms:CilE.warn_none_mode
                      ~exact:true
                      state
                      v
                      subvalue
                  in
                  insert_subvalue_in_list (subvalue, eval_expr ~with_alarms substate e) l
                in
                let subdiv l =
                  match l with
                    [] -> assert false
                  | (value, _exp_value) :: tail ->
                      let (subvalue1, subvalue2) = Cvalue_type.V.subdiv_float_interval value in
                      let s =  exp_subvalue subvalue1 tail
                      in
                      exp_subvalue subvalue2 s
                in
                for i = 1 to 60 do
                  working_list := subdiv !working_list;
                  Value_parameters.debug ~level:2 "first elements of the list %a %a"
                    V.pretty (fst (List.hd !working_list))
                    V.pretty (snd (List.hd !working_list)) ;
                done
              in
              subdiv_for_bound compare_min ;
              (* sort working_list in decreasing order on the upper bounds of exp_value *)
              let comp_exp_value (_value1,exp_value1) (_value2,exp_value2) =
                compare_max exp_value1 exp_value2
              in
              working_list := (List.sort comp_exp_value !working_list) ;
              if Value_parameters.debug_atleast 2 then
                List.iter
                  (function (x, e) ->
                    Value_parameters.debug "les elements de la liste max %a %a"
                      V.pretty (x) V.pretty (e))
                  !working_list;
              subdiv_for_bound compare_max ;
              let optimized_exp_value =
                List.fold_left
                  (fun acc (_value, exp_value)  ->
                    Cvalue_type.V.join exp_value acc)
                  Cvalue_type.V.bottom
                  !working_list
              in
              state_without_subdiv, deps_without_subdiv, optimized_exp_value
            with Not_less_than | Too_linear ->
              try_sub tail
      in
      try_sub vars

and eval_lval_using_main_memory ~with_alarms deps (state:Relations_type.Model.t)
    lv
    =
  let state,deps,loc =
    lval_to_loc_deps_option ~with_alarms ?deps state lv
      ~reduce_valid_index:(Parameters.SafeArrays.get ())
  in
  CilE.set_syntactic_context (CilE.SyMem lv);
  let result = Relations_type.Model.find ~with_alarms state loc in
  (* TODO: move into Model.find *)
  let valid_loc = Locations.valid_part loc in
  let state =
    if Location_Bits.equal loc.Locations.loc valid_loc.Locations.loc
    then state
    else begin
        match lv with
          (*          Mem (Lval ((_,_) as lv_mem)),NoOffset ->
                  let loc_mem =
                  lval_to_loc ~with_alarms:warn_none_mode state lv_mem
                  in
                  if Location_Bits.cardinal_zero_or_one loc_mem.Locations.loc
                  then Relations_type.Model.reduce_binding
                  state loc_mem
                  (loc_bits_to_loc_bytes valid_loc.loc)
                  else state *)

          Mem (exp_mem),NoOffset ->
            let lv_mem_plus_list =
              find_lv_plus ~with_alarms:CilE.warn_none_mode state exp_mem
            in
            let treat_lv_mem_plus (lv_mem, plus) state =
              let loc_mem =
                lval_to_loc ~with_alarms:CilE.warn_none_mode state lv_mem
              in
              if Location_Bits.cardinal_zero_or_one loc_mem.Locations.loc
              then
                let new_val =
                  Location_Bytes.location_shift
                    (Ival.neg plus)
                    (loc_bits_to_loc_bytes valid_loc.loc)
                in
                Relations_type.Model.reduce_binding
                  state loc_mem new_val
              else state
            in
            List.fold_right treat_lv_mem_plus lv_mem_plus_list state
        | _ -> state
      end
  in
  (match with_alarms.CilE.imprecision_tracing with
  | CilE.Aignore -> ()
  | CilE.Acall f -> f ()
  | CilE.Alog -> warn_lval_read lv loc result);
  let new_deps =
    match deps with
    | None -> None
    | Some deps -> Some (Zone.join deps (valid_enumerate_bits loc))
  in
  state, new_deps, result

and eval_lval ~with_alarms deps state (base,offset as lv) =
  let state, deps, result_from_main_memory =
    eval_lval_using_main_memory ~with_alarms deps state lv
  in
  let find_loc_mem sub_lv offs =
    try
      let loc = lval_to_loc ~with_alarms state sub_lv in
      let size = sizeof_lval lv in
      CilE.set_syntactic_context (CilE.SyMem lv);
      Relations_type.Model.find_mem loc size offs state
    with Relations_type.Use_Main_Memory ->
      result_from_main_memory
  in
  let result = match base with
  | Mem({enode = Lval sub_lv} as e) when UseRelations.get () ->
      let typ = typeOf e in
      begin try
          let _, _, offs =
            eval_offset ~reduce_valid_index:(Parameters.SafeArrays.get ())
              ~with_alarms None typ state offset
          in
          find_loc_mem sub_lv offs
        with
          Offset_not_based_on_Null _ ->
            result_from_main_memory
      end
  | Mem({enode = BinOp((PlusPI|IndexPI|MinusPI as op),
                      {enode = Lval sub_lv} ,
                      e2,_)}
           as e)
      when UseRelations.get () ->
      begin
        let e2 = eval_expr ~with_alarms state e2 in
        let typ = typeOf e in
        try
          let ival = Cvalue_type.V.find_ival e2 in
          let ival = if op=MinusPI then Ival.neg ival else ival in
          let _, _, offs =
            eval_offset ~reduce_valid_index:(Parameters.SafeArrays.get ())
              ~with_alarms None typ state offset in
          let offs = (* convert to bits *)
            Ival.add
              (Ival.scale
                  (Int_Base.project (sizeof_pointed typ))
                  ival)
              offs
          in
          let result = find_loc_mem sub_lv offs in
          result
        with
        | Offset_not_based_on_Null _
        | Int_Base.Error_Top
        | Cvalue_type.V.Not_based_on_null -> result_from_main_memory
      end
  | _e ->
      result_from_main_memory
  in
  let result_inter = Cvalue_type.V.narrow result_from_main_memory result in
  state, deps, result_inter

and eval_offset ~reduce_valid_index ~with_alarms deps typ state offset =
  match offset with
  | NoOffset ->
      state, deps, Ival.singleton_zero
  | Index (exp,remaining) ->
      let typ_pointed,array_size = match (unrollType typ) with
      | TArray (t,size,_,_) -> t, size
      | TPtr(t,_) ->
          (match unrollType t with
          | TArray (t,size,_,_) -> t,size (* pointer to start of an array *)
          | _ ->
              error "Got type '%a'" !Ast_printer.d_type t;
              assert false)
      | t ->
          error "Got type '%a'" !Ast_printer.d_type t;
          assert false
      in
      let state, deps, current =
        eval_expr_with_deps_state ~with_alarms deps state exp
      in
      if V.is_bottom current
      then Relations_type.Model.bottom, (Some Zone.bottom), Ival.bottom
      else
        let state, offset =
          try
            let v = V.find_ival current in
            let state, v =
              if reduce_valid_index then
                try
                  let array_siz = lenOfArray64 array_size in
                  let new_v =
                    Ival.narrow (Ival.inject_range
                                    (Some Int.zero)
                                    (Some (Int.of_int64 (Int64.pred array_siz)))) v
                  in
                  let new_state =
                    if Ival.equal new_v v
                    then state
                    else begin
                        begin
                          match with_alarms.CilE.others with
                          | CilE.Aignore -> ()
                          | CilE.Acall f -> f ()
                          | CilE.Alog ->
                              CilE.set_syntactic_context
                                (CilE.SyBinOp
                                    (IndexPI,
                                    exp,
                                    Cilutil.out_some array_size));
                              CilE.warn_index  with_alarms "accessing"
                        end;
                        state (* TODO : if the index is a variable, reduce *)
                      end
                  in
                  new_state, new_v
                with LenOfArray -> state, v
              else state, v
            in
            state, v
          with V.Not_based_on_null ->
            let deps, offset =
              topify_offset
                ~with_alarms
                deps
                state
                (Cvalue_type.V.topify_arith_origin current)
                remaining
            in
            raise (Offset_not_based_on_Null (deps,offset))
        in
        let state, deps, r =
          eval_offset ~reduce_valid_index ~with_alarms
            deps typ_pointed state remaining
        in
        let offset = Ival.scale_int64base (sizeof typ_pointed) offset in
        state, deps, Ival.add offset r
  | Field (fi,remaining) ->
      let current,_ = bitsOffset typ (Field(fi,NoOffset)) in
      let state, deps, r =
        eval_offset ~reduce_valid_index ~with_alarms
          deps
          fi.ftype
          state
          remaining
      in
      state, deps, Ival.add (Ival.of_int current) r
and topify_offset ~with_alarms deps state acc offset =
  match offset with
  | NoOffset -> deps,acc
  | Field (_fi,remaining) -> topify_offset ~with_alarms deps state acc remaining
  | Index (exp,remaining) ->
      let deps, loc_index = eval_expr_with_deps ~with_alarms deps state exp in
      let acc = Location_Bytes.join
        (Cvalue_type.V.topify_arith_origin loc_index)
        acc
      in
      topify_offset ~with_alarms deps state acc remaining