(** [simplify p] removes unnecessary casts in the Clight program [p].
Example: [(char) ((int)x + (int)y)] where [x] and [y] are of type [char]
will be transformed into [x + y]. *)
let f_ctype ctype _ = ctype
let f_expr = ClightFold.expr_fill_subs
let f_expr_descr e sub_ctypes_res sub_exprs_res =
match e, sub_exprs_res with
| Clight.Ecast (Clight.Tint (Clight.I8, signedness1), _),
Clight.Expr
(Clight.Eunop
(unop,
Clight.Expr
(Clight.Ecast
(Clight.Tint (Clight.I32, _),
(Clight.Expr (_, Clight.Tint (Clight.I8, signedness2)) as e)),
_)),
_) :: _ when signedness1 = signedness2 ->
Clight.Eunop (unop, e)
| Clight.Ecast (Clight.Tint (Clight.I8, signedness1), _),
Clight.Expr
(Clight.Ebinop
(binop,
Clight.Expr
(Clight.Ecast
(Clight.Tint (Clight.I32, _),
(Clight.Expr (_,
Clight.Tint (Clight.I8, signedness2)) as e1)),
_),
Clight.Expr
(Clight.Ecast
(Clight.Tint (Clight.I32, _),
(Clight.Expr (_,
Clight.Tint (Clight.I8, signedness3)) as e2)),
_)),
_) :: _ when signedness1 = signedness2 && signedness2 = signedness3 ->
Clight.Ebinop (binop, e1, e2)
| Clight.Ecast (Clight.Tint (Clight.I8, signedness1), _),
Clight.Expr
(Clight.Ebinop
(binop,
Clight.Expr
(Clight.Ecast
(Clight.Tint (Clight.I32, _),
(Clight.Expr (_,
Clight.Tint (Clight.I8, signedness2)) as e1)),
_),
Clight.Expr (Clight.Econst_int i, _)),
_) :: _ when signedness1 = signedness2 ->
Clight.Ebinop (binop, e1,
Clight.Expr (Clight.Econst_int i,
Clight.Tint (Clight.I8, signedness1)))
| Clight.Ecast (Clight.Tint (Clight.I8, signedness1), _),
Clight.Expr
(Clight.Ebinop
(binop,
Clight.Expr (Clight.Econst_int i, _),
Clight.Expr
(Clight.Ecast
(Clight.Tint (Clight.I32, _),
(Clight.Expr (_,
Clight.Tint (Clight.I8, signedness2)) as e1)),
_)),
_) :: _ when signedness1 = signedness2 ->
Clight.Ebinop (binop,
Clight.Expr (Clight.Econst_int i,
Clight.Tint (Clight.I8, signedness1)),
e1)
| _ -> ClightFold.expr_descr_fill_subs e sub_ctypes_res sub_exprs_res
let f_statement = ClightFold.statement_fill_subs
let simplify_stmt = ClightFold.statement f_ctype f_expr f_expr_descr f_statement
let simplify_funct (id, fundef) =
let fundef' = match fundef with
| Clight.Internal cfun ->
Clight.Internal
{ cfun with Clight.fn_body = simplify_stmt cfun.Clight.fn_body }
| _ -> fundef in
(id, fundef')
let simplify p =
{ p with Clight.prog_funct = List.map simplify_funct p.Clight.prog_funct }