From 4d4a23fd6ac37b1b942d274869d38d5b47cceea1 Mon Sep 17 00:00:00 2001 From: Andrei Paskevich <andrei@lri.fr> Date: Fri, 8 Jul 2011 13:56:59 +0200 Subject: [PATCH] translate 'if' of WhyML to 'if' of Why when the both branches are pure this reduces the unnecessary branching in WPs, especially for C-inspired expressions like (if <cond> then 1 else 0). --- src/programs/pgm_wp.ml | 39 +++++++++++++++++++++++++++------------ 1 file changed, 27 insertions(+), 12 deletions(-) diff --git a/src/programs/pgm_wp.ml b/src/programs/pgm_wp.ml index b58032498a..5f1611d2b4 100644 --- a/src/programs/pgm_wp.ml +++ b/src/programs/pgm_wp.ml @@ -443,14 +443,14 @@ and wp_desc env rm e q = match e.expr_desc with | Elogic t -> let (v, q), _ = q in t_subst_single v t q - | Elocal v -> - let (res, q), _ = q in - t_subst (subst1 res (t_var v.pv_pure)) q - | Eglobal { ps_kind = PSfun _ } -> - let (_, q), _ = q in q + | Elocal pv -> + let (v, q), _ = q in + t_subst_single v (t_var pv.pv_pure) q | Eglobal { ps_kind = PSvar pv } -> let (v, q), _ = q in t_subst_single v (t_var pv.pv_pure) q + | Eglobal { ps_kind = PSfun _ } -> + let (_, q), _ = q in q | Eglobal { ps_kind = PSlogic } -> assert false | Efun (bl, t) -> @@ -472,14 +472,29 @@ and wp_desc env rm e q = match e.expr_desc with let wl = List.map (wp_recfun env rm) dl in wp_ands ~sym:true (w1 :: wl) | Eif (e1, e2, e3) -> - let w2 = wp_expr env rm e2 (filter_post e2.expr_effect q) in - let w3 = wp_expr env rm e3 (filter_post e3.expr_effect q) in - let q1 = (* if result=True then w2 else w3 *) - let res = v_result e1.expr_type in - let test = t_equ (t_var res) (t_True env) in - let q1 = t_if test w2 w3 in - saturate_post e1.expr_effect (res, q1) q + let res = v_result e1.expr_type in + let test = t_equ (t_var res) (t_True env) in + (* if the both branches are pure, do not split *) + let q1 = + try + let r2 = match e2.expr_desc with + | Elogic t -> t + | Elocal pv -> t_var pv.pv_pure + | Eglobal { ps_kind = PSvar pv } -> t_var pv.pv_pure + | _ -> raise Exit in + let r3 = match e3.expr_desc with + | Elogic t -> t + | Elocal pv -> t_var pv.pv_pure + | Eglobal { ps_kind = PSvar pv } -> t_var pv.pv_pure + | _ -> raise Exit in + let (v, q), _ = q in + t_subst_single v (t_if test r2 r3) q + with Exit -> + let w2 = wp_expr env rm e2 (filter_post e2.expr_effect q) in + let w3 = wp_expr env rm e3 (filter_post e3.expr_effect q) in + t_if test w2 w3 in + let q1 = saturate_post e1.expr_effect (res, q1) q in wp_expr env rm e1 q1 | Eloop ({ loop_invariant = inv; loop_variant = var }, e1) -> let wfr = well_founded_rel var in -- GitLab