let rec expr pos e =
let pos = match e.enode with Info(_,einfo) -> einfo.exp_loc | _ -> pos in
let expr = expr pos in
let integral_expr = integral_expr pos in
let enode =
let e = stripInfo e in
match e.enode with
| Info _ -> assert false
| Const c -> const ~in_code:true pos c
| Lval lv -> (lval pos lv)#node
| SizeOf _ | SizeOfE _ | SizeOfStr _ | AlignOf _ | AlignOfE _ ->
assert false
| UnOp(_op,_e,ty) when isIntegralType ty ->
(integral_expr e)#node
| UnOp(op,e,_ty) ->
let e =
locate (mkexpr (JCPEunary(unop op,expr e)) pos)
in
e#node
| BinOp(_op,_e1,_e2,ty) when isIntegralType ty ->
(integral_expr e)#node
| BinOp(op,e1,e2,_ty) ->
let e =
locate (mkexpr (JCPEbinary(expr e1,binop op,expr e2)) pos)
in
e#node
| CastE(ty,e') when isIntegralType ty && isArithmeticType (typeOf e') ->
(integral_expr e)#node
| CastE(ty,e) when isFloatingType ty && isArithmeticType (typeOf e) ->
let e = locate (mkexpr (JCPEcast(expr e,ctype ty)) pos) in
e#node
| CastE(ty,e') when isIntegralType ty && isPointerType (typeOf e') ->
unsupported "Casting from type %a to type %a not allowed"
!Ast_printer.d_type (typeOf e') !Ast_printer.d_type ty
| CastE(ptrty,_e1) when isPointerType ptrty ->
begin
let e = stripCastsAndInfo e in
match e.enode with
| Const c
when is_integral_const c
&& value_of_integral_const c = Int64.zero ->
JCPEconst JCCnull
| _ ->
let ety = typeOf e in
if isIntegralType ety then
unsupported "Casting from type %a to type %a not allowed"
!Ast_printer.d_type (typeOf e) !Ast_printer.d_type ptrty
else if isPointerType ety then
let enode = JCPEcast(expr e,ctype ptrty) in
let e = locate (mkexpr enode pos) in
e#node
else
unsupported "Casting from type %a to type %a not allowed"
!Ast_printer.d_type (typeOf e) !Ast_printer.d_type ptrty
end
| CastE(ty,e') ->
notimplemented "Casting from type %a to type %a not allowed in %a with size %Ld and %Ld"
!Ast_printer.d_type (typeOf e') !Ast_printer.d_type ty !Ast_printer.d_exp e
( bits_sizeof ty) ( bits_sizeof (typeOf e'))
| AddrOf _lv -> assert false
| StartOf lv -> (lval pos lv)#node
in
mkexpr enode pos
and boolean_expr pos e =
let pos = match e.enode with Info(_,einfo) -> einfo.exp_loc | _ -> pos in
let expr = expr pos in
let boolean_expr = boolean_expr pos in
let boolean_node_from_expr ty e =
if isPointerType ty then JCPEbinary(e,`Bneq,null_expr)
else if isArithmeticType ty then JCPEbinary (e,`Bneq,zero_expr)
else assert false
in
let enode = match (stripInfo e).enode with
| Info _ -> assert false
| Const c -> JCPEconst(boolean_const c)
| UnOp(LNot,e,_typ) -> JCPEunary(unop LNot,boolean_expr e)
| BinOp((LAnd | LOr) as op,e1,e2,_typ) ->
JCPEbinary(boolean_expr e1,binop op,boolean_expr e2)
| BinOp((Eq | Ne) as op,e1,e2,_typ) ->
JCPEbinary(expr e1,binop op,expr e2)
| BinOp((Lt | Gt | Le | Ge) as op,e1,e2,_typ) ->
let ty = typeOf e1 in
if isArithmeticType ty then
JCPEbinary(expr e1,binop op,expr e2)
else
let sube = mkexpr (JCPEbinary(expr e1,`Bsub,expr e2)) pos in
JCPEbinary(sube,binop op,zero_expr)
| _ -> boolean_node_from_expr (typeOf e) (expr e)
in
mkexpr enode pos
and integral_expr pos e =
let rec int_expr pos e =
let expr = expr pos in
let int_expr = int_expr pos in
let boolean_expr = boolean_expr pos in
let node_from_boolean_expr e = JCPEif(e,one_expr,zero_expr) in
let enode = match e.enode with
| UnOp(LNot,e,_ty) ->
let e = mkexpr (JCPEunary(unop LNot,boolean_expr e)) pos in
node_from_boolean_expr e
| UnOp(op,e,_ty) ->
let e =
locate (mkexpr (JCPEunary(unop op,expr e)) pos)
in
e#node
| BinOp((LAnd | LOr) as op,e1,e2,_ty) ->
let e =
mkexpr (JCPEbinary(boolean_expr e1,binop op,boolean_expr e2)) pos
in
node_from_boolean_expr e
| BinOp((Lt | Gt | Le | Ge as op),e1,e2,_ty)
when isPointerType (typeOf e1) ->
let sube = mkexpr (JCPEbinary(expr e1,`Bsub,expr e2)) pos in
let e = mkexpr (JCPEbinary(sube,binop op,zero_expr)) pos in
node_from_boolean_expr e
| BinOp((Eq | Ne) as op,e1,e2,_ty) ->
let e = mkexpr (JCPEbinary(expr e1,binop op,expr e2)) pos in
node_from_boolean_expr e
| BinOp((Lt | Gt | Le | Ge) as op,e1,e2,_ty) ->
let e = mkexpr (JCPEbinary(expr e1,binop op,expr e2)) pos in
node_from_boolean_expr e
| BinOp(Shiftrt,e1,e2,_ty) ->
let e = match possible_value_of_integral_expr e2 with
| Some i when i >= 0L && i < 63L ->
let pow = constant_expr (power_of_two i) in
locate (mkexpr (JCPEbinary(expr e1,`Bdiv,expr pow)) pos)
| _ ->
let op =
if isSignedInteger (typeOf e1) then `Barith_shift_right
else `Blogical_shift_right
in
locate (mkexpr (JCPEbinary(expr e1,op,expr e2)) pos)
in
e#node
| BinOp(Shiftlt as op,e1,e2,_ty) ->
let e = match possible_value_of_integral_expr e2 with
| Some i when i >= 0L && i < 63L ->
let pow = constant_expr (power_of_two i) in
locate (mkexpr (JCPEbinary(expr e1,`Bmul,expr pow)) pos)
| _ ->
locate (mkexpr (JCPEbinary(expr e1,binop op,expr e2)) pos)
in
e#node
| BinOp(op,e1,e2,_ty) ->
let e =
locate (mkexpr (JCPEbinary(expr e1,binop op,expr e2)) pos)
in
e#node
| CastE(ty,e1) when isFloatingType (typeOf e1) ->
let e1' = locate (mkexpr (JCPEcast(expr e1,ltype Linteger)) pos) in
if Jessie_options.IntModel.get_val () = Jessie_options.IMexact then
e1'#node
else
let e2' = locate (mkexpr (JCPEcast(e1',ctype ty)) pos) in
e2'#node
| CastE(ty,e) when isIntegralType (typeOf e) ->
if Jessie_options.IntModel.get_val () = Jessie_options.IMexact then
(int_expr e)#node
else
let e = locate (mkexpr (JCPEcast(int_expr e,ctype ty)) pos) in
e#node
| _ -> (expr e)#node
in
mkexpr enode pos
in
match e.enode with
| CastE _ -> int_expr pos e
| _ -> int_expr pos (new_exp(CastE(typeOf e,e)))
and lval pos = function
| Var v, NoOffset -> mkexpr (JCPEvar v.vname) pos
| Var _v, _off -> assert false
| Mem _e, NoOffset -> assert false
| Mem e, Field(fi,off) ->
assert (off = NoOffset);
let e = expr pos e in
if not fi.fcomp.cstruct then
locate (mkexpr (JCPEcast(e,ctype fi.ftype)) pos)
else
let repfi = Retype.FieldUnion.repr fi in
let e,fi =
if FieldinfoComparable.equal fi repfi then
e,fi
else
let caste =
locate
(mkexpr
(JCPEcast(e,ctype (TPtr(TComp(repfi.fcomp, empty_size_cache (),[]),[])))) pos)
in
caste,repfi
in
locate (mkexpr (JCPEderef(e,fi.fname)) pos)
| Mem e, Index(ie,Field(fi,off)) ->
assert (off = NoOffset);
let e = mkexpr (JCPEbinary(expr pos e,`Badd,expr pos ie)) pos in
if not fi.fcomp.cstruct then
locate (mkexpr (JCPEcast(e,ctype fi.ftype)) pos)
else
let repfi = Retype.FieldUnion.repr fi in
let e,fi =
if FieldinfoComparable.equal fi repfi then
e,fi
else
let caste =
locate
(mkexpr
(JCPEcast(e,ctype (TPtr(TComp(repfi.fcomp, empty_size_cache (),[]),[])))) pos)
in
caste,repfi
in
locate (mkexpr (JCPEderef(e,fi.fname)) pos)
| Mem _e, Index _ as lv ->
Jessie_options.fatal ~current:true "Unexpected lval %a" !Ast_printer.d_lval lv