diff --git a/src/plugins/wp/cfgCalculus.ml b/src/plugins/wp/cfgCalculus.ml index 313ffb87e0a1b3b035872880092281a91052aca3..bb1c39135e2b60658b383f0e6bfb3b35b7013df0 100644 --- a/src/plugins/wp/cfgCalculus.ml +++ b/src/plugins/wp/cfgCalculus.ml @@ -114,6 +114,14 @@ let is_selected_props (props : props) ?pi pid = | Some q -> q | None -> WpPropId.property_of_id pid +let rec factorize ~wdefault = function + | (_,w)::wcs when w==wdefault -> factorize ~wdefault wcs + | (e,w)::wcs -> collect ~wdefault [e] w wcs + | [] -> [] +and collect ~wdefault rs wr = function + | (e,w)::wcs when w==wr -> collect ~wdefault (e::rs) wr wcs + | wcs -> (List.rev rs,wr) :: factorize ~wdefault wcs + (* -------------------------------------------------------------------------- *) (* --- WP Calculus Driver from Interpreted Automata --- *) (* -------------------------------------------------------------------------- *) @@ -218,9 +226,9 @@ struct let welse = wp env velse in W.test env.we s cond wthen welse | Switch { value ; cases ; default } -> - let wcases = List.map (fun (e,v) -> [e], wp env v) cases in + let wcases = List.map (fun (e,v) -> e,wp env v) cases in let wdefault = wp env default in - W.switch env.we s value wcases wdefault + W.switch env.we s value (factorize ~wdefault wcases) wdefault | Loop _ -> let m = env.mode in let smoking = diff --git a/src/plugins/wp/cfgDump.ml b/src/plugins/wp/cfgDump.ml index 3d25437b758b492c269acc2df68f7486fe2eec97..0b14a6f2785491717613431d59900041d4b7a80b 100644 --- a/src/plugins/wp/cfgDump.ml +++ b/src/plugins/wp/cfgDump.ml @@ -163,14 +163,25 @@ let return _env _stmt r k = let test _env _stmt e k1 k2 = let u = node () in - Format.fprintf !out " %a [ color=cyan , label=\"If %a\" ] ;@." pretty u Printer.pp_exp e ; + Format.fprintf !out " %a [ color=cyan , label=\"If %a\" ] ;@." + pretty u Printer.pp_exp e ; link u k1 ; link u k2 ; u let switch _env _stmt e cases def = let u = node () in - Format.fprintf !out " %a [ color=cyan , label=\"Switch %a\" ] ;@." pretty u Printer.pp_exp e ; - List.iter (fun (_,k) -> link u k) cases ; - link u def ; u + Format.fprintf !out " %a [ color=cyan , label=\"Switch %a\" ] ;@." + pretty u Printer.pp_exp e ; + List.iter (fun (es,k) -> + let c = node () in + Format.fprintf !out " %a [ color=orange , label=\"Case %a\" ] ;@." + pretty c (Pretty_utils.pp_list ~sep:"," Printer.pp_exp) es ; + link u c ; + link c k ; + ) cases ; + let d = node () in + Format.fprintf !out " %a [ color=orange , label=\"Default\" ] ;@." pretty d ; + link u d ; + link d def ; u let const _ x k = let u = node () in